~ruther/guix-local

07c0b6e08264f62d0e55ac16be6d313925badfd9 — Ludovic Courtès 11 years ago 5763ad9
gnu: ld-wrapper2: Make 'readlink*' tail-recursive.

* gnu/packages/ld-wrapper2.in (readlink*): Make tail-recursive.
1 files changed, 16 insertions(+), 10 deletions(-)

M gnu/packages/ld-wrapper2.in
M gnu/packages/ld-wrapper2.in => gnu/packages/ld-wrapper2.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