amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix build: 'options->transformation' no longer takes a 'store' parameter.

Browse source 
* guix/scripts/build.scm (transform-package-source)
(transform-package-inputs, transform-package-inputs/graft)
(transform-package-source-branch, transform-package-source-commit)
(transform-package-source-git-url, transform-package-toolchain)
(transform-package-with-debug-info, transform-package-tests): Remove
'store' parameter.
(options->transformation, options->derivations): Adjust accordingly.
* guix/scripts/environment.scm (options/resolve-packages): Likewise.
* guix/scripts/graph.scm (guix-graph): Likewise.
* guix/scripts/pack.scm (guix-pack): Likewise.
* guix/scripts/package.scm (transaction-upgrade-entry): Likewise.
(process-actions): Likewise.
* tests/scripts-build.scm ("options->transformation, no transformations")
("options->transformation, with-source, replacement"):
Adjust tests.
("options->transformation, with-source")
("options->transformation, with-source, with version")
("options->transformation, with-source, PKG=URI"): Use 'lower-object' to
compute the store file name of the source.
("options->transformation, with-source, no matches"): Remove
'with-store' and adjust accordingly.
("options->transformation, with-input"): Likewise.
("options->transformation, with-graft"): Likewise.
("options->transformation, with-branch"): Likewise.
("options->transformation, with-commit"): Likewise.
("options->transformation, with-git-url"): Likewise.
("options->transformation, with-git-url + with-branch"): Likewise.
("options->transformation, with-c-toolchain"): Likewise.
("options->transformation, with-c-toolchain twice"): Likewise.
("options->transformation, with-c-toolchain, no effect"): Likewise.
("options->transformation, with-debug-info"): Likewise.
("options->transformation, without-tests"): Likewise.
This commit is contained in:
Ludovic Courtès 2020-10-28 23:35:49 +01:00
parent e72cc79263
commit 1ae33664a6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
6 changed files with 148 additions and 156 deletions
Download patch file Download diff file Expand all files Collapse all files

25
guix/scripts/build.scm
View file

