Merge branch 'core-updates'

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).