diff mbox series

[bug#58032] transformations: '--with-source' now operates in depth.

Message ID 20220923204208.31957-1-ludo@gnu.org
State Accepted
Headers show
Series [bug#58032] transformations: '--with-source' now operates in depth. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git-branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Ludovic Courtès Sept. 23, 2022, 8:42 p.m. UTC
From: Ludovic Courtès <ludovic.courtes@inria.fr>

The '--with-source' option is the first one that was implemented, and
it's the only one that would operate only on leaf packages rather than
traversing the dependency graph.  This change makes it consistent with
the rest of the transformation options.

* guix/transformations.scm (evaluate-source-replacement-specs): New
procedure.
(transform-package-source): Rewrite using it.
* tests/transformations.scm ("options->transformation, with-source, no
matches"): Rewrite since we no longer get a warning.
("options->transformation, with-source, in depth"): New test.
* doc/guix.texi (Package Transformation Options): Adjust examples.
---
 doc/guix.texi             |  7 ++--
 guix/transformations.scm  | 74 +++++++++++++++++++++------------------
 tests/transformations.scm | 32 +++++++++++++----
 3 files changed, 68 insertions(+), 45 deletions(-)

Hi!

That ‘--with-source’ doesn’t work recursively, unlike other
transformations, has been a source of confusion.  This change
addresses that.  (It could probably use a channel news entry.)

Thoughts?

Actually a similar attempt had been made by Jesse Gibbons
at <https://issues.guix.gnu.org/43193>.  Oh well…

Ludo’.

Comments

Maxim Cournoyer Sept. 28, 2022, 4:46 p.m. UTC | #1
Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> From: Ludovic Courtès <ludovic.courtes@inria.fr>
>
> The '--with-source' option is the first one that was implemented, and
> it's the only one that would operate only on leaf packages rather than
> traversing the dependency graph.  This change makes it consistent with
> the rest of the transformation options.

Good idea!  I needed to workaround the lack of recursion at least once.

[...]

> diff --git a/guix/transformations.scm b/guix/transformations.scm
> index 411c4014cb..be2d31b8c7 100644
> --- a/guix/transformations.scm
> +++ b/guix/transformations.scm
> @@ -129,42 +129,46 @@ (define* (package-with-source p uri #:optional version)
>  ;;; Transformations.
>  ;;;
>  
> -(define (transform-package-source sources)
> +(define (evaluate-source-replacement-specs specs)
> +  "Parse SPECS, a list of strings like \"guile=/tmp/guile-4.2.tar.gz\" or just
> +\"/tmp/guile-4.2.tar.gz\" and return a list of package spec/procedure pairs as
> +expected by 'package-input-rewriting/spec'.  Raise an error if an element of
> +SPECS uses invalid syntax."
> +  (define not-equal
> +    (char-set-complement (char-set #\=)))
> +
> +  (map (lambda (spec)
> +         (match (string-tokenize spec not-equal)
> +           ((uri)
> +            (let* ((base (tarball-base-name (basename uri)))

Unrelated, but 'tarball-base-name' is a bit of a misnomer since the file
could be a single, non-tarball archive (or plain file).

> +                   (name (hyphen-package-name->name+version base)))
> +              (cons name
> +                    (lambda (old)
> +                      (package-with-source old uri)))))
> +           ((spec uri)
> +            (let-values (((name version)
> +                          (package-name->name+version spec)))

You usually recommend (srfi srfi-71) when using multiple values; why not
use it here?  I don't have a preference myself (I find srfi-71
surprising for the non-initiated (I was), although I like its simple
interface! :-)).
> +              ;; Note: Here VERSION is used as the version string of the new
> +              ;; package rather than as part of the spec of the package being
> +              ;; targeted.
> +              (cons name
> +                    (lambda (old)
> +                      (package-with-source old uri version)))))
> +           (_
> +            (raise (formatted-message
> +                    (G_ "invalid source replacement specification: ~s")
> +                    spec)))))
> +       specs))
> +
> +(define (transform-package-source replacement-specs)
>    "Return a transformation procedure that replaces package sources with the
> -matching URIs given in SOURCES."
> -  (define new-sources
> -    (map (lambda (uri)
> -           (match (string-index uri #\=)
> -             (#f
> -              ;; Determine the package name and version from URI.
> -              (call-with-values
> -                  (lambda ()
> -                    (hyphen-package-name->name+version
> -                     (tarball-base-name (basename uri))))
> -                (lambda (name version)
> -                  (list name version uri))))
> -             (index
> -              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
> -              (call-with-values
> -                  (lambda ()
> -                    (package-name->name+version (string-take uri index)))
> -                (lambda (name version)
> -                  (list name version
> -                        (string-drop uri (+ 1 index))))))))
> -         sources))
> -
> -  (lambda (obj)
> -    (let loop ((sources  new-sources)
> -               (result   '()))
> -      (match obj
> -        ((? package? p)
> -         (match (assoc-ref sources (package-name p))
> -           ((version source)
> -            (package-with-source p source version))
> -           (#f
> -            p)))
> -        (_
> -         obj)))))
> +matching URIs given in REPLACEMENT-SPECS."
> +  (let* ((replacements (evaluate-source-replacement-specs replacement-specs))
> +         (rewrite      (package-input-rewriting/spec replacements)))
> +    (lambda (obj)
> +      (if (package? obj)
> +          (rewrite obj)
> +          obj))))
>  
>  (define (evaluate-replacement-specs specs proc)
>    "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
> diff --git a/tests/transformations.scm b/tests/transformations.scm
> index dbfe523518..47b1fc650d 100644
> --- a/tests/transformations.scm
> +++ b/tests/transformations.scm
> @@ -103,16 +103,11 @@ (define-module (test-transformations)
>                                            "sha256" f))))))))))
>  
>  (test-assert "options->transformation, with-source, no matches"
> -  ;; When a transformation in not applicable, a warning must be raised.
>    (let* ((p (dummy-package "foobar"))
>           (s (search-path %load-path "guix.scm"))
>           (t (options->transformation `((with-source . ,s)))))
> -    (let* ((port (open-output-string))
> -           (new  (parameterize ((guix-warning-port port))
> -                   (t p))))
> -      (and (eq? new p)
> -           (string-contains (get-output-string port)
> -                            "had no effect")))))
> +    (eq? (package-source (t p))
> +         (package-source p))))

I'd personally find it a better interface if it failed noisily when
--with-source doesn't have any effect.  The warning was of little use
because it got lost in the other outputs; now it would be totally
silent, right?

>  (test-assert "options->transformation, with-source, PKG=URI"
>    (let* ((p (dummy-package "foo"))
> @@ -147,6 +142,29 @@ (define-module (test-transformations)
>                         (add-to-store store (basename s) #t
>                                       "sha256" s)))))))
>  
> +(test-assert "options->transformation, with-source, in depth"
> +  (let* ((p0 (dummy-package "foo" (version "0.0")))
> +         (s  (search-path %load-path "guix.scm"))
> +         (f  (string-append "foo@42.0=" s))
> +         (t  (options->transformation `((with-source . ,f))))
> +         (p1 (dummy-package "bar" (inputs (list p0))))
> +         (p2 (dummy-package "baz" (inputs (list p1)))))
> +    (with-store store
> +      (let ((new (t p2)))
> +        (and (not (eq? new p2))
> +             (match (package-inputs new)
> +               ((("bar" p1*))
> +                (match (package-inputs p1*)
> +                  ((("foo" p0*))
> +                   (and (not (eq? p0* p0))
> +                        (string=? (package-name p0*) (package-name p0))
> +                        (string=? (package-version p0*) "42.0")
> +                        (string=? (add-to-store store (basename s) #t
> +                                                "sha256" s)
> +                                  (run-with-store store
> +                                    (lower-object
> +                                     (package-source p0*))))))))))))))
> +

The recursive? option should probably be #f in the add-store above,
since the "dummy" source is a single file.  It may be better to create
the dummy file ourselves instead of relying on the existence of a
'guix.scm' one (it'd help clarify the test too, that bit was a bit
mysterious at first).

Other than that, LGTM!

Thanks,

Maxim
Ludovic Courtès Sept. 29, 2022, 11 a.m. UTC | #2
Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

>> +                   (name (hyphen-package-name->name+version base)))
>> +              (cons name
>> +                    (lambda (old)
>> +                      (package-with-source old uri)))))
>> +           ((spec uri)
>> +            (let-values (((name version)
>> +                          (package-name->name+version spec)))
>
> You usually recommend (srfi srfi-71) when using multiple values; why not
> use it here?  I don't have a preference myself (I find srfi-71
> surprising for the non-initiated (I was), although I like its simple
> interface! :-)).

