me
/
guix
Archived
1
0
Fork 0
Code

graft: Perform grafts with guile-final. 

* guix/build/graft.scm (rewrite-directory): Rewrite store directories in
individual files sequentially.
(exit-on-exception): Remove procedure.
* guix/packages.scm (guile-for-grafts): Switch to guile-final.

Change-Id: I50f7b23a3ceff8bb1495dc1f4bc772746147d924
master
Efraim Flashner 2024-04-09 13:06:56 +03:00
parent 20c4e778a9
commit c74401749a
No known key found for this signature in database
GPG Key ID: 41AAE7DCCA3D8351
2 changed files with 6 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
guix/build/graft.scm
View File

@ -299,19 +299,6 @@ a list of store file name pairs."
(string-append (dirname file) "/" target)))) (string-append (dirname file) "/" target))))
matches))) matches)))
(define (exit-on-exception proc)
"Return a procedure that wraps PROC so that 'primitive-exit' is called when
an exception is caught."
(lambda (arg)
(catch #t
(lambda ()
(proc arg))
(lambda (key . args)
;; Since ports are not thread-safe as of Guile 2.0, reopen stderr.
(let ((port (fdopen 2 "w0")))
(print-exception port #f key args)
(primitive-exit 1))))))
(define* (rewrite-directory directory output mapping (define* (rewrite-directory directory output mapping
#:optional (store (%store-directory))) #:optional (store (%store-directory)))
"Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of
@ -383,13 +370,10 @@ file name pairs."
(else (else
(error "unsupported file type" stat))))) (error "unsupported file type" stat)))))
;; Use 'exit-on-exception' to force an exit upon I/O errors, given that ;; n-par-for-each can lead to segfaults in the grafting code?
;; 'n-par-for-each' silently swallows exceptions. (for-each rewrite-leaf
;; See <http://bugs.gnu.org/23581>. (find-files directory (const #t)
(n-par-for-each (parallel-job-count) #:directories? #t))
(exit-on-exception rewrite-leaf)
(find-files directory (const #t)
#:directories? #t))
(rename-matching-files output mapping)) (rename-matching-files output mapping))
(define %graft-hooks (define %graft-hooks

6
guix/packages.scm
View File

@ -932,10 +932,8 @@ derivations."
(define (guile-for-grafts) (define (guile-for-grafts)
"Return the Guile package used to build grafting derivations." "Return the Guile package used to build grafting derivations."
;; Guile 2.2 would not work due to <https://bugs.gnu.org/28211> when (let ((distro (resolve-interface '(gnu packages commencement))))
;; grafting packages. (module-ref distro 'guile-final)))
(let ((distro (resolve-interface '(gnu packages guile))))
(module-ref distro 'guile-2.0)))
(define* (default-guile-derivation #:optional (system (%current-system))) (define* (default-guile-derivation #:optional (system (%current-system)))
"Return the derivation for SYSTEM of the default Guile package used to run "Return the derivation for SYSTEM of the default Guile package used to run