mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-05-18 23:25:57 +02:00
gnu: ld-wrapper2: Make 'readlink*' tail-recursive.
* gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
This commit is contained in:
+16
-10
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user