This file is still on SRFI-11 so I followed that, but now that you
mention it, I’ll switch it to SRFI-71 in a subsequent commit.  :-)

>>  (test-assert "options->transformation, with-source, no matches"
>> -  ;; When a transformation in not applicable, a warning must be raised.
>>    (let* ((p (dummy-package "foobar"))
>>           (s (search-path %load-path "guix.scm"))
>>           (t (options->transformation `((with-source . ,s)))))
>> -    (let* ((port (open-output-string))
>> -           (new  (parameterize ((guix-warning-port port))
>> -                   (t p))))
>> -      (and (eq? new p)
>> -           (string-contains (get-output-string port)
>> -                            "had no effect")))))
>> +    (eq? (package-source (t p))
>> +         (package-source p))))
>
> I'd personally find it a better interface if it failed noisily when
> --with-source doesn't have any effect.  The warning was of little use
> because it got lost in the other outputs; now it would be totally
> silent, right?

Yes, it’ll be silent now, as with the other options.

That’s not great; the problem is that it’s impossible to tell whether a
package variant differs from the original one until they’ve been lowered
to a bag (or a derivation).

>> +(test-assert "options->transformation, with-source, in depth"
>> +  (let* ((p0 (dummy-package "foo" (version "0.0")))
>> +         (s  (search-path %load-path "guix.scm"))
>> +         (f  (string-append "foo@42.0=" s))
>> +         (t  (options->transformation `((with-source . ,f))))
>> +         (p1 (dummy-package "bar" (inputs (list p0))))
>> +         (p2 (dummy-package "baz" (inputs (list p1)))))
>> +    (with-store store
>> +      (let ((new (t p2)))
>> +        (and (not (eq? new p2))
>> +             (match (package-inputs new)
>> +               ((("bar" p1*))
>> +                (match (package-inputs p1*)
>> +                  ((("foo" p0*))
>> +                   (and (not (eq? p0* p0))
>> +                        (string=? (package-name p0*) (package-name p0))
>> +                        (string=? (package-version p0*) "42.0")
>> +                        (string=? (add-to-store store (basename s) #t
>> +                                                "sha256" s)
>> +                                  (run-with-store store
>> +                                    (lower-object
>> +                                     (package-source p0*))))))))))))))
>> +
>
> The recursive? option should probably be #f in the add-store above,
> since the "dummy" source is a single file.

