1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015, 2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (test-gremlin)
21 #:use-module (guix elf)
22 #:use-module (guix tests)
23 #:use-module ((guix utils) #:select (call-with-temporary-directory))
24 #:use-module (guix build utils)
25 #:use-module (guix build gremlin)
26 #:use-module (srfi srfi-1)
27 #:use-module (srfi srfi-26)
28 #:use-module (srfi srfi-34)
29 #:use-module (srfi srfi-64)
30 #:use-module (rnrs io ports)
31 #:use-module (ice-9 popen)
32 #:use-module (ice-9 rdelim)
33 #:use-module (ice-9 regex)
34 #:use-module (ice-9 match))
36 (define %guile-executable
37 (match (false-if-exception (readlink "/proc/self/exe"))
39 (and (file-exists? program) (elf-file? program)
45 (compose parse-elf get-bytevector-all))
48 (or (which "gcc") (which "cc") (which "g++")))
51 (test-begin "gremlin")
53 (unless %guile-executable (test-skip 1))
54 (test-assert "elf-dynamic-info-needed, executable"
55 (let* ((elf (call-with-input-file %guile-executable read-elf))
56 (dyninfo (elf-dynamic-info elf)))
57 (or (not dyninfo) ;static executable
59 (list (string-append "libguile-" (effective-version))
62 (string-take lib (string-contains lib ".so")))
63 (elf-dynamic-info-needed dyninfo))))))
65 (unless (and %guile-executable (not (getenv "LD_LIBRARY_PATH"))
66 (file-needed %guile-executable) ;statically linked?
67 ;; When Guix has been built on a foreign distro, using a
68 ;; toolchain and libraries from that foreign distro, it is not
69 ;; unusual for the runpath to be empty.
70 (pair? (file-runpath %guile-executable)))
72 (test-assert "file-needed/recursive"
73 (let* ((needed (file-needed/recursive %guile-executable))
76 ;; Tell ld.so to list loaded objects, like 'ldd' does.
77 (setenv "LD_TRACE_LOADED_OBJECTS" "yup"))
79 (open-pipe* OPEN_READ %guile-executable))
81 (unsetenv "LD_TRACE_LOADED_OBJECTS")))))
83 (make-regexp "^[[:blank:]]+([[:graph:]]+ => )?([[:graph:]]+) .*$"))
85 (define (read-ldd-output port)
86 ;; Read from PORT output in GNU ldd format.
87 (let loop ((result '()))
88 (match (read-line port)
91 ((= (cut regexp-exec ldd-rx <>) m)
93 (loop (cons (match:substring m 2) result))
96 (remove (lambda (entry)
97 ;; See vdso(7) for the list of vDSO names across
99 (or (string-prefix? "linux-vdso.so" entry)
100 (string-prefix? "linux-vdso32.so" entry) ;32-bit powerpc
101 (string-prefix? "linux-vdso64.so" entry) ;64-bit powerpc
102 (string-prefix? "linux-gate.so" entry))) ;i386
103 (read-ldd-output pipe)))
105 (and (zero? (close-pipe pipe))
106 ;; It's OK if file-needed/recursive returns multiple entries that are
107 ;; different strings referring to the same file. This appears to be a
108 ;; benign edge case. See: https://issues.guix.gnu.org/52940
109 (lset= file=? (pk 'truth ground-truth) (pk 'needed needed)))))
111 (test-equal "expand-origin"
116 (map (cut expand-origin <> "OOO")
119 "../${ORIGIN}/bar/$ORIGIN/baz"
124 (test-equal "strip-runpath"
126 (call-with-temporary-directory
128 (with-directory-excursion directory
129 (call-with-output-file "t.c"
131 (display "int main () { puts(\"hello\"); }" port)))
132 (invoke c-compiler "t.c"
133 "-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
134 (let* ((dyninfo (elf-dynamic-info
135 (parse-elf (call-with-input-file "a.out"
136 get-bytevector-all))))
137 (old (elf-dynamic-info-runpath dyninfo))
138 (new (strip-runpath "a.out"))
139 (new* (strip-runpath "a.out")))
140 (validate-needed-in-runpath "a.out")
141 (and (member "/foo" old) (member "/bar" old)
142 (not (member "/foo" new))
143 (not (member "/bar" new))
145 (let* ((pipe (open-input-pipe "./a.out"))
146 (str (get-string-all pipe)))
152 (test-equal "set-file-runpath + file-runpath"
154 (call-with-temporary-directory
156 (with-directory-excursion directory
157 (call-with-output-file "t.c"
159 (display "int main () { puts(\"hello\"); }" port)))
161 (invoke c-compiler "t.c"
162 "-Wl,--enable-new-dtags" "-Wl,-rpath=/xxxxxxxxx")
164 (let ((original-runpath (file-runpath "a.out")))
165 (and (member "/xxxxxxxxx" original-runpath)
166 (guard (c ((runpath-too-long-error? c)
167 (string=? "a.out" (runpath-too-long-error-file c))))
168 (set-file-runpath "a.out" (list (make-string 777 #\y))))
169 (let ((runpath (delete "/xxxxxxxxx" original-runpath)))
170 (set-file-runpath "a.out" runpath)
171 (equal? runpath (file-runpath "a.out")))
172 (let* ((pipe (open-input-pipe "./a.out"))
173 (str (get-string-all pipe)))
179 (test-equal "elf-dynamic-info-soname"
181 (call-with-temporary-directory
183 (with-directory-excursion directory
184 (call-with-output-file "t.c"
186 (display "// empty file" port)))
187 (invoke c-compiler "t.c"
188 "-shared" "-Wl,-soname,libfoo.so.2")
189 (let* ((dyninfo (elf-dynamic-info
190 (parse-elf (call-with-input-file "a.out"
191 get-bytevector-all))))
192 (soname (elf-dynamic-info-soname dyninfo)))