aboutsummaryrefslogtreecommitdiff
path: root/tests/profiles.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-18 11:35:45 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-18 11:38:48 +0200
commit22ef06b801b284760b4ffd9587ea1a3dffd31baa (patch)
treeadb65b28be5230783c3fb20db6a65ac9f32b64ea /tests/profiles.scm
parent41f76ae08a7a830cdeb1eaac271d714cb58fbce3 (diff)
downloadpatches-22ef06b801b284760b4ffd9587ea1a3dffd31baa.tar
patches-22ef06b801b284760b4ffd9587ea1a3dffd31baa.tar.gz
union: Gracefully handle dangling symlinks in the input.
Fixes <http://bugs.gnu.org/26949>. Reported by Pjotr Prins <pjotr.public12@thebird.nl>. * guix/build/union.scm (file-is-directory?): Return #f when FILE does not exist or is a dangling symlink. (file=?): Pass #f as a second argument to 'stat'; return #f when both ST1 or ST2 is #f. * tests/profiles.scm (test-equalm): New macro. ("union vs. dangling symlink"): New test.
Diffstat (limited to 'tests/profiles.scm')
-rw-r--r--tests/profiles.scm29
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/profiles.scm b/tests/profiles.scm
index d0b1e14a86..093422792f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -50,6 +50,12 @@
(run-with-store %store exp
#:guile-for-build (%guile-for-build))))
+(define-syntax-rule (test-equalm name value exp)
+ (test-equal name
+ value
+ (run-with-store %store exp
+ #:guile-for-build (%guile-for-build))))
+
;; Example manifest entries.
(define guile-1.8.8
@@ -366,6 +372,29 @@
get-string-all)
"foo!"))))))
+(test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949>
+ "does-not-exist"
+ (mlet* %store-monad
+ ((thing1 -> (dummy-package "dummy"
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (symlink "does-not-exist"
+ (string-append out "/dangling"))
+ #t)))))
+ (thing2 -> (package (inherit thing1) (name "dummy2")))
+ (drv (profile-derivation (packages->manifest
+ (list thing1 thing2))
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (return (readlink (readlink (string-append profile "/dangling")))))))
+
(test-end "profiles")
;;; Local Variables: