From 268896444bed7b958add74b2e1e86ff802c5f5cb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 16 Aug 2019 18:41:55 +0200 Subject: derivations: Delete duplicate inputs when computing derivation hash. Fixes . Reported by Carl Dong . * guix/derivations.scm (derivation/masked-inputs): Call 'delete-duplicates' on INPUTS. * tests/derivations.scm ("derivation with duplicate fixed-output inputs"): New test. --- tests/derivations.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 368012d2b2..db73d19b3a 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -410,6 +410,38 @@ (equal? (derivation->output-path final1) (derivation->output-path final2))))) +(test-assert "derivation with duplicate fixed-output inputs" + ;; Here we create a derivation that has two inputs, both of which are + ;; fixed-output leading to the same result. This test ensures the hash of + ;; that derivation is correctly computed, namely that duplicate inputs are + ;; coalesced. See . + (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh" + "echo -n hello > $out" '())) + (builder2 (add-text-to-store %store "fixed-builder2.sh" + "echo hey; echo -n hello > $out" '())) + (hash (sha256 (string->utf8 "hello"))) + (fixed1 (derivation %store "fixed" + %bash `(,builder1) + #:hash hash #:hash-algo 'sha256)) + (fixed2 (derivation %store "fixed" + %bash `(,builder2) + #:hash hash #:hash-algo 'sha256)) + (builder3 (add-text-to-store %store "builder.sh" + "echo fake builder")) + (final (derivation %store "final" + %bash `(,builder3) + #:sources (list %bash builder3) + #:inputs (list (derivation-input fixed1) + (derivation-input fixed2))))) + (and (derivation? final) + (match (derivation-inputs final) + (((= derivation-input-derivation one) + (= derivation-input-derivation two)) + (and (not (string=? (derivation-file-name one) + (derivation-file-name two))) + (string=? (derivation->output-path one) + (derivation->output-path two)))))))) + (test-assert "multiple-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $second" -- cgit 1.4.1 From 37592014e13abead7a691d0dcb5918d1a10f5cd6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 17 Aug 2019 15:34:24 +0200 Subject: tests: Relax expectations for the 'home-page' checker. Fixes a regression introduced in 50fc2384feb3bb2677d074f8f0deb5ae3c56b4d8. * tests/lint.scm (warning-contains?): New procedure. ("home-page: host not found"): Use 'warning-contains?' instead of testing for equality, as was the case before commit 50fc2384feb. This handles the case where the 'getaddrinfo' error is not "Name or service not known" but instead something like "System error" or "Servname not supported for ai_socktype", as is the case in the build environment. --- tests/lint.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/lint.scm b/tests/lint.scm index 8a9023a7a3..db6dd6dbe1 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -74,6 +74,12 @@ (((and (? lint-warning?) warning)) (lint-warning-message warning)))) +(define (warning-contains? str warnings) + "Return true if WARNINGS is a singleton with a warning that contains STR." + (match warnings + (((? lint-warning? warning)) + (string-contains (lint-warning-message warning) str)))) + (test-begin "lint") @@ -366,13 +372,11 @@ (single-lint-warning-message (check-home-page pkg)))) -(test-equal "home-page: host not found" - "URI http://does-not-exist domain not found: Name or service not known" +(test-assert "home-page: host not found" (let ((pkg (package (inherit (dummy-package "x")) (home-page "http://does-not-exist")))) - (single-lint-warning-message - (check-home-page pkg)))) + (warning-contains? "domain not found" (check-home-page pkg)))) (test-skip (if (http-server-can-listen?) 0 1)) (test-equal "home-page: Connection refused" -- cgit 1.4.1 From 75a6f66815db811cc41aadbe93033a6efd3ad62f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 17 Aug 2019 15:40:49 +0200 Subject: tests: Move 'guix environment -C --no-cwd' test where it belongs. This ensures that this test is skipped in contexts where user namespaces are not supported, instead of failing. This is a followup to commit b6dc08393e6a8313b88ce422fc3c1e4e9c0efc6f. * tests/guix-environment.sh: Move '--container --no-cwd' test to... * tests/guix-environment-container.sh: ... here. --- tests/guix-environment-container.sh | 7 +++++++ tests/guix-environment.sh | 8 -------- 2 files changed, 7 insertions(+), 8 deletions(-) (limited to 'tests') diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 78507f76c0..32a5ba1f97 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -144,6 +144,13 @@ HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \ --share="$tmpdir/umock" \ -- guile -c "$usertest" +# if not sharing CWD, chdir home +( + cd "$tmpdir" \ + && guix environment --bootstrap --container --no-cwd --user=foo \ + --ad-hoc guile-bootstrap --pure \ + -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir" +) # Check the exit code. diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 5a5a69d58c..a670db36be 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -84,14 +84,6 @@ echo "(use-modules (guix profiles) (gnu packages bootstrap)) guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \ -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"' -# if not sharing CWD, chdir home -( - cd "$tmpdir" \ - && guix environment --bootstrap --container --no-cwd --user=foo \ - --ad-hoc guile-bootstrap --pure \ - -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir" -) - # Make sure '-r' works as expected. rm -f "$gcroot" expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \ -- cgit 1.4.1 From 01ce7af25add55514f737af48ea6c127bedfde67 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 6 Aug 2019 20:17:28 +0100 Subject: import: cpan: Adapt for the change to guile-json version 3. In guile-json version 3, JSON objects are represented as hash tables, rather than alists. * guix/import/cpan.scm (string->license): Change the match expression to match on lists, rather than vectors. (module->dist-name, cpan-source-url, cpan-version): Change assoc-ref to hash-ref. (cpan-module->sexp): Change assoc-ref to hash-ref, and assoc-ref* to hash-ref*. * tests/cpan.scm ("source-url-http", "source-url-https"): Convert the alist to a hash table. --- guix/import/cpan.scm | 30 ++++++++++++++++-------------- tests/cpan.scm | 13 ++++++++----- 2 files changed, 24 insertions(+), 19 deletions(-) (limited to 'tests') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index ec86f11743..0be37e715e 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -34,7 +34,7 @@ #:use-module (guix ui) #:use-module ((guix download) #:select (download-to-store url-fetch)) #:use-module ((guix import utils) #:select (factorize-uri - flatten assoc-ref*)) + flatten hash-ref*)) #:use-module (guix import json) #:use-module (guix packages) #:use-module (guix upstream) @@ -76,8 +76,8 @@ ;; ssleay ;; sun ("zlib" 'zlib) - (#(x) (string->license x)) - (#(lst ...) `(list ,@(map string->license lst))) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) (_ #f))) (define (module->name module) @@ -88,11 +88,11 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (assoc-ref (json-fetch (string-append - "https://fastapi.metacpan.org/v1/module/" - module - "?fields=distribution")) - "distribution")) + (hash-ref (json-fetch (string-append + "https://fastapi.metacpan.org/v1/module/" + module + "?fields=distribution")) + "distribution")) (define (package->upstream-name package) "Return the CPAN name of PACKAGE." @@ -122,12 +122,12 @@ or #f on failure. MODULE should be e.g. \"Test::Script\"" (define (cpan-source-url meta) "Return the download URL for a module's source tarball." (regexp-substitute/global #f "http[s]?://cpan.metacpan.org" - (assoc-ref meta "download_url") + (hash-ref meta "download_url") 'pre "mirror://cpan" 'post)) (define (cpan-version meta) "Return the version number from META." - (match (assoc-ref meta "version") + (match (hash-ref meta "version") ((? number? version) ;; version is sometimes not quoted in the module json, so it gets ;; imported into Guile as a number, so convert it to a string. @@ -183,7 +183,7 @@ depend on (gnu packages perl)." "Return the `package' s-expression for a CPAN module from the metadata in META." (define name - (assoc-ref meta "distribution")) + (hash-ref meta "distribution")) (define (guix-name name) (if (string-prefix? "perl-" name) @@ -198,7 +198,9 @@ META." (match (flatten (map (lambda (ph) (filter-map (lambda (t) - (assoc-ref* meta "metadata" "prereqs" ph t)) + (and=> (hash-ref* meta "metadata" "prereqs" ph t) + (lambda (h) + (hash-map->list cons h)))) '("requires" "recommends" "suggests"))) phases)) (#f @@ -251,9 +253,9 @@ META." ,@(maybe-inputs 'propagated-inputs (convert-inputs '("runtime"))) (home-page ,(cpan-home name)) - (synopsis ,(assoc-ref meta "abstract")) + (synopsis ,(hash-ref meta "abstract")) (description fill-in-yourself!) - (license ,(string->license (assoc-ref meta "license")))))) + (license ,(string->license (hash-ref meta "license")))))) (define (cpan->guix-package module-name) "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the diff --git a/tests/cpan.scm b/tests/cpan.scm index 189dd027e6..cdd6c0e76a 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -24,7 +24,8 @@ #:use-module (guix tests) #:use-module (guix grafts) #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module (ice-9 hash-table)) ;; Globally disable grafts because they can trigger early builds. (%graft? #f) @@ -109,14 +110,16 @@ (test-equal "source-url-http" ((@@ (guix import cpan) cpan-source-url) - `(("download_url" . - "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))) + (alist->hash-table + `(("download_url" . + "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))) "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz") (test-equal "source-url-https" ((@@ (guix import cpan) cpan-source-url) - `(("download_url" . - "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))) + (alist->hash-table + `(("download_url" . + "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))) "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz") (test-end "cpan") -- cgit 1.4.1 From d020821c0bd2206a5f3d4db155f2a9a3de7dc670 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 22 Aug 2019 14:24:11 -0400 Subject: Revert "import: cpan: Adapt for the change to guile-json version 3." This reverts commit 01ce7af25add55514f737af48ea6c127bedfde67. --- guix/import/cpan.scm | 30 ++++++++++++++---------------- tests/cpan.scm | 13 +++++-------- 2 files changed, 19 insertions(+), 24 deletions(-) (limited to 'tests') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 0be37e715e..ec86f11743 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -34,7 +34,7 @@ #:use-module (guix ui) #:use-module ((guix download) #:select (download-to-store url-fetch)) #:use-module ((guix import utils) #:select (factorize-uri - flatten hash-ref*)) + flatten assoc-ref*)) #:use-module (guix import json) #:use-module (guix packages) #:use-module (guix upstream) @@ -76,8 +76,8 @@ ;; ssleay ;; sun ("zlib" 'zlib) - ((x) (string->license x)) - ((lst ...) `(list ,@(map string->license lst))) + (#(x) (string->license x)) + (#(lst ...) `(list ,@(map string->license lst))) (_ #f))) (define (module->name module) @@ -88,11 +88,11 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (hash-ref (json-fetch (string-append - "https://fastapi.metacpan.org/v1/module/" - module - "?fields=distribution")) - "distribution")) + (assoc-ref (json-fetch (string-append + "https://fastapi.metacpan.org/v1/module/" + module + "?fields=distribution")) + "distribution")) (define (package->upstream-name package) "Return the CPAN name of PACKAGE." @@ -122,12 +122,12 @@ or #f on failure. MODULE should be e.g. \"Test::Script\"" (define (cpan-source-url meta) "Return the download URL for a module's source tarball." (regexp-substitute/global #f "http[s]?://cpan.metacpan.org" - (hash-ref meta "download_url") + (assoc-ref meta "download_url") 'pre "mirror://cpan" 'post)) (define (cpan-version meta) "Return the version number from META." - (match (hash-ref meta "version") + (match (assoc-ref meta "version") ((? number? version) ;; version is sometimes not quoted in the module json, so it gets ;; imported into Guile as a number, so convert it to a string. @@ -183,7 +183,7 @@ depend on (gnu packages perl)." "Return the `package' s-expression for a CPAN module from the metadata in META." (define name - (hash-ref meta "distribution")) + (assoc-ref meta "distribution")) (define (guix-name name) (if (string-prefix? "perl-" name) @@ -198,9 +198,7 @@ META." (match (flatten (map (lambda (ph) (filter-map (lambda (t) - (and=> (hash-ref* meta "metadata" "prereqs" ph t) - (lambda (h) - (hash-map->list cons h)))) + (assoc-ref* meta "metadata" "prereqs" ph t)) '("requires" "recommends" "suggests"))) phases)) (#f @@ -253,9 +251,9 @@ META." ,@(maybe-inputs 'propagated-inputs (convert-inputs '("runtime"))) (home-page ,(cpan-home name)) - (synopsis ,(hash-ref meta "abstract")) + (synopsis ,(assoc-ref meta "abstract")) (description fill-in-yourself!) - (license ,(string->license (hash-ref meta "license")))))) + (license ,(string->license (assoc-ref meta "license")))))) (define (cpan->guix-package module-name) "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the diff --git a/tests/cpan.scm b/tests/cpan.scm index cdd6c0e76a..189dd027e6 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -24,8 +24,7 @@ #:use-module (guix tests) #:use-module (guix grafts) #:use-module (srfi srfi-64) - #:use-module (ice-9 match) - #:use-module (ice-9 hash-table)) + #:use-module (ice-9 match)) ;; Globally disable grafts because they can trigger early builds. (%graft? #f) @@ -110,16 +109,14 @@ (test-equal "source-url-http" ((@@ (guix import cpan) cpan-source-url) - (alist->hash-table - `(("download_url" . - "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))) + `(("download_url" . + "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))) "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz") (test-equal "source-url-https" ((@@ (guix import cpan) cpan-source-url) - (alist->hash-table - `(("download_url" . - "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))) + `(("download_url" . + "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))) "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz") (test-end "cpan") -- cgit 1.4.1