From c5cf9ce041905db20b835f1a6a15c52b5dc2a795 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Tue, 9 Apr 2024 13:06:56 +0300 Subject: 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 --- guix/build/graft.scm | 24 ++++-------------------- guix/packages.scm | 6 ++---- 2 files changed, 6 insertions(+), 24 deletions(-) diff --git a/guix/build/graft.scm b/guix/build/graft.scm index c8c7e33ab2..7fc5ecba99 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -299,19 +299,6 @@ a list of store file name pairs." (string-append (dirname file) "/" target)))) 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 #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -383,13 +370,10 @@ file name pairs." (else (error "unsupported file type" stat))))) - ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that - ;; 'n-par-for-each' silently swallows exceptions. - ;; See . - (n-par-for-each (parallel-job-count) - (exit-on-exception rewrite-leaf) - (find-files directory (const #t) - #:directories? #t)) + ;; n-par-for-each can lead to segfaults in the grafting code. + (for-each rewrite-leaf + (find-files directory (const #t) + #:directories? #t)) (rename-matching-files output mapping)) (define %graft-hooks diff --git a/guix/packages.scm b/guix/packages.scm index bd72b284b1..197e2f20b3 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -881,10 +881,8 @@ derivations." (define (guile-for-grafts) "Return the Guile package used to build grafting derivations." - ;; Guile 2.2 would not work due to when - ;; grafting packages. - (let ((distro (resolve-interface '(gnu packages guile)))) - (module-ref distro 'guile-2.0))) + (let ((distro (resolve-interface '(gnu packages commencement)))) + (module-ref distro 'guile-final))) (define* (default-guile-derivation #:optional (system (%current-system))) "Return the derivation for SYSTEM of the default Guile package used to run -- cgit v1.2.3