diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-04-19 17:24:37 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-04-19 23:34:53 +0200 |
commit | 07c0b6e08264f62d0e55ac16be6d313925badfd9 (patch) | |
tree | 3008e2ff120c4b8ca62c2ef1817edc8d52706571 | |
parent | 5763ad9266ec7682d53b87a874fc6ae04f92b6c4 (diff) | |
download | guix-07c0b6e08264f62d0e55ac16be6d313925badfd9.tar guix-07c0b6e08264f62d0e55ac16be6d313925badfd9.tar.gz |
gnu: ld-wrapper2: Make 'readlink*' tail-recursive.
* gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
-rw-r--r-- | gnu/packages/ld-wrapper2.in | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/gnu/packages/ld-wrapper2.in b/gnu/packages/ld-wrapper2.in index 2f0e0ab24a..f4ab17c59f 100644 --- a/gnu/packages/ld-wrapper2.in +++ b/gnu/packages/ld-wrapper2.in @@ -97,16 +97,22 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line)) target (string-append (dirname file) "/" target))) - (catch 'system-error - (lambda () - (if (>= depth %max-symlink-depth) - file - (loop (absolute (readlink file)) (+ depth 1)))) - (lambda args - (let ((errno (system-error-errno args))) - (if (or (= errno EINVAL) (= errno ENOENT)) - file - (apply throw args))))))) + (if (>= depth %max-symlink-depth) + file + (call-with-values + (lambda () + (catch 'system-error + (lambda () + (values #t (readlink file))) + (lambda args + (let ((errno (system-error-errno args))) + (if (or (= errno EINVAL) (= errno ENOENT)) + (values #f file) + (apply throw args)))))) + (lambda (success? target) + (if success? + (loop (absolute target) (+ depth 1)) + file)))))) (define (pure-file-name? file) ;; Return #t when FILE is the name of a file either within the store |