Revert "Use mmap for the elf parser, reducing memory usage."

This reverts commit 2c1fe0df11ae0f66392b8abb6f62430d79305538.
author: Maxim Cournoyer <maxim@guixotic.coop> 2025-10-30 16:19:50 +0900
committer: Maxim Cournoyer <maxim@guixotic.coop> 2025-10-30 16:19:50 +0900
commit: 0f39db9c1942969bcbc603b306d8e47f8feb8566 (patch)
tree: 4c277554d2167559e9325afc191c53e262733918 /tests/debug-link.scm
parent: 9d60fdf6a2e482e7d52184521191c14449619aec (diff)
1 files changed, 90 insertions, 97 deletions
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index 7ccc054a5d9..a1ae4f141c0 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -1,6 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,15 +20,12 @@
  #:use-module (guix elf)
  #:use-module (guix build utils)
  #:use-module (guix build debug-link)
-  #:use-module (guix build io)
  #:use-module (guix gexp)
-  #:use-module (guix modules)
  #:use-module (guix store)
  #:use-module (guix tests)
  #:use-module (guix monads)
  #:use-module (guix derivations)
  #:use-module (gnu packages bootstrap)
-  #:use-module ((gnu packages guile) #:select (guile-3.0))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
@@ -44,12 +40,15 @@
    (_
     #f)))
+(define read-elf
+  (compose parse-elf get-bytevector-all))
 (test-begin "debug-link")
 (unless %guile-executable (test-skip 1))
-(test-assert "elf-debuglink, no .gnu_debuglink section"
+(test-assert "elf-debuglink"
-  (let ((elf (parse-elf (file->bytevector %guile-executable))))
+  (let ((elf (call-with-input-file %guile-executable read-elf)))
    (match (call-with-values (lambda () (elf-debuglink elf)) list)
      ((#f #f)                                    ;no '.gnu_debuglink' section
       (pk 'no-debuglink #t))
@@ -57,101 +56,95 @@
       (string-suffix? ".debug" file)))))
 ;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests
-;; when networking is unreachable because we'd fail to download it.  Since
+;; when networking is unreachable because we'd fail to download it.
-;; using mmap to load ELF more efficiently, we also need the regular Guile
+(unless (network-reachable?) (test-skip 1))
-;; package, as guile-bootstrap cannot resolve dynamic symbols.
+(test-assertm "elf-debuglink"
-(with-external-store store
+  ;; Check whether we can compute the CRC just like objcopy, and whether we
-  (unless (and (network-reachable?) store) (test-skip 1))
+  ;; can retrieve it.
-  (test-assertm "elf-debuglink"
+  (let* ((code (plain-file "test.c" "int main () { return 42; }"))
-      ;; Check whether we can compute the CRC just like objcopy, and whether we
+         (exp  (with-imported-modules '((guix build utils)
-      ;; can retrieve it.
+                                        (guix build debug-link)
-      (let* ((code (plain-file "test.c" "int main () { return 42; }"))
+                                        (guix elf))
-             (exp  (with-imported-modules (source-module-closure
+                 #~(begin
-                                           '((guix build io)
+                     (use-modules (guix build utils)
-                                             (guix build utils)
+                                  (guix build debug-link)
-                                             (guix build debug-link)
+                                  (guix elf)
-                                             (guix elf)))
+                                  (rnrs io ports))
-                     #~(begin
-                         (use-modules (guix build io)
-                                      (guix build utils)
-                                      (guix build debug-link)
-                                      (guix elf)
-                                      (rnrs io ports))
-                         (define read-elf
+                     (define read-elf
-                           (compose parse-elf file->bytevector))
+                       (compose parse-elf get-bytevector-all))
-                         (setenv "PATH" (string-join '(#$%bootstrap-gcc
+                     (setenv "PATH" (string-join '(#$%bootstrap-gcc
-                                                       #$%bootstrap-binutils)
+                                                   #$%bootstrap-binutils)
-                                                     "/bin:" 'suffix))
+                                                 "/bin:" 'suffix))
-                         (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+                     (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
-                         (copy-file "exe" "exe.debug")
+                     (copy-file "exe" "exe.debug")
-                         (invoke "strip" "--only-keep-debug" "exe.debug")
+                     (invoke "strip" "--only-keep-debug" "exe.debug")
-                         (invoke "strip" "--strip-debug" "exe")
+                     (invoke "strip" "--strip-debug" "exe")
-                         (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+                     (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
-                                 "exe")
+                             "exe")
-                         (call-with-values (lambda ()
+                     (call-with-values (lambda ()
-                                             (elf-debuglink (read-elf "exe")))
+                                         (elf-debuglink
-                           (lambda (file crc)
+                                          (call-with-input-file "exe"
-                             (call-with-output-file #$output
+                                            read-elf)))
-                               (lambda (port)
+                       (lambda (file crc)
-                                 (let ((expected (call-with-input-file "exe.debug"
+                         (call-with-output-file #$output
-                                                   debuglink-crc32)))
+                           (lambda (port)
-                                   (write (list file (= crc expected))
+                             (let ((expected (call-with-input-file "exe.debug"
-                                          port))))))))))
+                                               debuglink-crc32)))
-        (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+                               (write (list file (= crc expected))
-                             (x   (built-derivations (list drv))))
+                                      port))))))))))
-          (call-with-input-file (derivation->output-path drv)
+    (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
-            (lambda (port)
+                         (x   (built-derivations (list drv))))
-              (return (match (read port)
+      (call-with-input-file (derivation->output-path drv)
-                        (("exe.debug" #t) #t)
+        (lambda (port)
-                        (x                (pk 'fail x #f)))))))))
+          (return (match (read port)
+                    (("exe.debug" #t) #t)
+                    (x                (pk 'fail x #f)))))))))
-  (unless (and (network-reachable?) store) (test-skip 1))
+(unless (network-reachable?) (test-skip 1))
-  (test-assertm "set-debuglink-crc"
+(test-assertm "set-debuglink-crc"
-      ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
+  ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
-      (let* ((code  (plain-file "test.c" "int main () { return 42; }"))
+  (let* ((code  (plain-file "test.c" "int main () { return 42; }"))
-             (debug (plain-file "exe.debug" "a"))
+         (debug (plain-file "exe.debug" "a"))
-             (exp   (with-imported-modules (source-module-closure
+         (exp   (with-imported-modules '((guix build utils)
-                                            '((guix build io)
+                                         (guix build debug-link)
-                                              (guix build utils)
+                                         (guix elf))
-                                              (guix build debug-link)
+                  #~(begin
-                                              (guix elf)))
+                      (use-modules (guix build utils)
-                      #~(begin
+                                   (guix build debug-link)
-                          (use-modules (guix build io)
+                                   (guix elf)
-                                       (guix build utils)
+                                   (rnrs io ports))
-                                       (guix build debug-link)
-                                       (guix elf)
-                                       (rnrs io ports))
-                          (define read-elf
+                      (define read-elf
-                            (compose parse-elf file->bytevector))
+                        (compose parse-elf get-bytevector-all))
-                          (setenv "PATH" (string-join '(#$%bootstrap-gcc
+                      (setenv "PATH" (string-join '(#$%bootstrap-gcc
-                                                        #$%bootstrap-binutils)
+                                                    #$%bootstrap-binutils)
-                                                      "/bin:" 'suffix))
+                                                  "/bin:" 'suffix))
-                          (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+                      (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
-                          (copy-file "exe" "exe.debug")
+                      (copy-file "exe" "exe.debug")
-                          (invoke "strip" "--only-keep-debug" "exe.debug")
+                      (invoke "strip" "--only-keep-debug" "exe.debug")
-                          (invoke "strip" "--strip-debug" "exe")
+                      (invoke "strip" "--strip-debug" "exe")
-                          (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+                      (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
-                                  "exe")
+                              "exe")
-                          (set-debuglink-crc "exe" #$debug)
+                      (set-debuglink-crc "exe" #$debug)
-                          (call-with-values (lambda ()
+                      (call-with-values (lambda ()
-                                              (elf-debuglink
+                                          (elf-debuglink
-                                               (read-elf "exe")))
+                                           (call-with-input-file "exe"
-                            (lambda (file crc)
+                                             read-elf)))
-                              (call-with-output-file #$output
+                        (lambda (file crc)
-                                (lambda (port)
+                          (call-with-output-file #$output
-                                  (write (list file crc) port)))))))))
+                            (lambda (port)
-        (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+                              (write (list file crc) port)))))))))
-                             (x   (built-derivations (list drv))))
+    (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
-          (call-with-input-file (derivation->output-path drv)
+                         (x   (built-derivations (list drv))))
-            (lambda (port)
+      (call-with-input-file (derivation->output-path drv)
-              (return (match (read port)
+        (lambda (port)
-                        (("exe.debug" crc)
+          (return (match (read port)
-                         (= crc (debuglink-crc32 (open-input-string "a"))))
+                    (("exe.debug" crc)
-                        (x
+                     (= crc (debuglink-crc32 (open-input-string "a"))))
-                         (pk 'fail x #f))))))))))
+                    (x
+                     (pk 'fail x #f)))))))))
 (test-end "debug-link")
author	Maxim Cournoyer <maxim@guixotic.coop>	2025-10-30 16:19:50 +0900
committer	Maxim Cournoyer <maxim@guixotic.coop>	2025-10-30 16:19:50 +0900
commit	0f39db9c1942969bcbc603b306d8e47f8feb8566 (patch)
tree	4c277554d2167559e9325afc191c53e262733918 /tests/debug-link.scm
parent	9d60fdf6a2e482e7d52184521191c14449619aec (diff)

diff --git a/tests/debug-link.scm b/tests/debug-link.scm index 7ccc054a5d9..a1ae4f141c0 100644 --- a/tests/debug-link.scm +++ b/tests/debug-link.scm
@@ -1,6 +1,5 @@
1	;;; GNU Guix --- Functional package management for GNU	1	;;; GNU Guix --- Functional package management for GNU
2	;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>	2	;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
3	;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
4	;;;	3	;;;
5	;;; This file is part of GNU Guix.	4	;;; This file is part of GNU Guix.
6	;;;	5	;;;
@@ -21,15 +20,12 @@
21	#:use-module (guix elf)	20	#:use-module (guix elf)
22	#:use-module (guix build utils)	21	#:use-module (guix build utils)
23	#:use-module (guix build debug-link)	22	#:use-module (guix build debug-link)
24	#:use-module (guix build io)
25	#:use-module (guix gexp)	23	#:use-module (guix gexp)
26	#:use-module (guix modules)
27	#:use-module (guix store)	24	#:use-module (guix store)
28	#:use-module (guix tests)	25	#:use-module (guix tests)
29	#:use-module (guix monads)	26	#:use-module (guix monads)
30	#:use-module (guix derivations)	27	#:use-module (guix derivations)
31	#:use-module (gnu packages bootstrap)	28	#:use-module (gnu packages bootstrap)
32	#:use-module ((gnu packages guile) #:select (guile-3.0))
33	#:use-module (srfi srfi-1)	29	#:use-module (srfi srfi-1)
34	#:use-module (srfi srfi-26)	30	#:use-module (srfi srfi-26)
35	#:use-module (srfi srfi-64)	31	#:use-module (srfi srfi-64)
@@ -44,12 +40,15 @@
44	(_	40	(_
45	#f)))	41	#f)))
46		42
		43	(define read-elf
		44	(compose parse-elf get-bytevector-all))
		45
47		46
48	(test-begin "debug-link")	47	(test-begin "debug-link")
49		48
50	(unless %guile-executable (test-skip 1))	49	(unless %guile-executable (test-skip 1))
51	(test-assert "elf-debuglink, no .gnu_debuglink section"	50	(test-assert "elf-debuglink"
52	(let ((elf (parse-elf (file->bytevector %guile-executable))))	51	(let ((elf (call-with-input-file %guile-executable read-elf)))
53	(match (call-with-values (lambda () (elf-debuglink elf)) list)	52	(match (call-with-values (lambda () (elf-debuglink elf)) list)
54	((#f #f) ;no '.gnu_debuglink' section	53	((#f #f) ;no '.gnu_debuglink' section
55	(pk 'no-debuglink #t))	54	(pk 'no-debuglink #t))
@@ -57,101 +56,95 @@
57	(string-suffix? ".debug" file)))))	56	(string-suffix? ".debug" file)))))
58		57
59	;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests	58	;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests
60	;; when networking is unreachable because we'd fail to download it. Since	59	;; when networking is unreachable because we'd fail to download it.
61	;; using mmap to load ELF more efficiently, we also need the regular Guile	60	(unless (network-reachable?) (test-skip 1))
62	;; package, as guile-bootstrap cannot resolve dynamic symbols.	61	(test-assertm "elf-debuglink"
63	(with-external-store store	62	;; Check whether we can compute the CRC just like objcopy, and whether we
64	(unless (and (network-reachable?) store) (test-skip 1))	63	;; can retrieve it.
65	(test-assertm "elf-debuglink"	64	(let* ((code (plain-file "test.c" "int main () { return 42; }"))
66	;; Check whether we can compute the CRC just like objcopy, and whether we	65	(exp (with-imported-modules '((guix build utils)
67	;; can retrieve it.	66	(guix build debug-link)
68	(let* ((code (plain-file "test.c" "int main () { return 42; }"))	67	(guix elf))
69	(exp (with-imported-modules (source-module-closure	68	#~(begin
70	'((guix build io)	69	(use-modules (guix build utils)
71	(guix build utils)	70	(guix build debug-link)
72	(guix build debug-link)	71	(guix elf)
73	(guix elf)))	72	(rnrs io ports))
74	#~(begin
75	(use-modules (guix build io)
76	(guix build utils)
77	(guix build debug-link)
78	(guix elf)
79	(rnrs io ports))
80		73
81	(define read-elf	74	(define read-elf
82	(compose parse-elf file->bytevector))	75	(compose parse-elf get-bytevector-all))
83		76
84	(setenv "PATH" (string-join '(#$%bootstrap-gcc	77	(setenv "PATH" (string-join '(#$%bootstrap-gcc
85	#$%bootstrap-binutils)	78	#$%bootstrap-binutils)
86	"/bin:" 'suffix))	79	"/bin:" 'suffix))
87	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")	80	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")
88	(copy-file "exe" "exe.debug")	81	(copy-file "exe" "exe.debug")
89	(invoke "strip" "--only-keep-debug" "exe.debug")	82	(invoke "strip" "--only-keep-debug" "exe.debug")
90	(invoke "strip" "--strip-debug" "exe")	83	(invoke "strip" "--strip-debug" "exe")
91	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"	84	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"
92	"exe")	85	"exe")
93	(call-with-values (lambda ()	86	(call-with-values (lambda ()
94	(elf-debuglink (read-elf "exe")))	87	(elf-debuglink
95	(lambda (file crc)	88	(call-with-input-file "exe"
96	(call-with-output-file #$output	89	read-elf)))
97	(lambda (port)	90	(lambda (file crc)
98	(let ((expected (call-with-input-file "exe.debug"	91	(call-with-output-file #$output
99	debuglink-crc32)))	92	(lambda (port)
100	(write (list file (= crc expected))	93	(let ((expected (call-with-input-file "exe.debug"
101	port))))))))))	94	debuglink-crc32)))
102	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))	95	(write (list file (= crc expected))
103	(x (built-derivations (list drv))))	96	port))))))))))
104	(call-with-input-file (derivation->output-path drv)	97	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
105	(lambda (port)	98	(x (built-derivations (list drv))))
106	(return (match (read port)	99	(call-with-input-file (derivation->output-path drv)
107	(("exe.debug" #t) #t)	100	(lambda (port)
108	(x (pk 'fail x #f)))))))))	101	(return (match (read port)
		102	(("exe.debug" #t) #t)
		103	(x (pk 'fail x #f)))))))))
109		104
110	(unless (and (network-reachable?) store) (test-skip 1))	105	(unless (network-reachable?) (test-skip 1))
111	(test-assertm "set-debuglink-crc"	106	(test-assertm "set-debuglink-crc"
112	;; Check whether 'set-debuglink-crc' successfully updates the CRC.	107	;; Check whether 'set-debuglink-crc' successfully updates the CRC.
113	(let* ((code (plain-file "test.c" "int main () { return 42; }"))	108	(let* ((code (plain-file "test.c" "int main () { return 42; }"))
114	(debug (plain-file "exe.debug" "a"))	109	(debug (plain-file "exe.debug" "a"))
115	(exp (with-imported-modules (source-module-closure	110	(exp (with-imported-modules '((guix build utils)
116	'((guix build io)	111	(guix build debug-link)
117	(guix build utils)	112	(guix elf))
118	(guix build debug-link)	113	#~(begin
119	(guix elf)))	114	(use-modules (guix build utils)
120	#~(begin	115	(guix build debug-link)
121	(use-modules (guix build io)	116	(guix elf)
122	(guix build utils)	117	(rnrs io ports))
123	(guix build debug-link)
124	(guix elf)
125	(rnrs io ports))
126		118
127	(define read-elf	119	(define read-elf
128	(compose parse-elf file->bytevector))	120	(compose parse-elf get-bytevector-all))
129		121
130	(setenv "PATH" (string-join '(#$%bootstrap-gcc	122	(setenv "PATH" (string-join '(#$%bootstrap-gcc
131	#$%bootstrap-binutils)	123	#$%bootstrap-binutils)
132	"/bin:" 'suffix))	124	"/bin:" 'suffix))
133	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")	125	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")
134	(copy-file "exe" "exe.debug")	126	(copy-file "exe" "exe.debug")
135	(invoke "strip" "--only-keep-debug" "exe.debug")	127	(invoke "strip" "--only-keep-debug" "exe.debug")
136	(invoke "strip" "--strip-debug" "exe")	128	(invoke "strip" "--strip-debug" "exe")
137	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"	129	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"
138	"exe")	130	"exe")
139	(set-debuglink-crc "exe" #$debug)	131	(set-debuglink-crc "exe" #$debug)
140	(call-with-values (lambda ()	132	(call-with-values (lambda ()
141	(elf-debuglink	133	(elf-debuglink
142	(read-elf "exe")))	134	(call-with-input-file "exe"
143	(lambda (file crc)	135	read-elf)))
144	(call-with-output-file #$output	136	(lambda (file crc)
145	(lambda (port)	137	(call-with-output-file #$output
146	(write (list file crc) port)))))))))	138	(lambda (port)
147	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))	139	(write (list file crc) port)))))))))
148	(x (built-derivations (list drv))))	140	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
149	(call-with-input-file (derivation->output-path drv)	141	(x (built-derivations (list drv))))
150	(lambda (port)	142	(call-with-input-file (derivation->output-path drv)
151	(return (match (read port)	143	(lambda (port)
152	(("exe.debug" crc)	144	(return (match (read port)
153	(= crc (debuglink-crc32 (open-input-string "a"))))	145	(("exe.debug" crc)
154	(x	146	(= crc (debuglink-crc32 (open-input-string "a"))))
155	(pk 'fail x #f))))))))))	147	(x
		148	(pk 'fail x #f)))))))))
156		149
157	(test-end "debug-link")	150	(test-end "debug-link")