transformations: '--with-source' now operates in depth.

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.
This commit is contained in:
Ludovic Courtès 2022-09-23 19:04:29 +02:00 committed by Ludovic Courtès
parent 1bf18818c6
commit 28ade1bab2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 68 additions and 45 deletions

View file

@ -12364,14 +12364,15 @@ one provided by the distribution. The example below downloads
the @code{ed} package: the @code{ed} package:
@example @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 @end example
As a developer, @option{--with-source} makes it easy to test release 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 @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 @end example
@dots{} or to build from a checkout in a pristine environment: @dots{} or to build from a checkout in a pristine environment:

View file

@ -129,42 +129,46 @@ (define* (package-with-source p uri #:optional version)
;;; Transformations. ;;; Transformations.
;;; ;;;
(define (transform-package-source sources) (define (evaluate-source-replacement-specs specs)
"Return a transformation procedure that replaces package sources with the "Parse SPECS, a list of strings like \"guile=/tmp/guile-4.2.tar.gz\" or just
matching URIs given in SOURCES." \"/tmp/guile-4.2.tar.gz\" and return a list of package spec/procedure pairs as
(define new-sources expected by 'package-input-rewriting/spec'. Raise an error if an element of
(map (lambda (uri) SPECS uses invalid syntax."
(match (string-index uri #\=) (define not-equal
(#f (char-set-complement (char-set #\=)))
;; 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) (map (lambda (spec)
(let loop ((sources new-sources) (match (string-tokenize spec not-equal)
(result '())) ((uri)
(match obj (let* ((base (tarball-base-name (basename uri)))
((? package? p) (name (hyphen-package-name->name+version base)))
(match (assoc-ref sources (package-name p)) (cons name
((version source) (lambda (old)
(package-with-source p source version)) (package-with-source old uri)))))
(#f ((spec uri)
p))) (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)))))
(_ (_
obj))))) (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 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) (define (evaluate-replacement-specs specs proc)
"Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list

View file

@ -103,16 +103,11 @@ (define-module (test-transformations)
"sha256" f)))))))))) "sha256" f))))))))))
(test-assert "options->transformation, with-source, no matches" (test-assert "options->transformation, with-source, no matches"
;; When a transformation in not applicable, a warning must be raised.
(let* ((p (dummy-package "foobar")) (let* ((p (dummy-package "foobar"))
(s (search-path %load-path "guix.scm")) (s (search-path %load-path "guix.scm"))
(t (options->transformation `((with-source . ,s))))) (t (options->transformation `((with-source . ,s)))))
(let* ((port (open-output-string)) (eq? (package-source (t p))
(new (parameterize ((guix-warning-port port)) (package-source p))))
(t p))))
(and (eq? new p)
(string-contains (get-output-string port)
"had no effect")))))
(test-assert "options->transformation, with-source, PKG=URI" (test-assert "options->transformation, with-source, PKG=URI"
(let* ((p (dummy-package "foo")) (let* ((p (dummy-package "foo"))
@ -147,6 +142,29 @@ (define-module (test-transformations)
(add-to-store store (basename s) #t (add-to-store store (basename s) #t
"sha256" s))))))) "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" (test-assert "options->transformation, with-input"
(let* ((p (dummy-package "guix.scm" (let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,(specification->package "coreutils")) (inputs `(("foo" ,(specification->package "coreutils"))