diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-11-27 16:35:45 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-12-01 21:30:28 +0100 |
commit | 53fd256e5ba43e516fb9d6eaf085b88fe8bd12b6 (patch) | |
tree | af48602e9055debdcf442adc8061eb12cc784a2c /tests/gremlin.scm | |
parent | fad97a01dfce06d686269a4b8990376c68ed1ae6 (diff) | |
download | guix-53fd256e5ba43e516fb9d6eaf085b88fe8bd12b6.tar.gz guix-53fd256e5ba43e516fb9d6eaf085b88fe8bd12b6.zip |
gremlin: Add 'file-needed/recursive'.
* guix/build/gremlin.scm (file-needed/recursive): New procedure.
* tests/gremlin.scm ("file-needed/recursive"): New test.
Diffstat (limited to 'tests/gremlin.scm')
-rw-r--r-- | tests/gremlin.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/gremlin.scm b/tests/gremlin.scm index f191adb8b3..9ddac14265 100644 --- a/tests/gremlin.scm +++ b/tests/gremlin.scm @@ -27,6 +27,8 @@ #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) #:use-module (ice-9 match)) (define %guile-executable @@ -58,6 +60,40 @@ (string-take lib (string-contains lib ".so"))) (elf-dynamic-info-needed dyninfo)))))) +(unless (and %guile-executable (not (getenv "LD_LIBRARY_PATH")) + (file-needed %guile-executable)) ;statically linked? + (test-skip 1)) +(test-assert "file-needed/recursive" + (let* ((needed (file-needed/recursive %guile-executable)) + (pipe (dynamic-wind + (lambda () + ;; Tell ld.so to list loaded objects, like 'ldd' does. + (setenv "LD_TRACE_LOADED_OBJECTS" "yup")) + (lambda () + (open-pipe* OPEN_READ %guile-executable)) + (lambda () + (unsetenv "LD_TRACE_LOADED_OBJECTS"))))) + (define ldd-rx + (make-regexp "^[[:blank:]]+([[:graph:]]+ => )?([[:graph:]]+) .*$")) + + (define (read-ldd-output port) + ;; Read from PORT output in GNU ldd format. + (let loop ((result '())) + (match (read-line port) + ((? eof-object?) + (reverse result)) + ((= (cut regexp-exec ldd-rx <>) m) + (if m + (loop (cons (match:substring m 2) result)) + (loop result)))))) + + (define ground-truth + (remove (cut string-prefix? "linux-vdso.so" <>) + (read-ldd-output pipe))) + + (and (zero? (close-pipe pipe)) + (lset= string=? (pk 'truth ground-truth) (pk 'needed needed))))) + (test-equal "expand-origin" '("OOO/../lib" "OOO" |