aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/ld-wrapper.in
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-04-21 21:07:11 +0200
committerLudovic Courtès <ludo@gnu.org>2015-04-21 21:07:11 +0200
commitcbbb11c8a00c64cb24081025239f77208661b961 (patch)
tree072c87d23ebe53daa37773f2952b7ec67806a6dc /gnu/packages/ld-wrapper.in
parent44fd6ef137f4aa7b9eb9c999e57b450432c4e915 (diff)
downloadguix-cbbb11c8a00c64cb24081025239f77208661b961.tar
guix-cbbb11c8a00c64cb24081025239f77208661b961.tar.gz
gnu: Rename ld-wrapper2 to ld-wrapper.
* gnu/packages/ld-wrapper2.in: Rename to... * gnu/packages/ld-wrapper.in: ... this. * gnu-system.am (MISC_DISTRO_FILES): Remove ld-wrapper2.in. * gnu/packages/commencement.scm (fixed-ld-wrapper): Remove. (gcc-toolchain): Restore pre-77db91ad inputs.
Diffstat (limited to 'gnu/packages/ld-wrapper.in')
-rw-r--r--gnu/packages/ld-wrapper.in48
1 files changed, 23 insertions, 25 deletions
diff --git a/gnu/packages/ld-wrapper.in b/gnu/packages/ld-wrapper.in
index 094018de3d..f4ab17c59f 100644
--- a/gnu/packages/ld-wrapper.in
+++ b/gnu/packages/ld-wrapper.in
@@ -92,34 +92,32 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
(let loop ((file file)
(depth 0))
- (catch 'system-error
- (lambda ()
- (if (>= depth %max-symlink-depth)
- file
- (loop (readlink file) (+ depth 1))))
- (lambda args
- (if (= EINVAL (system-error-errno args))
- file
- (apply throw args))))))
-
-(define (dereference-symlinks file)
- ;; Same as 'readlink*' but return FILE if the symlink target is invalid or
- ;; FILE does not exist.
- (catch 'system-error
- (lambda ()
- ;; When used from a user environment, FILE may refer to
- ;; ~/.guix-profile/lib/libfoo.so, which is itself a symlink to the
- ;; store. Check whether this is the case.
- (readlink* file))
- (lambda args
- (if (= ENOENT (system-error-errno args))
- file
- (apply throw args)))))
+ (define (absolute target)
+ (if (absolute-file-name? target)
+ target
+ (string-append (dirname file) "/" target)))
+
+ (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
;; (possibly via a symlink) or within the build directory.
- (let ((file (dereference-symlinks file)))
+ (let ((file (readlink* file)))
(or (not (string-prefix? "/" file))
(string-prefix? %store-directory file)
(string-prefix? %temporary-directory file)
@@ -128,7 +126,7 @@ exec @GUILE@ -c "(load-compiled \"@SELF@.go\") (apply $main (cdr (command-line))
(define (store-file-name? file)
;; Return #t when FILE is a store file, possibly indirectly.
- (string-prefix? %store-directory (dereference-symlinks file)))
+ (string-prefix? %store-directory (readlink* file)))
(define (shared-library? file)
;; Return #t when FILE denotes a shared library.