From 2d2f6c97ad1deeb2fc8a214d992c7894a7c5e293 Mon Sep 17 00:00:00 2001 From: Jesse Gibbons Date: Thu, 3 Sep 2020 17:45:08 -0600 Subject: [PATCH 1/2] guix: Make --with-source option recursive * guix/scripts/build.scm: (transform-package-inputs/source): new function (evaluate-source-replacement-specs): new function (%transformations): change with-source to use evaluate-source-replacement-specs * doc/guix.texi (Package Transformation Options): document it. * tests/scripts-build.scm: (options->transformation, with-source, no matches): adjust to new expectations. (options->transformation, with-source, recursive): new test. --- doc/guix.texi | 4 +-- guix/scripts/build.scm | 61 ++++++++++++++++++++++++++++++++++++++--- tests/scripts-build.scm | 25 +++++++++++++++-- 3 files changed, 81 insertions(+), 9 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 82241b010a..3470ccc99c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9142,8 +9142,8 @@ without having to type in the definitions of package variants @itemx --with-source=@var{package}=@var{source} @itemx --with-source=@var{package}@@@var{version}=@var{source} Use @var{source} as the source of @var{package}, and @var{version} as -its version number. -@var{source} must be a file name or a URL, as for @command{guix +its version number. This replacement is applied recursively on all +dependencies. @var{source} must be a file name or a URL, as for @command{guix download} (@pxref{Invoking guix download}). When @var{package} is omitted, diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 38e0516c95..a899f18a61 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -201,9 +201,9 @@ matching URIs given in SOURCES." (#f ;; Determine the package name and version from URI. (call-with-values - (lambda () - (hyphen-package-name->name+version - (tarball-base-name (basename uri)))) + (lambda () + (hyphen-package-name->name+version + (tarball-base-name (basename uri)))) (lambda (name version) (list name version uri)))) (index @@ -280,6 +280,26 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them." (rewrite obj) obj)))) +(define (transform-package-inputs/source replacement-specs) + "Return a procedure that, when passed a package, replaces its direct +dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of +strings like \"guile=/path/to/source\" or +\"guile=https://www.example.com/guile-source.tar.gz\" meaning that, any +dependency on a package called \"guile\" must be replaced with a dependency on a +\"guile\" built with the source at the specified location. SPECS may also +simply be a file location, in which case the package name and version are parsed +from the file name." + (lambda (store obj) + (let* ((replacements (evaluate-source-replacement-specs replacement-specs + (lambda* (old file #:optional version) + (package-with-source store old file version)))) + (rewrite (package-input-rewriting/spec replacements)) + (rewrite* (lambda (obj) + (rewrite obj)))) + (if (package? obj) + (rewrite* obj) + obj)))) + (define %not-equal (char-set-complement (char-set #\=))) @@ -314,6 +334,39 @@ syntax, or if a package it refers to could not be found." (leave (G_ "invalid replacement specification: ~s~%") spec)))) specs)) +(define (evaluate-source-replacement-specs specs proc) + "Parse SPECS, a list of strings like \"guile=/path/to/source\", and return a +list of package pairs, where (PROC PACKAGE URL) returns the replacement package. +Raise an error if an element of SPECS uses invalid syntax, or if a package it +refers to could not be found." + (define* (replacement file #:optional version) + (lambda (old) + (proc old file version))) + (map (lambda (spec) + (match (string-tokenize spec %not-equal) + ((package-spec file) + (let* ((spec-list (call-with-values + (lambda () + (package-specification->name+version+output package-spec)) + list)) + (name (list-ref spec-list 0)) + (version (list-ref spec-list 1))) + (cons name (replacement file version)))) + ((file) + (let* ((package-spec + (call-with-values + (lambda () + (hyphen-package-name->name+version + (tarball-base-name (basename file)))) + (lambda (name version) + (cons name version)))) + (name (car package-spec)) + (version (cdr package-spec))) + (cons name (replacement file version)))) + (_ + (leave (G_ "invalid source replacement specification: ~s~%") spec)))) + specs)) + (define (transform-package-source-branch replacement-specs) "Return a procedure that, when passed a package, replaces its direct dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of @@ -398,7 +451,7 @@ a checkout of the Git repository at the given URL." ;; key used in the option alist, and the cdr is the transformation ;; procedure; it is called with two arguments: the store, and a list of ;; things to build. - `((with-source . ,transform-package-source) + `((with-source . ,transform-package-inputs/source) (with-input . ,transform-package-inputs) (with-graft . ,transform-package-inputs/graft) (with-branch . ,transform-package-source-branch) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 32876e956a..40d7d03637 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -94,9 +94,9 @@ (let* ((port (open-output-string)) (new (parameterize ((guix-warning-port port)) (t store p)))) - (and (eq? new p) - (string-contains (get-output-string port) - "had no effect")))))) + (and (eq? (package-version new) (package-version p)) + (eq? (package-name new) (package-name p)) + (eq? (package-source new) (package-source p))))))) (test-assert "options->transformation, with-source, PKG=URI" (let* ((p (dummy-package "foo")) @@ -127,6 +127,25 @@ (add-to-store store (basename s) #t "sha256" s))))))) +(test-assert "options->transformation, with-source, recursive" + (let* ((q (dummy-package "foo")) + (p (dummy-package "guix.scm" + (inputs `(("foo" ,q))))) + (s (search-path %load-path "guix.scm")) + (f (string-append "foo@42.0=" s)) + (t (options->transformation `((with-source . ,f))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1)) + (and + (string=? (package-name dep1) "foo") + (string=? (package-version dep1) "42.0") + (string=? (package-source dep1) + (add-to-store store (basename s) #t + "sha256" s)))))))))) + (test-assert "options->transformation, with-input" (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,(specification->package "coreutils")) -- 2.28.0