tests: Add 'union-build' test for <http://bugs.gnu.org/17083>.

* tests/union.scm ("union-build with symlink to directory"): New test.

diff --git a/tests/union.scm b/tests/union.scm
index f63329a..74c51cb 100644 (file)
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +28,7 @@
   #:use-module (gnu packages bootstrap)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
+  #:use-module (rnrs io ports)
   #:use-module (ice-9 match))
 
 ;; Exercise the (guix build union) module.
@@ -43,6 +44,51 @@
 \f
 (test-begin "union")
 
+(test-assert "union-build with symlink to directory"
+  ;; http://bugs.gnu.org/17083
+  ;; Here both ONE and TWO provide an element called 'foo', but in ONE it's a
+  ;; directory whereas in TWO it's a symlink to a directory.
+  (let* ((one     (build-expression->derivation
+                   %store "one"
+                   '(begin
+                      (use-modules (guix build utils) (srfi srfi-26))
+                      (let ((foo (string-append %output "/foo")))
+                        (mkdir-p foo)
+                        (call-with-output-file (string-append foo "/one")
+                          (cut display "one" <>))))
+                   #:modules '((guix build utils))))
+         (two     (build-expression->derivation
+                   %store "two"
+                   '(begin
+                      (use-modules (guix build utils) (srfi srfi-26))
+                      (let ((foo (string-append %output "/foo"))
+                            (bar (string-append %output "/bar")))
+                        (mkdir-p bar)
+                        (call-with-output-file (string-append bar "/two")
+                          (cut display "two" <>))
+                        (symlink "bar" foo)))
+                   #:modules '((guix build utils))))
+         (builder '(begin
+                     (use-modules (guix build union))
+
+                     (union-build (assoc-ref %outputs "out")
+                                  (list (assoc-ref %build-inputs "one")
+                                        (assoc-ref %build-inputs "two")))))
+         (drv
+          (build-expression->derivation %store "union-collision-symlink"
+                                        builder
+                                        #:inputs `(("one" ,one) ("two" ,two))
+                                        #:modules '((guix build union)))))
+    (and (build-derivations %store (list drv))
+         (with-directory-excursion (pk (derivation->output-path drv))
+           (and (string=? "one"
+                          (call-with-input-file "foo/one" get-string-all))
+                (string=? "two"
+                          (call-with-input-file "foo/two" get-string-all))
+                (string=? "two"
+                          (call-with-input-file "bar/two" get-string-all))
+                (not (file-exists? "bar/one")))))))
+
 (test-skip (if (and %store
                     (false-if-exception
                      (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))