summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/cmake-build-system.scm11
-rw-r--r--guix/build/gnu-build-system.scm43
-rw-r--r--guix/build/syscalls.scm16
-rw-r--r--guix/build/utils.scm17
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).