diff options
| -rw-r--r-- | guix/scripts/build.scm | 25 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 4 | ||||
| -rw-r--r-- | tests/scripts-build.scm | 261 |
6 files changed, 148 insertions, 156 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 65a125263d..4b86047587 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -233,7 +233,7 @@ matching URIs given in SOURCES." (string-drop uri (+ 1 index)))))))) sources)) - (lambda (store obj) + (lambda (obj) (let loop ((sources new-sources) (result '())) (match obj @@ -276,7 +276,7 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (lambda (old new) new))) (rewrite (package-input-rewriting/spec replacements))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj)))) @@ -292,7 +292,7 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them." (let* ((replacements (evaluate-replacement-specs replacement-specs set-replacement)) (rewrite (package-input-rewriting/spec replacements))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj)))) @@ -349,7 +349,7 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using (let* ((replacements (evaluate-git-replacement-specs replacement-specs replace)) (rewrite (package-input-rewriting/spec replacements))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj)))) @@ -377,7 +377,7 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using (let* ((replacements (evaluate-git-replacement-specs replacement-specs replace)) (rewrite (package-input-rewriting/spec replacements))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj)))) @@ -405,7 +405,7 @@ a checkout of the Git repository at the given URL." (define rewrite (package-input-rewriting/spec replacements)) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj))) @@ -478,7 +478,7 @@ the equal sign." spec)))) replacement-specs)) - (lambda (store obj) + (lambda (obj) (if (package? obj) (or (any (match-lambda ((bottom . toolchain) @@ -516,7 +516,7 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field." (cons spec package-with-debug-info)) specs))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj))) @@ -535,7 +535,7 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field." (cons spec package-without-tests)) specs))) - (lambda (store obj) + (lambda (obj) (if (package? obj) (rewrite obj) obj))) @@ -646,7 +646,7 @@ derivation, etc.), applies the transformations specified by OPTS." applicable)) ,@(package-properties p))))) - (lambda (store obj) + (lambda (obj) (define (tagged-object new) (if (and (not (eq? obj new)) (package? new) (not (null? applicable))) @@ -656,7 +656,7 @@ derivation, etc.), applies the transformations specified by OPTS." (tagged-object (fold (match-lambda* (((name value transform) obj) - (let ((new (transform store obj))) + (let ((new (transform obj))) (when (eq? new obj) (warning (G_ "transformation '~a' had no effect on ~a~%") name @@ -1113,8 +1113,7 @@ build." (systems systems))) (define things-to-build - (map (cut transform store <>) - (options->things-to-build opts))) + (map transform (options->things-to-build opts))) (define (compute-derivation obj system) ;; Compute the derivation of OBJ for SYSTEM. diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 91ce2af9bb..4db6c5d2d7 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -320,7 +320,7 @@ for the corresponding packages." (manifest-entry-output e2)))) (define transform - (cut (options->transformation opts) store <>)) + (options->transformation opts)) (define* (package->manifest-entry* package #:optional (output "out")) (package->manifest-entry (transform package) output)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 0d11fc9795..6b2e60d7e2 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -582,11 +582,11 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (('argument . (? store-path? item)) item) (('argument . spec) - (transform store - (specification->package spec))) + (transform + (specification->package spec))) (('expression . exp) - (transform store - (read/eval-package-expression exp))) + (transform + (read/eval-package-expression exp))) (_ #f)) opts))) (run-with-store store diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 8e694edbbe..9fe5a24aee 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1132,9 +1132,9 @@ Create a bundle of PACKAGE.\n")) (let* ((transform (options->transformation opts)) (packages (map (match-lambda (((? package? package) output) - (list (transform store package) output)) + (list (transform package) output)) ((? package? package) - (list (transform store package) "out"))) + (list (transform package) "out"))) (reverse (filter-map maybe-package-argument opts)))) (manifests (filter-map (match-lambda diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index ba62d98682..5599e26f5d 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -223,7 +223,7 @@ non-zero relevance score." (($ <manifest-entry> name version output (? string? path)) (match (find-best-packages-by-name name #f) ((pkg . rest) - (let* ((pkg (transform store pkg)) + (let* ((pkg (transform pkg)) (candidate-version (package-version pkg))) (match (package-superseded pkg) ((? package? new) @@ -871,7 +871,7 @@ processed, #f otherwise." (define transform (options->transformation opts)) (define (transform-entry entry) - (let ((item (transform store (manifest-entry-item entry)))) + (let ((item (transform (manifest-entry-item entry)))) (manifest-entry-with-transformations (manifest-entry (inherit entry) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 3a49759567..d56e02b452 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -19,6 +19,7 @@ (define-module (test-scripts-build) #:use-module (guix tests) #:use-module (guix store) + #:use-module ((guix gexp) #:select (lower-object)) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix git-download) @@ -42,8 +43,7 @@ (test-assert "options->transformation, no transformations" (let ((p (dummy-package "foo")) (t (options->transformation '()))) - (with-store store - (eq? (t store p) p)))) + (eq? (t p) p))) (test-assert "options->transformation, with-source" ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should @@ -52,9 +52,11 @@ (s (search-path %load-path "guix.scm")) (t (options->transformation `((with-source . ,s))))) (with-store store - (let ((new (t store p))) + (let* ((new (t p)) + (source (run-with-store store + (lower-object (package-source new))))) (and (not (eq? new p)) - (string=? (package-source new) + (string=? source (add-to-store store "guix.scm" #t "sha256" s))))))) @@ -64,12 +66,9 @@ (let* ((p (dummy-package "guix.scm" (replacement coreutils))) (s (search-path %load-path "guix.scm")) (t (options->transformation `((with-source . ,s))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (string=? (package-source new) - (add-to-store store "guix.scm" #t "sha256" s)) - (not (package-replacement new))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (not (package-replacement new)))))) (test-assert "options->transformation, with-source, with version" ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source @@ -82,11 +81,13 @@ (t (options->transformation `((with-source . ,f))))) (copy-file s f) (with-store store - (let ((new (t store p))) + (let* ((new (t p)) + (source (run-with-store store + (lower-object (package-source new))))) (and (not (eq? new p)) (string=? (package-name new) (package-name p)) (string=? (package-version new) "42.0") - (string=? (package-source new) + (string=? source (add-to-store store (basename f) #t "sha256" f)))))))))) @@ -95,13 +96,12 @@ (let* ((p (dummy-package "foobar")) (s (search-path %load-path "guix.scm")) (t (options->transformation `((with-source . ,s))))) - (with-store store - (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")))))) + (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"))))) (test-assert "options->transformation, with-source, PKG=URI" (let* ((p (dummy-package "foo")) @@ -109,12 +109,14 @@ (f (string-append "foo=" s)) (t (options->transformation `((with-source . ,f))))) (with-store store - (let ((new (t store p))) + (let* ((new (t p)) + (source (run-with-store store + (lower-object (package-source new))))) (and (not (eq? new p)) (string=? (package-name new) (package-name p)) (string=? (package-version new) (package-version p)) - (string=? (package-source new) + (string=? source (add-to-store store (basename s) #t "sha256" s))))))) @@ -124,11 +126,13 @@ (f (string-append "foo@42.0=" s)) (t (options->transformation `((with-source . ,f))))) (with-store store - (let ((new (t store p))) + (let* ((new (t p)) + (source (run-with-store store + (lower-object (package-source new))))) (and (not (eq? new p)) (string=? (package-name new) (package-name p)) (string=? (package-version new) "42.0") - (string=? (package-source new) + (string=? source (add-to-store store (basename s) #t "sha256" s))))))) @@ -140,20 +144,19 @@ (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-input . "coreutils=busybox") (with-input . "grep=findutils"))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2) ("baz" dep3)) - (and (string=? (package-full-name dep1) - (package-full-name busybox)) - (string=? (package-full-name dep2) - (package-full-name findutils)) - (string=? (package-name dep3) "chbouib") - (match (package-native-inputs dep3) - ((("x" dep)) - (string=? (package-full-name dep) - (package-full-name findutils)))))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2) ("baz" dep3)) + (and (string=? (package-full-name dep1) + (package-full-name busybox)) + (string=? (package-full-name dep2) + (package-full-name findutils)) + (string=? (package-name dep3) "chbouib") + (match (package-native-inputs dep3) + ((("x" dep)) + (string=? (package-full-name dep) + (package-full-name findutils))))))))))) (test-assert "options->transformation, with-graft" (let* ((p (dummy-package "guix.scm" @@ -161,23 +164,22 @@ ("bar" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-graft . "grep=findutils"))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2)) - (and (string=? (package-full-name dep1) - (package-full-name grep)) - (string=? (package-full-name (package-replacement dep1)) - (package-full-name findutils)) - (string=? (package-name dep2) "chbouib") - (match (package-native-inputs dep2) - ((("x" dep)) - (with-store store - (string=? (derivation-file-name - (package-derivation store findutils)) - (derivation-file-name - (package-derivation store dep)))))))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-full-name (package-replacement dep1)) + (package-full-name findutils)) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep)) + (with-store store + (string=? (derivation-file-name + (package-derivation store findutils)) + (derivation-file-name + (package-derivation store dep))))))))))))) (test-equal "options->transformation, with-branch" (git-checkout (url "https://example.org") @@ -193,15 +195,14 @@ (commit "cabba9e"))) (sha256 #f))))))))) (t (options->transformation '((with-branch . "chbouib=devel"))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2)) - (and (string=? (package-full-name dep1) - (package-full-name grep)) - (string=? (package-name dep2) "chbouib") - (package-source dep2))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2)))))))) (test-equal "options->transformation, with-commit" (git-checkout (url "https://example.org") @@ -217,15 +218,14 @@ (commit "cabba9e"))) (sha256 #f))))))))) (t (options->transformation '((with-commit . "chbouib=abcdef"))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2)) - (and (string=? (package-full-name dep1) - (package-full-name grep)) - (string=? (package-name dep2) "chbouib") - (package-source dep2))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2)))))))) (test-equal "options->transformation, with-git-url" (let ((source (git-checkout (url "https://example.org") @@ -236,17 +236,16 @@ ("bar" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-git-url . "grep=https://example.org"))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2)) - (and (string=? (package-full-name dep1) - (package-full-name grep)) - (string=? (package-name dep2) "chbouib") - (match (package-native-inputs dep2) - ((("x" dep3)) - (map package-source (list dep1 dep3)))))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3))))))))))) (test-equal "options->transformation, with-git-url + with-branch" ;; Combine the two options and make sure the 'with-branch' transformation @@ -263,16 +262,15 @@ (reverse '((with-git-url . "grep=https://example.org") (with-branch . "grep=BRANCH")))))) - (with-store store - (let ((new (t store p))) - (and (not (eq? new p)) - (match (package-inputs new) - ((("foo" dep1) ("bar" dep2)) - (and (string=? (package-name dep1) "grep") - (string=? (package-name dep2) "chbouib") - (match (package-native-inputs dep2) - ((("x" dep3)) - (map package-source (list dep1 dep3)))))))))))) + (let ((new (t p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-name dep1) "grep") + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3))))))))))) (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain")) "Return true if P depends on TOOLCHAIN instead of the default tool chain." @@ -302,21 +300,20 @@ ;; Here we check that the transformation applies to DEP0 and all its ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on. - (with-store store - (let ((new (t store p))) - (and (depends-on-toolchain? new "gcc-toolchain") - (match (bag-build-inputs (package->bag new)) - ((("foo" dep0) ("bar" dep1) _ ...) - (and (depends-on-toolchain? dep1 "gcc-toolchain") - (not (depends-on-toolchain? dep0 "gcc-toolchain")) - (string=? (package-full-name dep0) - (package-full-name grep)) - (match (bag-build-inputs (package->bag dep1)) - ((("x" dep) _ ...) - (and (depends-on-toolchain? dep "gcc-toolchain") - (match (bag-build-inputs (package->bag dep)) - ((("y" dep) _ ...) ;this one is unchanged - (eq? dep grep)))))))))))))) + (let ((new (t p))) + (and (depends-on-toolchain? new "gcc-toolchain") + (match (bag-build-inputs (package->bag new)) + ((("foo" dep0) ("bar" dep1) _ ...) + (and (depends-on-toolchain? dep1 "gcc-toolchain") + (not (depends-on-toolchain? dep0 "gcc-toolchain")) + (string=? (package-full-name dep0) + (package-full-name grep)) + (match (bag-build-inputs (package->bag dep1)) + ((("x" dep) _ ...) + (and (depends-on-toolchain? dep "gcc-toolchain") + (match (bag-build-inputs (package->bag dep)) + ((("y" dep) _ ...) ;this one is unchanged + (eq? dep grep))))))))))))) (test-equal "options->transformation, with-c-toolchain twice" (package-full-name grep) @@ -330,23 +327,21 @@ (t (options->transformation '((with-c-toolchain . "chbouib=clang-toolchain") (with-c-toolchain . "stuff=clang-toolchain"))))) - (with-store store - (let ((new (t store p))) - (and (depends-on-toolchain? new "clang-toolchain") - (match (bag-build-inputs (package->bag new)) - ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...) - (and (depends-on-toolchain? dep0 "clang-toolchain") - (depends-on-toolchain? dep1 "clang-toolchain") - (not (depends-on-toolchain? dep2 "clang-toolchain")) - (package-full-name dep2))))))))) + (let ((new (t p))) + (and (depends-on-toolchain? new "clang-toolchain") + (match (bag-build-inputs (package->bag new)) + ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...) + (and (depends-on-toolchain? dep0 "clang-toolchain") + (depends-on-toolchain? dep1 "clang-toolchain") + (not (depends-on-toolchain? dep2 "clang-toolchain")) + (package-full-name dep2)))))))) (test-assert "options->transformation, with-c-toolchain, no effect" (let ((p (dummy-package "thingie")) (t (options->transformation '((with-c-toolchain . "does-not-exist=gcc-toolchain"))))) ;; When it has no effect, '--with-c-toolchain' returns P. - (with-store store - (eq? (t store p) p)))) + (eq? (t p) p))) (test-equal "options->transformation, with-debug-info" '(#:strip-binaries? #f) @@ -357,13 +352,12 @@ ("bar" ,grep))))) (t (options->transformation '((with-debug-info . "chbouib"))))) - (with-store store - (let ((new (t store p))) - (match (package-inputs new) - ((("foo" dep0) ("bar" dep1)) - (and (string=? (package-full-name dep1) - (package-full-name grep)) - (package-arguments (package-replacement dep0))))))))) + (let ((new (t p))) + (match (package-inputs new) + ((("foo" dep0) ("bar" dep1)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (package-arguments (package-replacement dep0)))))))) (test-assert "options->transformation, without-tests" (let* ((dep (dummy-package "dep")) @@ -371,14 +365,13 @@ (inputs `(("dep" ,dep))))) (t (options->transformation '((without-tests . "dep") (without-tests . "tar"))))) - (with-store store - (let ((new (t store p))) - (match (bag-direct-inputs (package->bag new)) - ((("dep" dep) ("tar" tar) _ ...) - ;; TODO: Check whether TAR has #:tests? #f when transformations - ;; apply to implicit inputs. - (equal? (package-arguments dep) - '(#:tests? #f)))))))) + (let ((new (t p))) + (match (bag-direct-inputs (package->bag new)) + ((("dep" dep) ("tar" tar) _ ...) + ;; TODO: Check whether TAR has #:tests? #f when transformations + ;; apply to implicit inputs. + (equal? (package-arguments dep) + '(#:tests? #f))))))) (test-end) |