diff options
| -rw-r--r-- | doc/guix.texi | 7 | ||||
| -rw-r--r-- | guix/transformations.scm | 74 | ||||
| -rw-r--r-- | tests/transformations.scm | 32 |
3 files changed, 68 insertions, 45 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 84f7064faf..535c8cdfc3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12364,14 +12364,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 @@ the new package's version number from URI." ;;; Transformations. ;;; -(define (transform-package-source sources) - "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)) +(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 #\=))) - (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))))) + (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 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 @@ "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 @@ (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")) |