Merge branch 'master' into core-updates

5 files changed, 104 insertions, 15 deletions

diff --git a/tests/containers.scm b/tests/containers.scm
index bbcff3f51f..698bef3e47 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -162,4 +162,13 @@
           (waitpid pid)
           (zero? result)))))))
 
+(skip-if-unsupported)
+(test-equal "container-excursion, same namespaces"
+  42
+  ;; The parent and child are in the same namespaces.  'container-excursion'
+  ;; should notice that and avoid calling 'setns' since that would fail.
+  (container-excursion (getpid)
+    (lambda ()
+      (primitive-exit 42))))
+
 (test-end)
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 4eff06b4b3..6454a03b1f 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -201,6 +201,54 @@
            (and (string=? (readlink one) repl)
                 (string=? (readlink two) one))))))
 
+(test-assert "graft-derivation, replaced derivation has multiple outputs"
+  ;; Here we have a replacement just for output "one" of P1 and not for the
+  ;; other output.  Make sure the graft for P1:one correctly applies to the
+  ;; dependents of P1.  See <http://bugs.gnu.org/24712>.
+  (let* ((p1  (build-expression->derivation
+               %store "p1"
+               `(let ((one (assoc-ref %outputs "one"))
+                      (two (assoc-ref %outputs "two")))
+                  (mkdir one)
+                  (mkdir two))
+               #:outputs '("one" "two")))
+         (p1r (build-expression->derivation
+               %store "P1"
+               `(let ((other (assoc-ref %outputs "ONE")))
+                  (mkdir other)
+                  (call-with-output-file (string-append other "/replacement")
+                    (const #t)))
+               #:outputs '("ONE")))
+         (p2  (build-expression->derivation
+               %store "p2"
+               `(let ((out (assoc-ref %outputs "aaa")))
+                  (mkdir (assoc-ref %outputs "zzz"))
+                  (mkdir out) (chdir out)
+                  (symlink (assoc-ref %build-inputs "p1:one") "one")
+                  (symlink (assoc-ref %build-inputs "p1:two") "two"))
+               #:outputs '("aaa" "zzz")
+               #:inputs `(("p1:one" ,p1 "one")
+                          ("p1:two" ,p1 "two"))))
+         (p3  (build-expression->derivation
+               %store "p3"
+               `(symlink (assoc-ref %build-inputs "p2:aaa")
+                         (assoc-ref %outputs "out"))
+               #:inputs `(("p2:aaa" ,p2 "aaa")
+                          ("p2:zzz" ,p2 "zzz"))))
+         (p1g (graft
+                (origin p1)
+                (origin-output "one")
+                (replacement p1r)
+                (replacement-output "ONE")))
+         (p3d (graft-derivation %store p3 (list p1g))))
+    (and (build-derivations %store (list p3d))
+         (let ((out (derivation->output-path (pk 'p2d p3d))))
+           (and (not (string=? (readlink out)
+                               (derivation->output-path p2 "aaa")))
+                (string=? (derivation->output-path p1 "two")
+                          (readlink (string-append out "/two")))
+                (file-exists? (string-append out "/one/replacement")))))))
+
 (test-assert "graft-derivation, renaming"         ;<http://bugs.gnu.org/23132>
   (let* ((build `(begin
                    (use-modules (guix build utils))
diff --git a/tests/lint.scm b/tests/lint.scm
index d692b42f93..fa2d19b2a6 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -218,6 +218,14 @@ string) on HTTP requests."
                              (check-description-style pkg)))
                          "should not contain trademark sign"))))
 
+(test-assert "description: suggest ornament instead of quotes"
+  (->bool
+   (string-contains (with-warnings
+                      (let ((pkg (dummy-package "x"
+                                   (description "This is a 'quoted' thing."))))
+                        (check-description-style pkg)))
+                    "use @code")))
+
 (test-assert "synopsis: not a string"
   (->bool
    (string-contains (with-warnings
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index e48c8da264..b324012806 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -102,4 +102,23 @@
                        ((("x" dep))
                         (eq? dep findutils)))))))))))
 
+(test-assert "options->transformation, with-graft"
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("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))
+                     (eq? (package-replacement dep1) findutils)
+                     (string=? (package-name dep2) "chbouib")
+                     (match (package-native-inputs dep2)
+                       ((("x" dep))
+                        (eq? (package-replacement dep) findutils)))))))))))
+
 (test-end)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 73fa8a7acf..1b31d87f23 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -148,25 +148,30 @@
 
 (unless perform-container-tests?
   (test-skip 1))
-(test-assert "pivot-root"
+(test-equal "pivot-root"
+  #t
   (match (pipe)
     ((in . out)
      (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
        (0
-        (close in)
-        (call-with-temporary-directory
-         (lambda (root)
-           (let ((put-old (string-append root "/real-root")))
-             (mount "none" root "tmpfs")
-             (mkdir put-old)
-             (call-with-output-file (string-append root "/test")
-               (lambda (port)
-                 (display "testing\n" port)))
-             (pivot-root root put-old)
-             ;; The test file should now be located inside the root directory.
-             (write (file-exists? "/test") out)
-             (close out))))
-        (primitive-exit 0))
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close in)
+            (call-with-temporary-directory
+             (lambda (root)
+               (let ((put-old (string-append root "/real-root")))
+                 (mount "none" root "tmpfs")
+                 (mkdir put-old)
+                 (call-with-output-file (string-append root "/test")
+                   (lambda (port)
+                     (display "testing\n" port)))
+                 (pivot-root root put-old)
+                 ;; The test file should now be located inside the root directory.
+                 (write (file-exists? "/test") out)
+                 (close out)))))
+          (lambda ()
+            (primitive-exit 0))))
        (pid
         (close out)
         (let ((result (read in)))