me/guix
Archived
1
0
Fork 0
Code Activity

gnu: ld-wrapper2: Make 'readlink*' tail-recursive.

Browse source 
* gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
This commit is contained in:
Ludovic Courtès 2015-04-19 17:24:37 +02:00
parent 5763ad9266
commit 07c0b6e082
1 changed files with 16 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gnu/packages/ld-wrapper2.in
View file

@ -97,16 +97,22 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
target target
(string-append (dirname file) "/" target))) (string-append (dirname file) "/" target)))
(catch 'system-error (if (>= depth %max-symlink-depth)
(lambda () file
(if (>= depth %max-symlink-depth) (call-with-values
file (lambda ()
(loop (absolute (readlink file)) (+ depth 1)))) (catch 'system-error
(lambda args (lambda ()
(let ((errno (system-error-errno args))) (values #t (readlink file)))
(if (or (= errno EINVAL) (= errno ENOENT)) (lambda args
file (let ((errno (system-error-errno args)))
(apply throw 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) (define (pure-file-name? file)
;; Return #t when FILE is the name of a file either within the store ;; Return #t when FILE is the name of a file either within the store