guix/guix
3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

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

Browse source 
* tests/union.scm ("union-build with symlink to directory"): New test.
This commit is contained in:
Ludovic Courtès 2014-04-02 23:08:44 +02:00
parent 1212999868
commit a53a9aed93
1 changed files with 47 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
tests/union.scm
View file

@ -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)))