Merge branch 'master' into gnome-team

5 files changed, 53 insertions, 33 deletions

diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 850b1f5f2a..8e12b5b6d4 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -40,6 +40,7 @@
             emacs-byte-compile-directory
             emacs-compile-directory
             emacs-header-parse
+            ert-number-tests
 
             as-display
             emacs-substitute-sexps
@@ -138,7 +139,7 @@ If native code is not supported, compile to bytecode instead."
            (files (directory-files-recursively ,dir "\\.el$")))
        (mapc
         (lambda (file)
-          (let (byte-to-native-output-file
+          (let (byte-to-native-output-buffer-file
                 ;; First entry is the eln-cache of the homeless shelter,
                 ;; second entry is the install directory.
                 (eln-dir (and (native-comp-available-p)
@@ -147,13 +148,9 @@ If native code is not supported, compile to bytecode instead."
                 (native-compile file
                                 (comp-el-to-eln-filename file eln-dir))
                 (byte-compile-file file))
-            ;; Sadly, we can't use pcase because quasiquote works different in
-            ;; Emacs.  See `batch-byte+native-compile' in comp.el for the
-            ;; actual shape of byte-to-native-output-file.
-            (unless (null byte-to-native-output-file)
-              (rename-file (car byte-to-native-output-file)
-                           (cdr byte-to-native-output-file)
-                           t))))
+            ;; After native compilation, write the bytecode file.
+            (unless (null byte-to-native-output-buffer-file)
+              (comp-write-bytecode-file nil))))
        files))
     #:dynamic? #t))
 
@@ -183,6 +180,19 @@ If native code is not supported, compile to bytecode instead."
              (insert " ")
              (insert ,(format #f "~s" replacement))))))
 
+(define (ert-number-tests file test-name)
+  "Add a numerically increasing suffix to tests of the same name.
+This fixes test errors of the pattern \"Test TEST_NAME redefined\"."
+  (emacs-batch-edit-file file
+    `(let ((i 0))
+       (while (re-search-forward ,(string-append "ert-deftest " test-name)
+                                 nil t)
+         (goto-char (match-beginning 0))
+         (kill-region (match-beginning 0) (match-end 0))
+         (insert (format "ert-deftest %s-%d" ,test-name i))
+         (setq i (+ i 1)))
+       (basic-save-buffer))))
+
 (define-syntax emacs-substitute-sexps
   (syntax-rules ()
     "Substitute the S-expression immediately following the first occurrence of
diff --git a/guix/git.scm b/guix/git.scm
index 1cb87a4560..1b3355109e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -360,21 +361,16 @@ dynamic extent of EXP."
 (define (reference-available? repository ref)
   "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
 definitely available in REPOSITORY, false otherwise."
-  ;; Note: this must not rely on 'resolve-reference', as that procedure always
-  ;; resolves the references for branch names such as master.  The semantic we
-  ;; want here is that unless the reference is exact (e.g. a commit), the
-  ;; reference should not be considered available, as it could have changed on
-  ;; the remote.
   (match ref
-    ((or ('commit . commit)
-         ('tag-or-commit . (? commit-id? commit)))
-     (let ((len (string-length commit))
-           (oid (string->oid commit)))
-       (false-if-git-not-found
-        (->bool (if (< len 40)
-                    (object-lookup-prefix repository oid len OBJ-COMMIT)
-                    (commit-lookup repository oid))))))
+    (('commit . (? commit-id? commit))
+     (let ((oid (string->oid commit)))
+       (->bool (commit-lookup repository oid))))
+    ((or ('tag . str)
+         ('tag-or-commit . str))
+     (false-if-git-not-found
+      (->bool (resolve-reference repository ref))))
     (_
+     ;; For the others REF as branch or symref, the REF cannot be available
      #f)))
 
 (define (clone-from-swh url tag-or-commit output)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index ec331809ef..547387d5e1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1169,7 +1169,7 @@ Some ACTIONS support additional ARGS.\n"))
     (debug . 0)
     (verbosity . #f)                              ;default
     (validate-reconfigure . ,ensure-forward-reconfigure)
-    (image-type . mbr-raw)
+    (image-type . mbr-hybrid-raw)
     (image-size . guess)
     (install-bootloader? . #t)
     (label . #f)
diff --git a/guix/self.scm b/guix/self.scm
index 81a36e007f..b8b9b9fe37 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1210,7 +1211,8 @@ containing MODULE-FILES and possibly other files as well."
                             '((guix build compile)
                               (guix build utils)))
       #~(begin
-          (use-modules (srfi srfi-26)
+          (use-modules (srfi srfi-1)
+                       (srfi srfi-26)
                        (ice-9 match)
                        (ice-9 format)
                        (ice-9 threads)
@@ -1243,13 +1245,23 @@ containing MODULE-FILES and possibly other files as well."
                     (* 100. (/ completed total)) total)
             (force-output))
 
-          (define (process-directory directory files output)
-            ;; Hide compilation warnings.
-            (parameterize ((current-warning-port (%make-void-port "w")))
-              (compile-files directory #$output files
-                             #:workers (parallel-job-count)
-                             #:report-load report-load
-                             #:report-compilation report-compilation)))
+          (define* (process-directory directory files output #:key (size 25))
+            (let ((chunks (unfold
+                           (lambda (seed) (< (length seed) size)) ;p
+                           (cute take <> size)                    ;f
+                           (cute drop <> size)                    ;g
+                           files                                  ;seed
+                           list)))                                ;tail
+              (for-each
+               (lambda (chunk)
+                 ;; Hide compilation warnings.
+                 (parameterize ((current-warning-port (%make-void-port "w")))
+                   (compile-files directory output chunk
+                                  #:workers (parallel-job-count)
+                                  #:report-load report-load
+                                  #:report-compilation report-compilation)
+                   (gc)))
+               chunks)))
 
           (setvbuf (current-output-port) 'line)
           (setvbuf (current-error-port) 'line)
@@ -1277,7 +1289,8 @@ containing MODULE-FILES and possibly other files as well."
 
           (mkdir #$output)
           (chdir #+module-tree)
-          (process-directory "." '#+module-files #$output)
+          (let ((size (if (equal? #$name "guix-packages-base") 10 25)))
+            (process-directory "." '#+module-files #$output #:size size))
           (newline))))
 
   (computed-file name build
diff --git a/guix/transformations.scm b/guix/transformations.scm
index ede914456f..9cba6bedab 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -529,8 +529,9 @@ system that builds code for MICRO-ARCHITECTURE; otherwise raise an error."
     ;; leading to an obscure build error, check whether the compiler is known
     ;; to support MICRO-ARCHITECTURE.  If not, bail out.
     (let* ((lowered      (apply lower args))
-           (architecture (match (string-tokenize (bag-system lowered)
-                                                 %not-hyphen)
+           (target (or (bag-target lowered)
+                       (bag-system lowered)))
+           (architecture (match (string-tokenize target %not-hyphen)
                            ((arch _ ...) arch)))
            (compiler     (any (match-lambda
                                 ((label (? package? p) . _)