No, it must be #t because that’s also how the transformation interns the
file (the option is called “recursive?” but it has little to do with
recursive directory traversal and more to do with the serialization
format.)

> It may be better to create the dummy file ourselves instead of relying
> on the existence of a 'guix.scm' one (it'd help clarify the test too,
> that bit was a bit mysterious at first).

Right, we could do that but that’s a tiny bit more verbose.  Here I
followed what existing tests do; perhaps we should plan for a face lift
of some of these tests.

Thanks for your feedback!

Ludo’.
Ludovic Courtès Sept. 29, 2022, 9:11 p.m. UTC | #3
Pushed!

  4244f5e9a7 news: Add entry for '--with-source'.
  28ade1bab2 transformations: '--with-source' now operates in depth.

Ludo'.
diff mbox series

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index eb12efa85e..7316b1c157 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12348,14 +12348,15 @@  one provided by the distribution.  The example below downloads
 the @code{ed} package:
 
 @example
-guix build ed --with-source=mirror://gnu/ed/ed-1.7.tar.gz
+guix build ed --with-source=mirror://gnu/ed/ed-1.4.tar.gz
 @end example
 
 As a developer, @option{--with-source} makes it easy to test release
-candidates:
+candidates, and even to test their impact on packages that depend on
+them:
 
 @example
-guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
+guix build elogind --with-source=@dots{}/shepherd-0.9.0rc1.tar.gz 
 @end example
 
 @dots{} or to build from a checkout in a pristine environment:
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 411c4014cb..be2d31b8c7 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -129,42 +129,46 @@  (define* (package-with-source p uri #:optional version)
 ;;; Transformations.
 ;;;
 
-(define (transform-package-source sources)
+(define (evaluate-source-replacement-specs specs)
+  "Parse SPECS, a list of strings like \"guile=/tmp/guile-4.2.tar.gz\" or just
+\"/tmp/guile-4.2.tar.gz\" and return a list of package spec/procedure pairs as
+expected by 'package-input-rewriting/spec'.  Raise an error if an element of
+SPECS uses invalid syntax."
+  (define not-equal
+    (char-set-complement (char-set #\=)))
+
+  (map (lambda (spec)
+         (match (string-tokenize spec not-equal)
+           ((uri)
+            (let* ((base (tarball-base-name (basename uri)))
+                   (name (hyphen-package-name->name+version base)))
+              (cons name
+                    (lambda (old)
+                      (package-with-source old uri)))))
+           ((spec uri)
+            (let-values (((name version)
+                          (package-name->name+version spec)))
+              ;; Note: Here VERSION is used as the version string of the new
+              ;; package rather than as part of the spec of the package being
+              ;; targeted.
+              (cons name
+                    (lambda (old)
+                      (package-with-source old uri version)))))
+           (_
+            (raise (formatted-message
+                    (G_ "invalid source replacement specification: ~s")
+                    spec)))))
+       specs))
+
+(define (transform-package-source replacement-specs)
   "Return a transformation procedure that replaces package sources with the
-matching URIs given in SOURCES."
-  (define new-sources
-    (map (lambda (uri)
-           (match (string-index uri #\=)
-             (#f
-              ;; Determine the package name and version from URI.
-              (call-with-values
-                  (lambda ()
-                    (hyphen-package-name->name+version
-                     (tarball-base-name (basename uri))))
-                (lambda (name version)
-                  (list name version uri))))
-             (index
-              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
-              (call-with-values
-                  (lambda ()
-                    (package-name->name+version (string-take uri index)))
-                (lambda (name version)
-                  (list name version
-                        (string-drop uri (+ 1 index))))))))
-         sources))
-
-  (lambda (obj)
-    (let loop ((sources  new-sources)
-               (result   '()))
-      (match obj
-        ((? package? p)
-         (match (assoc-ref sources (package-name p))
-           ((version source)
-            (package-with-source p source version))
-           (#f
-            p)))
-        (_
-         obj)))))
+matching URIs given in REPLACEMENT-SPECS."
+  (let* ((replacements (evaluate-source-replacement-specs replacement-specs))
+         (rewrite      (package-input-rewriting/spec replacements)))
+    (lambda (obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
 
 (define (evaluate-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
diff --git a/tests/transformations.scm b/tests/transformations.scm
index dbfe523518..47b1fc650d 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -103,16 +103,11 @@  (define-module (test-transformations)
                                           "sha256" f))))))))))
 
 (test-assert "options->transformation, with-source, no matches"
-  ;; When a transformation in not applicable, a warning must be raised.
   (let* ((p (dummy-package "foobar"))
          (s (search-path %load-path "guix.scm"))
          (t (options->transformation `((with-source . ,s)))))
-    (let* ((port (open-output-string))
-           (new  (parameterize ((guix-warning-port port))
-                   (t p))))
-      (and (eq? new p)
-           (string-contains (get-output-string port)
-                            "had no effect")))))
+    (eq? (package-source (t p))
+         (package-source p))))
 
 (test-assert "options->transformation, with-source, PKG=URI"
   (let* ((p (dummy-package "foo"))
@@ -147,6 +142,29 @@  (define-module (test-transformations)
                        (add-to-store store (basename s) #t
                                      "sha256" s)))))))
 
+(test-assert "options->transformation, with-source, in depth"
+  (let* ((p0 (dummy-package "foo" (version "0.0")))
+         (s  (search-path %load-path "guix.scm"))
+         (f  (string-append "foo@42.0=" s))
+         (t  (options->transformation `((with-source . ,f))))
+         (p1 (dummy-package "bar" (inputs (list p0))))
+         (p2 (dummy-package "baz" (inputs (list p1)))))
+    (with-store store
+      (let ((new (t p2)))
+        (and (not (eq? new p2))
+             (match (package-inputs new)
+               ((("bar" p1*))
+                (match (package-inputs p1*)
+                  ((("foo" p0*))
+                   (and (not (eq? p0* p0))
+                        (string=? (package-name p0*) (package-name p0))
+                        (string=? (package-version p0*) "42.0")
+                        (string=? (add-to-store store (basename s) #t
+                                                "sha256" s)
+                                  (run-with-store store
+                                    (lower-object
+                                     (package-source p0*))))))))))))))
+
 (test-assert "options->transformation, with-input"
   (let* ((p (dummy-package "guix.scm"
               (inputs `(("foo" ,(specification->package "coreutils"))