From 07c0b6e08264f62d0e55ac16be6d313925badfd9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 19 Apr 2015 17:24:37 +0200 Subject: gnu: ld-wrapper2: Make 'readlink*' tail-recursive. * gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive. --- gnu/packages/ld-wrapper2.in | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) (limited to 'gnu') 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 -- cgit v1.2.3