tests: Add 'union-build' test for <http://bugs.gnu.org/17083>.
* tests/union.scm ("union-build with symlink to directory"): New test.
This commit is contained in:
parent
1212999868
commit
a53a9aed93
|
@ -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 @@
|
|||
|
||||
(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)))
|
||||
|
|
Loading…
Reference in New Issue