From a53a9aed9352b8d8f711dc9630337be7ef88764a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 2 Apr 2014 23:08:44 +0200
Subject: tests: Add 'union-build' test for <http://bugs.gnu.org/17083>.

* tests/union.scm ("union-build with symlink to directory"): New test.
---
 tests/union.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

diff --git a/tests/union.scm b/tests/union.scm
index f63329a511..74c51cbed9 100644
--- 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 @@ (define-module (test-union)
   #: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 @@ (define %store
 
 (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)))
-- 
cgit v1.2.3