summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm38
-rw-r--r--tests/guix-package.sh12
-rw-r--r--tests/snix.scm4
-rw-r--r--tests/union.scm19
4 files changed, 65 insertions, 8 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 692b2aea8d..166a917490 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -360,6 +360,44 @@
     ;; built.
     (null? (derivation-prerequisites-to-build %store drv))))
 
+(test-assert "derivation-prerequisites-to-build when outputs already present"
+  (let*-values (((builder)
+                 '(begin (mkdir %output) #t))
+                ((input-drv-path input-drv)
+                 (build-expression->derivation %store "input"
+                                               (%current-system)
+                                               builder '()))
+                ((input-path)
+                 (derivation-output-path
+                  (assoc-ref (derivation-outputs input-drv)
+                             "out")))
+                ((drv-path drv)
+                 (build-expression->derivation %store "something"
+                                               (%current-system)
+                                               builder
+                                               `(("i" ,input-drv-path))))
+                ((output)
+                 (derivation-output-path
+                  (assoc-ref (derivation-outputs drv) "out"))))
+    ;; Make sure these things are not already built.
+    (when (valid-path? %store input-path)
+      (delete-paths %store (list input-path)))
+    (when (valid-path? %store output)
+      (delete-paths %store (list output)))
+
+    (and (equal? (map derivation-input-path
+                      (derivation-prerequisites-to-build %store drv))
+                 (list input-drv-path))
+
+         ;; Build DRV and delete its input.
+         (build-derivations %store (list drv-path))
+         (delete-paths %store (list input-path))
+         (not (valid-path? %store input-path))
+
+         ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
+         ;; prerequisite to build because DRV itself is already built.
+         (null? (derivation-prerequisites-to-build %store drv)))))
+
 (test-assert "build-expression->derivation with expression returning #f"
   (let* ((builder  '(begin
                       (mkdir %output)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 81b7f05634..bd2c816b9a 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -27,13 +27,13 @@ rm -f "$profile"
 
 trap 'rm "$profile" "$profile-"[0-9]*' EXIT
 
-guix-package -b -p "$profile"						\
+guix-package --bootstrap -p "$profile"						\
     -i `guix-build -e '(@@ (distro packages base) %bootstrap-guile)'`
 test -L "$profile" && test -L "$profile-1-link"
 test -f "$profile/bin/guile"
 
 # Installing the same package a second time does nothing.
-guix-package -b -p "$profile"						\
+guix-package --bootstrap -p "$profile"						\
     -i `guix-build -e '(@@ (distro packages base) %bootstrap-guile)'`
 test -L "$profile" && test -L "$profile-1-link"
 ! test -f "$profile-2-link"
@@ -42,7 +42,7 @@ test -f "$profile/bin/guile"
 # Check whether we have network access.
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
-    guix-package -b -p "$profile"						\
+    guix-package --bootstrap -p "$profile"						\
 	-i `guix-build -e '(@@ (distro packages base) gnu-make-boot0)'`
     test -L "$profile-2-link"
     test -f "$profile/bin/make" && test -f "$profile/bin/guile"
@@ -64,13 +64,13 @@ then
     test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
 
     # Remove a package.
-    guix-package -b -p "$profile" -r "guile-bootstrap"
+    guix-package --bootstrap -p "$profile" -r "guile-bootstrap"
     test -L "$profile-3-link"
     test -f "$profile/bin/make" && ! test -f "$profile/bin/guile"
 fi
 
 # Make sure the `:' syntax works.
-guix-package -b -i "libsigsegv:lib" -n
+guix-package --bootstrap -i "libsigsegv:lib" -n
 
 # Check whether `--list-available' returns something sensible.
 guix-package -A 'gui.*e' | grep guile
diff --git a/tests/snix.scm b/tests/snix.scm
index 7623d0cd8f..89582f2408 100644
--- a/tests/snix.scm
+++ b/tests/snix.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,7 +61,7 @@
        ('home-page (? string?))
        ('synopsis (? string?))
        ('description (? string?))
-       ('license (? string?)))
+       ('license (? symbol?)))
      (and (member '("libffi" ,libffi) inputs)
           (member '("gmp" ,gmp) pinputs)
           #t))
diff --git a/tests/union.scm b/tests/union.scm
index 58c0a301b2..5bbf992a59 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -65,6 +65,25 @@
                 (bin make)
                 (share (doc (make README))))))
 
+(test-equal "delete-duplicate-leaves, default"
+  '(bin make touch ls)
+  (delete-duplicate-leaves '(bin ls make touch ls)))
+
+(test-equal "delete-duplicate-leaves, file names"
+  '("doc" ("info"
+           "/binutils/ld.info"
+           "/gcc/gcc.info"
+           "/binutils/standards.info"))
+  (let ((leaf=? (lambda (a b)
+                  (string=? (basename a) (basename b)))))
+    (delete-duplicate-leaves '("doc"
+                               ("info"
+                                "/binutils/ld.info"
+                                "/binutils/standards.info"
+                                "/gcc/gcc.info"
+                                "/gcc/standards.info"))
+                             leaf=?)))
+
 (test-skip (if (and %store
                     (false-if-exception
                      (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))