projects/guix·blob java-team · refs

205 lines · 7.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015, 2018, 2020, 2022 Ludovic Courtès <[email protected]>
3;;; Copyright © 2022 Chris Marusich <[email protected]>
4;;; Copyright © 2022 Pierre Langlois <[email protected]>
5;;;
6;;; This file is part of GNU Guix.
7;;;
8;;; GNU Guix is free software; you can redistribute it and/or modify it
9;;; under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 3 of the License, or (at
11;;; your option) any later version.
12;;;
13;;; GNU Guix is distributed in the hope that it will be useful, but
14;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (test-gremlin)
22 #:use-module (guix elf)
23 #:use-module (guix tests)
24 #:use-module ((guix utils) #:select (call-with-temporary-directory
25 target-aarch64?))
26 #:use-module (guix build utils)
27 #:use-module (guix build gremlin)
28 #:use-module (gnu packages bootstrap)
29 #:use-module (srfi srfi-1)
30 #:use-module (srfi srfi-26)
31 #:use-module (srfi srfi-34)
32 #:use-module (srfi srfi-64)
33 #:use-module (rnrs io ports)
34 #:use-module (ice-9 popen)
35 #:use-module (ice-9 rdelim)
36 #:use-module (ice-9 regex)
37 #:use-module (ice-9 match))
38
39(define %guile-executable
40 (match (false-if-exception (readlink "/proc/self/exe"))
41 ((? string? program)
42 (and (file-exists? program) (elf-file? program)
43 program))
44 (_
45 #f)))
46
47(define read-elf
48 (compose parse-elf get-bytevector-all))
49
50(define c-compiler
51 (or (which "gcc") (which "cc") (which "g++")))
52
53
54(test-begin "gremlin")
55
56(unless %guile-executable (test-skip 1))
57(test-assert "elf-dynamic-info-needed, executable"
58 (let* ((elf (call-with-input-file %guile-executable read-elf))
59 (dyninfo (elf-dynamic-info elf)))
60 (or (not dyninfo) ;static executable
61 (lset<= string=?
62 (list (string-append "libguile-" (effective-version))
63 "libc")
64 (map (lambda (lib)
65 (string-take lib (string-contains lib ".so")))
66 (elf-dynamic-info-needed dyninfo))))))
67
68(unless (and %guile-executable (not (getenv "LD_LIBRARY_PATH"))
69 (file-needed %guile-executable) ;statically linked?
70 ;; When Guix has been built on a foreign distro, using a
71 ;; toolchain and libraries from that foreign distro, it is not
72 ;; unusual for the runpath to be empty.
73 (pair? (file-runpath %guile-executable)))
74 (test-skip 1))
75(test-assert "file-needed/recursive"
76 (let* ((needed (file-needed/recursive %guile-executable))
77 (pipe (dynamic-wind
78 (lambda ()
79 ;; Tell ld.so to list loaded objects, like 'ldd' does.
80 (setenv "LD_TRACE_LOADED_OBJECTS" "yup"))
81 (lambda ()
82 (open-pipe* OPEN_READ %guile-executable))
83 (lambda ()
84 (unsetenv "LD_TRACE_LOADED_OBJECTS")))))
85 (define ldd-rx
86 (make-regexp "^[[:blank:]]+([[:graph:]]+ => )?([[:graph:]]+) .*$"))
87
88 (define (read-ldd-output port)
89 ;; Read from PORT output in GNU ldd format.
90 (let loop ((result '()))
91 (match (read-line port)
92 ((? eof-object?)
93 (reverse result))
94 ((= (cut regexp-exec ldd-rx <>) m)
95 (if m
96 (loop (cons (match:substring m 2) result))
97 (loop result))))))
98 (define ground-truth
99 (remove (lambda (entry)
100 ;; See vdso(7) for the list of vDSO names across
101 ;; architectures.
102 (or (string-prefix? "linux-vdso.so" entry)
103 (string-prefix? "linux-vdso32.so" entry) ;32-bit powerpc
104 (string-prefix? "linux-vdso64.so" entry) ;64-bit powerpc
105 (string-prefix? "linux-gate.so" entry) ;i386
106 ;; FIXME: ELF files on aarch64 do not always include a
107 ;; NEEDED entry for the dynamic linker, and it is unclear
108 ;; if that is OK. See: https://issues.guix.gnu.org/52943
109 (and (target-aarch64?)
110 (string-contains entry (glibc-dynamic-linker)))))
111 (read-ldd-output pipe)))
112
113 (and (zero? (close-pipe pipe))
114 ;; It's OK if file-needed/recursive returns multiple entries that are
115 ;; different strings referring to the same file. This appears to be a
116 ;; benign edge case. See: https://issues.guix.gnu.org/52940
117 (lset= file=? (pk 'truth ground-truth) (pk 'needed needed)))))
118
119(test-equal "expand-origin"
120 '("OOO/../lib"
121 "OOO"
122 "../OOO/bar/OOO/baz"
123 "ORIGIN/foo")
124 (map (cut expand-origin <> "OOO")
125 '("$ORIGIN/../lib"
126 "${ORIGIN}"
127 "../${ORIGIN}/bar/$ORIGIN/baz"
128 "ORIGIN/foo")))
129
130(unless c-compiler
131 (test-skip 1))
132(test-equal "strip-runpath"
133 "hello\n"
134 (call-with-temporary-directory
135 (lambda (directory)
136 (with-directory-excursion directory
137 (call-with-output-file "t.c"
138 (lambda (port)
139 (display "#include <stdio.h>\n" port)
140 (display "int main () { puts(\"hello\"); }" port)))
141 (invoke c-compiler "t.c"
142 "-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
143 (let* ((dyninfo (elf-dynamic-info
144 (parse-elf (call-with-input-file "a.out"
145 get-bytevector-all))))
146 (old (elf-dynamic-info-runpath dyninfo))
147 (new (strip-runpath "a.out"))
148 (new* (strip-runpath "a.out")))
149 (validate-needed-in-runpath "a.out")
150 (and (member "/foo" old) (member "/bar" old)
151 (not (member "/foo" new))
152 (not (member "/bar" new))
153 (equal? new* new)
154 (let* ((pipe (open-input-pipe "./a.out"))
155 (str (get-string-all pipe)))
156 (close-pipe pipe)
157 str)))))))
158
159(unless c-compiler
160 (test-skip 1))
161(test-equal "set-file-runpath + file-runpath"
162 "hello\n"
163 (call-with-temporary-directory
164 (lambda (directory)
165 (with-directory-excursion directory
166 (call-with-output-file "t.c"
167 (lambda (port)
168 (display "#include <stdio.h>\n" port)
169 (display "int main () { puts(\"hello\"); }" port)))
170
171 (invoke c-compiler "t.c"
172 "-Wl,--enable-new-dtags" "-Wl,-rpath=/xxxxxxxxx")
173
174 (let ((original-runpath (file-runpath "a.out")))
175 (and (member "/xxxxxxxxx" original-runpath)
176 (guard (c ((runpath-too-long-error? c)
177 (string=? "a.out" (runpath-too-long-error-file c))))
178 (set-file-runpath "a.out" (list (make-string 777 #\y))))
179 (let ((runpath (delete "/xxxxxxxxx" original-runpath)))
180 (set-file-runpath "a.out" runpath)
181 (equal? runpath (file-runpath "a.out")))
182 (let* ((pipe (open-input-pipe "./a.out"))
183 (str (get-string-all pipe)))
184 (close-pipe pipe)
185 str)))))))
186
187(unless c-compiler
188 (test-skip 1))
189(test-equal "elf-dynamic-info-soname"
190 "libfoo.so.2"
191 (call-with-temporary-directory
192 (lambda (directory)
193 (with-directory-excursion directory
194 (call-with-output-file "t.c"
195 (lambda (port)
196 (display "// empty file" port)))
197 (invoke c-compiler "t.c"
198 "-shared" "-Wl,-soname,libfoo.so.2")
199 (let* ((dyninfo (elf-dynamic-info
200 (parse-elf (call-with-input-file "a.out"
201 get-bytevector-all))))
202 (soname (elf-dynamic-info-soname dyninfo)))
203 soname)))))
204
205(test-end "gremlin")