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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 07c0b6e08264f62d0e55ac16be6d313925badfd9
Author: Ludovic Courtès <address@hidden>
Date:   Sun Apr 19 17:24:37 2015 +0200

    gnu: ld-wrapper2: Make 'readlink*' tail-recursive.
    
    * gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
---
 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 2f0e0ab..f4ab17c 100644
--- a/gnu/packages/ld-wrapper2.in
+++ b/gnu/packages/ld-wrapper2.in
@@ -97,16 +97,22 @@ exec @GUILE@ -c "(load-compiled \"@address@hidden") (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