06/18: packages: 'package-input-rewriting/spec' ignores hidden packages.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit eee95b5a879b7096dffd533f24107cf8926b621e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Mar 8 12:53:20 2023 +0100

    packages: 'package-input-rewriting/spec' ignores hidden packages.
    
    The primary motivation is to support things like:
    
      guix build guix --with-input=guile=guile-next
    
    without triggering a rebuild of (@@ (gnu packages commencement)
    guile-final) and similar things.
    
    It is also consistent with package name resolution on the command line:
    a package that cannot be named cannot be replaced.
    
    * guix/packages.scm (package-input-rewriting/spec)[rewrite]: When P is
    hidden, return it as-is.
    * tests/packages.scm ("package-input-rewriting/spec, hidden package"):
    New test.
    * doc/guix.texi (Defining Package Variants): Update.
    (Package Transformation Options): Update '--with-input' example.
---
 doc/guix.texi      | 21 ++++++++++++---------
 guix/packages.scm  |  7 +++++--
 tests/packages.scm | 20 +++++++++++++++++++-
 3 files changed, 36 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3814e60467..95c954bfcf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8331,10 +8331,13 @@ be replaced by name rather than by identity.
 @deffn {Scheme Procedure} package-input-rewriting/spec @var{replacements} 
[#:deep? #t]
 Return a procedure that, given a package, applies the given
 @var{replacements} to all the package graph, including implicit inputs
-unless @var{deep?} is false.  @var{replacements} is a list of
-spec/procedures pair; each spec is a package specification such as
-@code{"gcc"} or @code{"guile@@2"}, and each procedure takes a matching
-package and returns a replacement for that package.
+unless @var{deep?} is false.
+
+@var{replacements} is a list of spec/procedures pair; each spec is a
+package specification such as @code{"gcc"} or @code{"guile@@2"}, and
+each procedure takes a matching package and returns a replacement for
+that package.  Matching packages that have the @code{hidden?} property
+set are not replaced.
 @end deffn
 
 The example above could be rewritten this way:
@@ -12664,18 +12667,18 @@ or @code{guile@@1.8}.
 
 For instance, the following command builds Guix, but replaces its
 dependency on the current stable version of Guile with a dependency on
-the legacy version of Guile, @code{guile@@2.0}:
+the legacy version of Guile, @code{guile@@2.2}:
 
 @example
-guix build --with-input=guile=guile@@2.0 guix
+guix build --with-input=guile=guile@@2.2 guix
 @end example
 
 This is a recursive, deep replacement.  So in this example, both
 @code{guix} and its dependency @code{guile-json} (which also depends on
-@code{guile}) get rebuilt against @code{guile@@2.0}.
+@code{guile}) get rebuilt against @code{guile@@2.2}.
 
-This is implemented using the @code{package-input-rewriting} Scheme
-procedure (@pxref{Defining Packages, @code{package-input-rewriting}}).
+This is implemented using the @code{package-input-rewriting/spec} Scheme
+procedure (@pxref{Defining Packages, @code{package-input-rewriting/spec}}).
 
 @item --with-graft=@var{package}=@var{replacement}
 This is similar to @option{--with-input} but with an important difference:
diff --git a/guix/packages.scm b/guix/packages.scm
index ca958c6eae..4c0c194652 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1533,9 +1533,11 @@ package and returns its new name after rewrite."
 (define* (package-input-rewriting/spec replacements #:key (deep? #t))
   "Return a procedure that, given a package, applies the given REPLACEMENTS to
 all the package graph, including implicit inputs unless DEEP? is false.
+
 REPLACEMENTS is a list of spec/procedures pair; each spec is a package
 specification such as \"gcc\" or \"guile@2\", and each procedure takes a
-matching package and returns a replacement for that package."
+matching package and returns a replacement for that package.  Matching
+packages that have the 'hidden?' property set are not replaced."
   (define table
     (fold (lambda (replacement table)
             (match replacement
@@ -1563,7 +1565,8 @@ matching package and returns a replacement for that 
package."
     (gensym " package-replacement"))
 
   (define (rewrite p)
-    (if (assq-ref (package-properties p) replacement-property)
+    (if (or (assq-ref (package-properties p) replacement-property)
+            (hidden-package? p))
         p
         (match (find-replacement p)
           (#f p)
diff --git a/tests/packages.scm b/tests/packages.scm
index 27fb918f90..ef97fca86d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
@@ -1592,6 +1592,24 @@
     (match (delete-duplicates pythons eq?)
       ((p) (eq? p (rewrite python))))))
 
+(test-assert "package-input-rewriting/spec, hidden package"
+  ;; Hidden packages are not subject to rewriting.
+  (let* ((python  (hidden-package python))
+         (p0      (dummy-package "chbouib"
+                    (build-system trivial-build-system)
+                    (inputs (list python))))
+         (rewrite (package-input-rewriting/spec
+                   `(("python" . ,(const sed)))
+                   #:deep? #t))
+         (p1      (rewrite p0))
+         (bag1    (package->bag p1))
+         (pythons (filter-map (match-lambda
+                                (("python" python) python)
+                                (_ #f))
+                              (bag-transitive-inputs bag1))))
+    (match (delete-duplicates pythons eq?)
+      ((p) (eq? p python)))))
+
 (test-equal "package-input-rewriting/spec, graft"
   (derivation-file-name (package-derivation %store sed))