diff options
Diffstat (limited to 'guix/build')
| -rw-r--r-- | guix/build/cmake-build-system.scm | 11 | ||||
| -rw-r--r-- | guix/build/gnu-build-system.scm | 43 | ||||
| -rw-r--r-- | guix/build/syscalls.scm | 16 | ||||
| -rw-r--r-- | guix/build/utils.scm | 17 |
4 files changed, 73 insertions, 14 deletions
diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 27f2b5c872..128ab28fe5 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -32,7 +32,7 @@ ;; Code: (define* (configure #:key outputs (configure-flags '()) (out-of-source? #t) - build-type + build-type target #:allow-other-keys) "Configure the given package." (let* ((out (assoc-ref outputs "out")) @@ -59,6 +59,15 @@ ,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib") ;; enable verbose output from builds "-DCMAKE_VERBOSE_MAKEFILE=ON" + + ;; Cross-build + ,@(if target + (list (string-append "-DCMAKE_C_COMPILER=" + target "-gcc") + (if (string-contains target "mingw") + "-DCMAKE_SYSTEM_NAME=Windows" + "-DCMAKE_SYSTEM_NAME=Linux")) + '()) ,@configure-flags))) (format #t "running 'cmake' with arguments ~s~%" args) (zero? (apply system* "cmake" args))))) diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 1786e2e3c9..e37b751403 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -39,6 +39,13 @@ ;; ;; Code: +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (define* (set-SOURCE-DATE-EPOCH #:rest _) "Set the 'SOURCE_DATE_EPOCH' environment variable. This is used by tools that incorporate timestamps as a way to tell them to use a fixed timestamp. @@ -521,6 +528,25 @@ DOCUMENTATION-COMPRESSOR-FLAGS." ;; Return #t if FILE has hard links. (> (stat:nlink (lstat file)) 1)) + (define (points-to-symlink? symlink) + ;; Return #t if SYMLINK points to another symbolic link. + (let* ((target (readlink symlink)) + (target-absolute (if (string-prefix? "/" target) + target + (string-append (dirname symlink) + "/" target)))) + (catch 'system-error + (lambda () + (symbolic-link? target-absolute)) + (lambda args + (if (= ENOENT (system-error-errno args)) + (begin + (format (current-error-port) + "The symbolic link '~a' target is missing: '~a'\n" + symlink target-absolute) + #f) + (apply throw args)))))) + (define (maybe-compress-directory directory regexp) (or (not (directory-exists? directory)) (match (find-files directory regexp) @@ -538,12 +564,17 @@ DOCUMENTATION-COMPRESSOR-FLAGS." ;; Compress the non-symlink files, and adjust symlinks to refer ;; to the compressed files. Leave files that have hard links ;; unchanged ('gzip' would refuse to compress them anyway.) - (and (zero? (apply system* documentation-compressor - (append documentation-compressor-flags - (remove has-links? regular-files)))) - (every retarget-symlink - (filter (cut string-match regexp <>) - symlinks))))))))) + ;; Also, do not retarget symbolic links pointing to other + ;; symbolic links, since these are not compressed. + (and (every retarget-symlink + (filter (lambda (symlink) + (and (not (points-to-symlink? symlink)) + (string-match regexp symlink))) + symlinks)) + (zero? + (apply system* documentation-compressor + (append documentation-compressor-flags + (remove has-links? regular-files))))))))))) (define (maybe-compress output) (and (maybe-compress-directory (string-append output "/share/man") diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 33a23edaac..55b0df3911 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -726,15 +726,19 @@ mounted at FILE." (cond-expand (guile-2.2 (define %set-automatic-finalization-enabled?! - (let ((proc (pointer->procedure int - (dynamic-func - "scm_set_automatic_finalization_enabled" - (dynamic-link)) - (list int)))) + ;; When using a statically-linked Guile, for instance in the initrd, we + ;; cannot resolve this symbol, but most of the time we don't need it + ;; anyway. Thus, delay it. + (let ((proc (delay + (pointer->procedure int + (dynamic-func + "scm_set_automatic_finalization_enabled" + (dynamic-link)) + (list int))))) (lambda (enabled?) "Switch on or off automatic finalization in a separate thread. Turning finalization off shuts down the finalization thread as a side effect." - (->bool (proc (if enabled? 1 0)))))) + (->bool ((force proc) (if enabled? 1 0)))))) (define-syntax-rule (without-automatic-finalization exp) "Turn off automatic finalization within the dynamic extent of EXP." diff --git a/guix/build/utils.scm b/guix/build/utils.scm index e8efb0653a..7391307c87 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -32,7 +32,12 @@ #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:re-export (alist-cons - alist-delete) + alist-delete + + ;; Note: Re-export 'delete' to allow for proper syntax matching + ;; in 'modify-phases' forms. See + ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26805#16>. + delete) #:export (%store-directory store-file-name? strip-store-file-name @@ -79,6 +84,7 @@ fold-port-matches remove-store-references wrap-program + invoke locale-category->string)) @@ -574,6 +580,15 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and ((_ phases (add-after old-phase-name new-phase-name new-phase)) (alist-cons-after old-phase-name new-phase-name new-phase phases)))) +(define (invoke program . args) + "Invoke PROGRAM with the given ARGS. Raise an error if the exit +code is non-zero; otherwise return #t." + (let ((status (apply system* program args))) + (unless (zero? status) + (error (format #f "program ~s exited with non-zero code" program) + status)) + #t)) + ;;; ;;; Text substitution (aka. sed). |