@ -233,7 +233,7 @@ matching URIs given in SOURCES."
(string-drop uri (+ 1 index)))))))) (string-drop uri (+ 1 index))))))))
sources)) sources))
(lambda (store obj) (lambda (obj)
(let loop ((sources new-sources) (let loop ((sources new-sources)
(result '())) (result '()))
(match obj (match obj
@ -276,7 +276,7 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of
(lambda (old new) (lambda (old new)
new))) new)))
(rewrite (package-input-rewriting/spec replacements))) (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
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 (let* ((replacements (evaluate-replacement-specs replacement-specs
set-replacement)) set-replacement))
(rewrite (package-input-rewriting/spec replacements))) (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
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 (let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace)) replace))
(rewrite (package-input-rewriting/spec replacements))) (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
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 (let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace)) replace))
(rewrite (package-input-rewriting/spec replacements))) (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
obj)))) obj))))
@ -405,7 +405,7 @@ a checkout of the Git repository at the given URL."
(define rewrite (define rewrite
(package-input-rewriting/spec replacements)) (package-input-rewriting/spec replacements))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
obj))) obj)))
@ -478,7 +478,7 @@ the equal sign."
spec)))) spec))))
replacement-specs)) replacement-specs))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(or (any (match-lambda (or (any (match-lambda
((bottom . toolchain) ((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)) (cons spec package-with-debug-info))
specs))) specs)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
obj))) obj)))
@ -535,7 +535,7 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
(cons spec package-without-tests)) (cons spec package-without-tests))
specs))) specs)))
(lambda (store obj) (lambda (obj)
(if (package? obj) (if (package? obj)
(rewrite obj) (rewrite obj)
obj))) obj)))
@ -646,7 +646,7 @@ derivation, etc.), applies the transformations specified by OPTS."
applicable)) applicable))
,@(package-properties p))))) ,@(package-properties p)))))
(lambda (store obj) (lambda (obj)
(define (tagged-object new) (define (tagged-object new)
(if (and (not (eq? obj new)) (if (and (not (eq? obj new))
(package? new) (not (null? applicable))) (package? new) (not (null? applicable)))
@ -656,7 +656,7 @@ derivation, etc.), applies the transformations specified by OPTS."
(tagged-object (tagged-object
(fold (match-lambda* (fold (match-lambda*
(((name value transform) obj) (((name value transform) obj)
(let ((new (transform store obj))) (let ((new (transform obj)))
(when (eq? new obj) (when (eq? new obj)
(warning (G_ "transformation '~a' had no effect on ~a~%") (warning (G_ "transformation '~a' had no effect on ~a~%")
name name
@ -1113,8 +1113,7 @@ build."
(systems systems))) (systems systems)))
(define things-to-build (define things-to-build
(map (cut transform store <>) (map transform (options->things-to-build opts)))
(options->things-to-build opts)))
(define (compute-derivation obj system) (define (compute-derivation obj system)
;; Compute the derivation of OBJ for SYSTEM. ;; Compute the derivation of OBJ for SYSTEM.

2
guix/scripts/environment.scm
View file

@ -320,7 +320,7 @@ for the corresponding packages."
(manifest-entry-output e2)))) (manifest-entry-output e2))))
(define transform (define transform
(cut (options->transformation opts) store <>)) (options->transformation opts))
(define* (package->manifest-entry* package #:optional (output "out")) (define* (package->manifest-entry* package #:optional (output "out"))
(package->manifest-entry (transform package) output)) (package->manifest-entry (transform package) output))

8
guix/scripts/graph.scm
View file

@ -582,11 +582,11 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
(('argument . (? store-path? item)) (('argument . (? store-path? item))
item) item)
(('argument . spec) (('argument . spec)
(transform store (transform
(specification->package spec))) (specification->package spec)))
(('expression . exp) (('expression . exp)
(transform store (transform
(read/eval-package-expression exp))) (read/eval-package-expression exp)))
(_ #f)) (_ #f))
opts))) opts)))
(run-with-store store (run-with-store store

4
guix/scripts/pack.scm
View file

@ -1132,9 +1132,9 @@ Create a bundle of PACKAGE.\n"))
(let* ((transform (options->transformation opts)) (let* ((transform (options->transformation opts))
(packages (map (match-lambda (packages (map (match-lambda
(((? package? package) output) (((? package? package) output)
(list (transform store package) output)) (list (transform package) output))
((? package? package) ((? package? package)
(list (transform store package) "out"))) (list (transform package) "out")))
(reverse (reverse
(filter-map maybe-package-argument opts)))) (filter-map maybe-package-argument opts))))
(manifests (filter-map (match-lambda (manifests (filter-map (match-lambda

4
guix/scripts/package.scm
View file

@ -223,7 +223,7 @@ non-zero relevance score."
(($ <manifest-entry> name version output (? string? path)) (($ <manifest-entry> name version output (? string? path))
(match (find-best-packages-by-name name #f) (match (find-best-packages-by-name name #f)
((pkg . rest) ((pkg . rest)
(let* ((pkg (transform store pkg)) (let* ((pkg (transform pkg))
(candidate-version (package-version pkg))) (candidate-version (package-version pkg)))
(match (package-superseded pkg) (match (package-superseded pkg)
((? package? new) ((? package? new)
@ -871,7 +871,7 @@ processed, #f otherwise."
(define transform (options->transformation opts)) (define transform (options->transformation opts))
(define (transform-entry entry) (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-with-transformations
(manifest-entry (manifest-entry
(inherit entry) (inherit entry)

261
tests/scripts-build.scm
View file

@ -19,6 +19,7 @@
(define-module (test-scripts-build) (define-module (test-scripts-build)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix git-download) #:use-module (guix git-download)
@ -42,8 +43,7 @@
(test-assert "options->transformation, no transformations" (test-assert "options->transformation, no transformations"
(let ((p (dummy-package "foo")) (let ((p (dummy-package "foo"))
(t (options->transformation '()))) (t (options->transformation '())))
(with-store store (eq? (t p) p)))
(eq? (t store p) p))))
(test-assert "options->transformation, with-source" (test-assert "options->transformation, with-source"
;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
@ -52,9 +52,11 @@
(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)))))
(with-store store (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)) (and (not (eq? new p))
(string=? (package-source new) (string=? source
(add-to-store store "guix.scm" #t (add-to-store store "guix.scm" #t
"sha256" s))))))) "sha256" s)))))))
@ -64,12 +66,9 @@
(let* ((p (dummy-package "guix.scm" (replacement coreutils))) (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
(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)))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (not (package-replacement new))))))
(string=? (package-source new)
(add-to-store store "guix.scm" #t "sha256" s))
(not (package-replacement new)))))))
(test-assert "options->transformation, with-source, with version" (test-assert "options->transformation, with-source, with version"
;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
@ -82,11 +81,13 @@
(t (options->transformation `((with-source . ,f))))) (t (options->transformation `((with-source . ,f)))))
(copy-file s f) (copy-file s f)
(with-store store (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)) (and (not (eq? new p))
(string=? (package-name new) (package-name p)) (string=? (package-name new) (package-name p))
(string=? (package-version new) "42.0") (string=? (package-version new) "42.0")
(string=? (package-source new) (string=? source
(add-to-store store (basename f) #t (add-to-store store (basename f) #t
"sha256" f)))))))))) "sha256" f))))))))))
@ -95,13 +96,12 @@
(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)))))
(with-store store (let* ((port (open-output-string))
(let* ((port (open-output-string)) (new (parameterize ((guix-warning-port port))
(new (parameterize ((guix-warning-port port)) (t p))))
(t store p)))) (and (eq? new p)
(and (eq? new p) (string-contains (get-output-string port)
(string-contains (get-output-string port) "had no effect")))))
"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"))
@ -109,12 +109,14 @@
(f (string-append "foo=" s)) (f (string-append "foo=" s))
(t (options->transformation `((with-source . ,f))))) (t (options->transformation `((with-source . ,f)))))
(with-store store (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)) (and (not (eq? new p))
(string=? (package-name new) (package-name p)) (string=? (package-name new) (package-name p))
(string=? (package-version new) (string=? (package-version new)
(package-version p)) (package-version p))
(string=? (package-source new) (string=? source
(add-to-store store (basename s) #t (add-to-store store (basename s) #t
"sha256" s))))))) "sha256" s)))))))
@ -124,11 +126,13 @@
(f (string-append "foo@42.0=" s)) (f (string-append "foo@42.0=" s))
(t (options->transformation `((with-source . ,f))))) (t (options->transformation `((with-source . ,f)))))
(with-store store (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)) (and (not (eq? new p))
(string=? (package-name new) (package-name p)) (string=? (package-name new) (package-name p))
(string=? (package-version new) "42.0") (string=? (package-version new) "42.0")
(string=? (package-source new) (string=? source
(add-to-store store (basename s) #t (add-to-store store (basename s) #t
"sha256" s))))))) "sha256" s)))))))
@ -140,20 +144,19 @@
(native-inputs `(("x" ,grep))))))))) (native-inputs `(("x" ,grep)))))))))
(t (options->transformation '((with-input . "coreutils=busybox") (t (options->transformation '((with-input . "coreutils=busybox")
(with-input . "grep=findutils"))))) (with-input . "grep=findutils")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2) ("baz" dep3))
((("foo" dep1) ("bar" dep2) ("baz" dep3)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name busybox))
(package-full-name busybox)) (string=? (package-full-name dep2)
(string=? (package-full-name dep2) (package-full-name findutils))
(package-full-name findutils)) (string=? (package-name dep3) "chbouib")
(string=? (package-name dep3) "chbouib") (match (package-native-inputs dep3)
(match (package-native-inputs dep3) ((("x" dep))
((("x" dep)) (string=? (package-full-name dep)
(string=? (package-full-name dep) (package-full-name findutils)))))))))))
(package-full-name findutils))))))))))))
(test-assert "options->transformation, with-graft" (test-assert "options->transformation, with-graft"
(let* ((p (dummy-package "guix.scm" (let* ((p (dummy-package "guix.scm"
@ -161,23 +164,22 @@
("bar" ,(dummy-package "chbouib" ("bar" ,(dummy-package "chbouib"
(native-inputs `(("x" ,grep))))))))) (native-inputs `(("x" ,grep)))))))))
(t (options->transformation '((with-graft . "grep=findutils"))))) (t (options->transformation '((with-graft . "grep=findutils")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2))
((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name grep))
(package-full-name grep)) (string=? (package-full-name (package-replacement dep1))
(string=? (package-full-name (package-replacement dep1)) (package-full-name findutils))
(package-full-name findutils)) (string=? (package-name dep2) "chbouib")
(string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2)
(match (package-native-inputs dep2) ((("x" dep))
((("x" dep)) (with-store store
(with-store store (string=? (derivation-file-name
(string=? (derivation-file-name (package-derivation store findutils))
(package-derivation store findutils)) (derivation-file-name
(derivation-file-name (package-derivation store dep)))))))))))))
(package-derivation store dep))))))))))))))
(test-equal "options->transformation, with-branch" (test-equal "options->transformation, with-branch"
(git-checkout (url "https://example.org") (git-checkout (url "https://example.org")
@ -193,15 +195,14 @@
(commit "cabba9e"))) (commit "cabba9e")))
(sha256 #f))))))))) (sha256 #f)))))))))
(t (options->transformation '((with-branch . "chbouib=devel"))))) (t (options->transformation '((with-branch . "chbouib=devel")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2))
((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name grep))
(package-full-name grep)) (string=? (package-name dep2) "chbouib")
(string=? (package-name dep2) "chbouib") (package-source dep2))))))))
(package-source dep2)))))))))
(test-equal "options->transformation, with-commit" (test-equal "options->transformation, with-commit"
(git-checkout (url "https://example.org") (git-checkout (url "https://example.org")
@ -217,15 +218,14 @@
(commit "cabba9e"))) (commit "cabba9e")))
(sha256 #f))))))))) (sha256 #f)))))))))
(t (options->transformation '((with-commit . "chbouib=abcdef"))))) (t (options->transformation '((with-commit . "chbouib=abcdef")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2))
((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name grep))
(package-full-name grep)) (string=? (package-name dep2) "chbouib")
(string=? (package-name dep2) "chbouib") (package-source dep2))))))))
(package-source dep2)))))))))
(test-equal "options->transformation, with-git-url" (test-equal "options->transformation, with-git-url"
(let ((source (git-checkout (url "https://example.org") (let ((source (git-checkout (url "https://example.org")
@ -236,17 +236,16 @@
("bar" ,(dummy-package "chbouib" ("bar" ,(dummy-package "chbouib"
(native-inputs `(("x" ,grep))))))))) (native-inputs `(("x" ,grep)))))))))
(t (options->transformation '((with-git-url . "grep=https://example.org"))))) (t (options->transformation '((with-git-url . "grep=https://example.org")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2))
((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name grep))
(package-full-name grep)) (string=? (package-name dep2) "chbouib")
(string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2)
(match (package-native-inputs dep2) ((("x" dep3))
((("x" dep3)) (map package-source (list dep1 dep3)))))))))))
(map package-source (list dep1 dep3))))))))))))
(test-equal "options->transformation, with-git-url + with-branch" (test-equal "options->transformation, with-git-url + with-branch"
;; Combine the two options and make sure the 'with-branch' transformation ;; Combine the two options and make sure the 'with-branch' transformation
@ -263,16 +262,15 @@
(reverse '((with-git-url (reverse '((with-git-url
. "grep=https://example.org") . "grep=https://example.org")
(with-branch . "grep=BRANCH")))))) (with-branch . "grep=BRANCH"))))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (not (eq? new p))
(and (not (eq? new p)) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep1) ("bar" dep2))
((("foo" dep1) ("bar" dep2)) (and (string=? (package-name dep1) "grep")
(and (string=? (package-name dep1) "grep") (string=? (package-name dep2) "chbouib")
(string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2)
(match (package-native-inputs dep2) ((("x" dep3))
((("x" dep3)) (map package-source (list dep1 dep3)))))))))))
(map package-source (list dep1 dep3))))))))))))
(define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain")) (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain"))
"Return true if P depends on TOOLCHAIN instead of the default tool chain." "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 ;; Here we check that the transformation applies to DEP0 and all its
;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN
;; and the DEP0 that uses GCC-TOOLCHAIN, and so on. ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on.
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (depends-on-toolchain? new "gcc-toolchain")
(and (depends-on-toolchain? new "gcc-toolchain") (match (bag-build-inputs (package->bag new))
(match (bag-build-inputs (package->bag new)) ((("foo" dep0) ("bar" dep1) _ ...)
((("foo" dep0) ("bar" dep1) _ ...) (and (depends-on-toolchain? dep1 "gcc-toolchain")
(and (depends-on-toolchain? dep1 "gcc-toolchain") (not (depends-on-toolchain? dep0 "gcc-toolchain"))
(not (depends-on-toolchain? dep0 "gcc-toolchain")) (string=? (package-full-name dep0)
(string=? (package-full-name dep0) (package-full-name grep))
(package-full-name grep)) (match (bag-build-inputs (package->bag dep1))
(match (bag-build-inputs (package->bag dep1)) ((("x" dep) _ ...)
((("x" dep) _ ...) (and (depends-on-toolchain? dep "gcc-toolchain")
(and (depends-on-toolchain? dep "gcc-toolchain") (match (bag-build-inputs (package->bag dep))
(match (bag-build-inputs (package->bag dep)) ((("y" dep) _ ...) ;this one is unchanged
((("y" dep) _ ...) ;this one is unchanged (eq? dep grep)))))))))))))
(eq? dep grep))))))))))))))
(test-equal "options->transformation, with-c-toolchain twice" (test-equal "options->transformation, with-c-toolchain twice"
(package-full-name grep) (package-full-name grep)
@ -330,23 +327,21 @@
(t (options->transformation (t (options->transformation
'((with-c-toolchain . "chbouib=clang-toolchain") '((with-c-toolchain . "chbouib=clang-toolchain")
(with-c-toolchain . "stuff=clang-toolchain"))))) (with-c-toolchain . "stuff=clang-toolchain")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (and (depends-on-toolchain? new "clang-toolchain")
(and (depends-on-toolchain? new "clang-toolchain") (match (bag-build-inputs (package->bag new))
(match (bag-build-inputs (package->bag new)) ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...)
((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...) (and (depends-on-toolchain? dep0 "clang-toolchain")
(and (depends-on-toolchain? dep0 "clang-toolchain") (depends-on-toolchain? dep1 "clang-toolchain")
(depends-on-toolchain? dep1 "clang-toolchain") (not (depends-on-toolchain? dep2 "clang-toolchain"))
(not (depends-on-toolchain? dep2 "clang-toolchain")) (package-full-name dep2))))))))
(package-full-name dep2)))))))))
(test-assert "options->transformation, with-c-toolchain, no effect" (test-assert "options->transformation, with-c-toolchain, no effect"
(let ((p (dummy-package "thingie")) (let ((p (dummy-package "thingie"))
(t (options->transformation (t (options->transformation
'((with-c-toolchain . "does-not-exist=gcc-toolchain"))))) '((with-c-toolchain . "does-not-exist=gcc-toolchain")))))
;; When it has no effect, '--with-c-toolchain' returns P. ;; When it has no effect, '--with-c-toolchain' returns P.
(with-store store (eq? (t p) p)))
(eq? (t store p) p))))
(test-equal "options->transformation, with-debug-info" (test-equal "options->transformation, with-debug-info"
'(#:strip-binaries? #f) '(#:strip-binaries? #f)
@ -357,13 +352,12 @@
("bar" ,grep))))) ("bar" ,grep)))))
(t (options->transformation (t (options->transformation
'((with-debug-info . "chbouib"))))) '((with-debug-info . "chbouib")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (match (package-inputs new)
(match (package-inputs new) ((("foo" dep0) ("bar" dep1))
((("foo" dep0) ("bar" dep1)) (and (string=? (package-full-name dep1)
(and (string=? (package-full-name dep1) (package-full-name grep))
(package-full-name grep)) (package-arguments (package-replacement dep0))))))))
(package-arguments (package-replacement dep0)))))))))
(test-assert "options->transformation, without-tests" (test-assert "options->transformation, without-tests"
(let* ((dep (dummy-package "dep")) (let* ((dep (dummy-package "dep"))
@ -371,14 +365,13 @@
(inputs `(("dep" ,dep))))) (inputs `(("dep" ,dep)))))
(t (options->transformation '((without-tests . "dep") (t (options->transformation '((without-tests . "dep")
(without-tests . "tar"))))) (without-tests . "tar")))))
(with-store store (let ((new (t p)))
(let ((new (t store p))) (match (bag-direct-inputs (package->bag new))
(match (bag-direct-inputs (package->bag new)) ((("dep" dep) ("tar" tar) _ ...)
((("dep" dep) ("tar" tar) _ ...) ;; TODO: Check whether TAR has #:tests? #f when transformations
;; TODO: Check whether TAR has #:tests? #f when transformations ;; apply to implicit inputs.
;; apply to implicit inputs. (equal? (package-arguments dep)
(equal? (package-arguments dep) '(#:tests? #f)))))))
'(#:tests? #f))))))))
(test-end) (test-end)