Merge branch 'master' into core-updates

4 files changed, 47 insertions, 12 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 36558fe1dd..56b2775248 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -409,6 +409,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 <https://bugs.gnu.org/36777>.
+  (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"
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 067ae93822..fb1c1a022d 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 \
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"