fix: ignore invalid Guix progress updates

Reject nonsensical download-progress values before updating status or rendering progress. This keeps malformed trace fragments from producing invalid progress math while preserving the previous behavior for ordinary malformed non-numeric events.\n\nCover both status reduction and quiet event rendering with overrun progress tests.

(cherry picked from commit d240c0dc76)

.guix-authorizations

@@ -120,6 +120,8 @@
    (name "sharlatan"))
   ("F494 72F4 7A59 00D5 C235  F212 89F9 6D48 08F3 59C7"
    (name "snape"))
+  ("6688 9153 C51C 4613 A493  A525 2F0D FD14 EF99 DAC3"
+   (name "steffen"))
   ("6580 7361 3BFC C5C7 E2E4  5D45 DC51 8FC8 7F97 16AA"
    (name "vagrantc"))
   (;; primary: "C955 CC5D C048 7FB1 7966  40A9 199A F6A3 67E9 4ABB"

doc/guix.texi

@@ -16124,6 +16124,10 @@ the tag name for separating the numbers of the version.
 pre-releases; to make it also look for pre-releases, set the this
 property to @code{#t}.
 
+@item @code{stable-version-regexp}: a regular expression for matching the
+version string, if specified the updater will pick the latest version from
+matching ones when the @option{--target-version} option is omitted.
+
 @end itemize
 
 @lisp

gnu/local.mk

@@ -1993,6 +1993,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/nhc98-c-update.patch			\
   %D%/packages/patches/nheko-0-12-1-fix-rendering-replies.patch	\
   %D%/packages/patches/nix-dont-build-html-doc.diff		\
+  %D%/packages/patches/nlohmann_json_fix_char8_t.patch		\
   %D%/packages/patches/nfs4-acl-tools-0.3.7-fixpaths.patch	\
   %D%/packages/patches/neovim-tree-sitter-grammar-path.patch	\
   %D%/packages/patches/network-manager-plugin-ownership.patch	\

gnu/packages/chicken.scm

@@ -20,65 +20,113 @@
 
 (define-module (gnu packages chicken)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bash)
+  #:use-module (guix gexp)
   #:use-module (guix packages)
+  #:use-module (guix utils)
   #:use-module (guix build-system chicken)
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module (guix svn-download)
   #:use-module ((guix licenses)
-                #:prefix license:))
+                #:prefix license:)
+  #:use-module (srfi srfi-1))
 
+;; This package is build from pre-built C source code, provided in the CHICKEN
+;; release tarball.  Based on this bootstrap compiler, we build CHICKEN from
+;; the Scheme source, thus enabling us to (at least) patch it.
+;;
+;; See <https://issues.guix.gnu.org/22366>.
+(define-public chicken-bootstrap
+  (hidden-package
+   (package
+     (name "chicken-bootstrap")
+     (version "5.4.0")
+     (source (origin
+               (method url-fetch)
+               (uri (string-append "https://code.call-cc.org/releases/"
+                                   version "/chicken-" version ".tar.gz"))
+               (sha256
+                (base32
+                 "0pzcrnzkjw2sa44vy59wbygvlc3nva8zisprkdnvyrqi3jk4lp9w"))))
+     (build-system gnu-build-system)
+     (arguments
+      `(#:modules ((guix build gnu-build-system)
+                   (guix build utils)
+                   (srfi srfi-1))
+
+        ;; No `configure' script; run "make check" after "make install" as
+        ;; prescribed by README.
+        #:phases
+        (modify-phases %standard-phases
+          (delete 'configure)
+          (delete 'check)
+          (add-after 'install 'check
+            (assoc-ref %standard-phases 'check)))
+
+        #:make-flags (let ((out (assoc-ref %outputs "out")))
+                       (list "PLATFORM=linux"
+                             (string-append "PREFIX=" out)
+                             (string-append "VARDIR=" out "/var/lib")))
+
+        ;; Parallel builds are not supported, as noted in README.
+        #:parallel-build? #f))
+     (native-search-paths
+      (list (search-path-specification
+             (variable "CHICKEN_REPOSITORY_PATH")
+             ;; TODO extract binary version into a module level definition.
+             (files (list "var/lib/chicken/11")))))
+     ;; Reference gcc-toolchain lazily to avoid circular module dependency
+     ;; problems.
+     (propagated-inputs (list (module-ref (resolve-interface
+                                           '(gnu packages commencement))
+                                          'gcc-toolchain)))
+     (home-page "https://www.call-cc.org/")
+     (synopsis "R5RS Scheme implementation that compiles native code via C")
+     (description
+      "CHICKEN is a compiler for the Scheme programming language.  CHICKEN
+pr oduces portable and efficient C, supports almost all of the R5RS Scheme
+la nguage standard, and includes many enhancements and extensions.")
+     (license license:bsd-3))))
+
+;; The CHICKEN compiler is itself written in CHICKEN, the CHICKEN release
+;; tarballs includes auto-generated C code to mitigate the compiler
+;; bootstrapping problem.  To be able to patch the original Scheme source,
+;; we compile from this Scheme source here using the chicken-bootstrap
+;; compiler obtained from the autogenerated C code.
+;;
+;; See <https://issues.guix.gnu.org/22366>.
 (define-public chicken
   (package
+    (inherit chicken-bootstrap)
     (name "chicken")
-    (version "5.4.0")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "https://code.call-cc.org/releases/"
-                                  version "/chicken-" version ".tar.gz"))
-              (sha256
-               (base32
-                "0pzcrnzkjw2sa44vy59wbygvlc3nva8zisprkdnvyrqi3jk4lp9w"))))
-    (build-system gnu-build-system)
     (arguments
-     `(#:modules ((guix build gnu-build-system)
-                  (guix build utils)
-                  (srfi srfi-1))
-
-       ;; No `configure' script; run "make check" after "make install" as
-       ;; prescribed by README.
-       #:phases
-       (modify-phases %standard-phases
-         (delete 'configure)
-         (delete 'check)
-         (add-after 'install 'check
-           (assoc-ref %standard-phases 'check)))
-
-       #:make-flags (let ((out (assoc-ref %outputs "out")))
-                      (list "PLATFORM=linux"
-                            (string-append "PREFIX=" out)
-                            (string-append "VARDIR=" out "/var/lib")))
-
-       ;; Parallel builds are not supported, as noted in README.
-       #:parallel-build? #f))
-    (native-search-paths
-     (list (search-path-specification
-            (variable "CHICKEN_REPOSITORY_PATH")
-            ;; TODO extract binary version into a module level definition.
-            (files (list "var/lib/chicken/11")))))
-    ;; Reference gcc-toolchain lazily to avoid circular module dependency
-    ;; problems.
-    (propagated-inputs (list (module-ref (resolve-interface
-                                          '(gnu packages commencement))
-                                         'gcc-toolchain)))
-    (home-page "https://www.call-cc.org/")
-    (synopsis "R5RS Scheme implementation that compiles native code via C")
-    (description
-     "CHICKEN is a compiler for the Scheme programming language.  CHICKEN
-produces portable and efficient C, supports almost all of the R5RS Scheme
-language standard, and includes many enhancements and extensions.")
-    (license license:bsd-3)))
+     (substitute-keyword-arguments (package-arguments chicken-bootstrap)
+       ((#:phases phases)
+        #~(modify-phases #$phases
+            ;; CHICKEN contains auto-generated C code, remove it and
+            ;; compile from the Scheme source using chicken-bootstrap.
+            (add-after 'unpack 'remove-auto-generated-code
+              (lambda _
+                (invoke "make" "spotless")))
+            ;; Invoke commands by name, not by path.
+            ;;
+            ;; See <https://codeberg.org/guix/guix/issues/8471>.
+            (add-after 'unpack 'fix-paths
+              (lambda* (#:key inputs #:allow-other-keys)
+                (let ((sh (search-input-file inputs "/bin/sh"))
+                      (cp (search-input-file inputs "/bin/cp")))
+                  (substitute* "egg-compile.scm"
+                    (("/bin/sh") sh)
+                    (("\"cp\"") (string-append "\"" cp "\"")))
+                  (substitute* "posixunix.scm"
+                    (("/bin/sh") sh))
+                  (substitute* "chicken-install.scm"
+                    (("\"sh \"") (string-append "\"" sh " \""))))))))))
+    (inputs (list chicken-bootstrap))
+    (properties
+     (alist-delete 'hidden? (package-properties chicken-bootstrap)))))
 
 (define-public chicken-compile-file
   (package

gnu/packages/compression.scm

@@ -42,6 +42,7 @@
 ;;; Copyright © 2024 David Elsing <david.elsing@posteo.net>
 ;;; Copyright © 2024 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2024, 2025 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2026 Jake Forster <jakecameron.forster@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -3191,3 +3192,33 @@ exported by the zlib library.")
 ratio at the cost of high CPU/memory usage.")
     (home-page "https://github.com/byronknoll/cmix")
     (license license:gpl3)))
+
+(define-public zlib-ng
+  (package
+    (name "zlib-ng")
+    (version "2.3.3")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                     (url "https://github.com/zlib-ng/zlib-ng")
+                     (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0g4pxy7gc1slw9n6j583hzps32mml30f08gmmg1adsq4y3dl2cny"))))
+    (build-system cmake-build-system)
+    (native-inputs (list googletest))
+    (home-page "https://github.com/zlib-ng/zlib-ng")
+    (synopsis "Fork of the zlib data compression library")
+    (description
+     "zlib-ng is a @code{zlib} replacement with optimizations for next
+generation systems.")
+    (license license:zlib)))
+
+(define-public zlib-ng-compat
+  (package/inherit zlib-ng
+    (name "zlib-ng-compat")
+    (arguments
+     (substitute-keyword-arguments arguments
+       ((#:configure-flags flags #~(list))
+        #~(cons "-DZLIB_COMPAT=ON" #$flags))))))

gnu/packages/cpp.scm

@@ -53,6 +53,7 @@
 ;;; Copyright © 2025 Murilo <murilo@disroot.org>
 ;;; Copyright © 2026 Justin Veilleux <terramorpha@cock.li>
 ;;; Copyright © 2026 Daniel Littlewood <dan@danielittlewood.xyz>
+;;; Copyright © 2026 bdunahu <bdunahu@operationnull.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1433,6 +1434,9 @@ data transfer object.")
 (define-public nlohmann-json
   (package
     (name "nlohmann-json")
+    ;; XXX: Merge related package `nlohmann-json-no-char8-t' back into here when
+    ;; updating from 3.12.0, as the unique patch it applies will already be
+    ;; incorporated in.
     (version "3.12.0")
     (home-page "https://github.com/nlohmann/json")
     (source
@@ -1506,6 +1510,46 @@ intuitive syntax and trivial integration.")
 (define-deprecated-package json-modern-cxx
   nlohmann-json)
 
+(define-public nlohmann-json-no-char8-t
+  (package
+    ;; XXX: Version 3.12.0 does not work without char8_t support.
+    ;; OpenRCT2 compiles with -fno-char8_t, and thus requires this patch.
+    ;; See https://github.com/nlohmann/json/pull/4736
+    (inherit nlohmann-json)
+    (name "nlohmann-json-no-char8-t")
+    (version "3.12.0")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference (url "https://github.com/nlohmann/json")
+                           (commit (string-append "v" version))))
+       (sha256
+        (base32 "09nqq56ighr3lghhn3fs399lkllghz717j0xyp87x0giw86ayh3h"))
+       (file-name (git-file-name name version))
+       (modules '((guix build utils)))
+       (snippet
+        #~(begin
+            ;; Delete bundled software.  Preserve doctest_compatibility.h, which
+            ;; is a wrapper library added by this package.
+            (install-file "./tests/thirdparty/doctest/doctest_compatibility.h"
+                          "/tmp")
+            (delete-file-recursively "./tests/thirdparty")
+            (install-file "/tmp/doctest_compatibility.h"
+                          "./tests/thirdparty/doctest")
+
+            ;; Adjust for the unbundled fifo_map and doctest.
+            (substitute* (find-files "./tests/" "\\.h(pp)?")
+              (("#include \"doctest\\.h\"") "#include <doctest/doctest.h>")
+              (("#include <doctest\\.h>") "#include <doctest/doctest.h>"))
+            (with-directory-excursion "tests/src"
+              (let ((files (find-files "." "\\.cpp$")))
+                (substitute* files
+                  (("#include ?\"(fifo_map.hpp)\"" all fifo-map-hpp)
+                   (string-append
+                    "#include <fifo_map/" fifo-map-hpp ">")))))))
+       (patches
+        (search-patches "nlohmann_json_fix_char8_t.patch"))))))
+
 (define-public jthread
   (let ((commit "0fa8d394254886c555d6faccd0a3de819b7d47f8")
         (revision "0"))
@@ -4480,6 +4524,29 @@ file name and location, as well as filters with friendly names (such as
        "This package provides a simple S-Expression parser for C++.")
       (license license:gpl3+))))
 
+(define-public sfl-library
+  (package
+    (name "sfl-library")
+    (version "2.2.0")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+              (url "https://github.com/slavenf/sfl-library")
+              (commit version)))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "1ngy86b9y1b8a4j37c14m1jrg0q5b12jj8b0gdnpl5sjb1r2fljk"))))
+    (build-system cmake-build-system)
+    (arguments (list #:tests? #f))              ;no tests
+    (home-page "https://github.com/slavenf/sfl-library")
+    (synopsis "Header-only C++11/20 container library")
+    (description "sfl-library provides many STL-like (Standard Template Library)
+containers including vectors, associative containers, and unordered containers
+based on hash tables.  These containers are designed for C++11 and C++20
+constant expression usage.")
+    (license license:zlib)))
+
 (define-public string-view-lite
   (package
     (name "string-view-lite")

gnu/packages/electronics.scm

@@ -1021,7 +1021,7 @@ files.")
 (define-public klayout
   (package
     (name "klayout")
-    (version "0.30.8")
+    (version "0.30.9")
     (source
      (origin (method git-fetch)
              (uri (git-reference
@@ -1030,7 +1030,7 @@ files.")
              (file-name (git-file-name name version))
              (sha256
               (base32
-               "0aw0y5k27pslql9pir6nplapj6ml6fkhzd815s13rlnw3bm0fcs6"))))
+               "1v5ddw7xixvdc3qshd0lkrc3ayk2q5wkk1zbhvsidq0kzlqbr2z5"))))
     (build-system copy-build-system)
     (arguments
      (list
@@ -2207,7 +2207,7 @@ which allows one to install the M8 firmware on any Teensy.")
 (define-public magic
   (package
     (name "magic")
-    (version "8.3.644")
+    (version "8.3.652")
     (source
      (origin
        (method git-fetch)
@@ -2216,7 +2216,7 @@ which allows one to install the M8 firmware on any Teensy.")
              (commit version)))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "0qp1alm4pczfm77r8lxwgzrwh02ihvfmk9sbwjlfbrixg1dn85xb"))))
+        (base32 "07q2lldcq6zb1apa5d3paciha92r6jlp7xny8pc31f56k5s9jnmz"))))
     (build-system gnu-build-system)
     (arguments
      (list
@@ -2312,7 +2312,7 @@ coverage.")
 (define-public netgen
   (package
     (name "netgen")
-    (version "1.5.319")
+    (version "1.5.320")
     (source
      (origin
        (method git-fetch)
@@ -2321,7 +2321,7 @@ coverage.")
              (commit version)))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "16xd2xcsny1bb6yk4lz34jfpwfb5xi2i9izxjymmalnzhg32i9cz"))))
+        (base32 "11mvf0nrsfc1lxbgqhmczi0maw4n10lib2xqnhpkyy73ci489147"))))
     (build-system gnu-build-system)
     (arguments
      (list
@@ -4376,7 +4376,7 @@ input and outputs an XML dataset.")
 (define-public qucs-s
   (package
     (name "qucs-s")
-    (version "26.1.0")                  ;update qucsator-rf accordingly
+    (version "26.1.1")                  ;update qucsator-rf accordingly
     (source
      (origin
        (method git-fetch)
@@ -4386,7 +4386,7 @@ input and outputs an XML dataset.")
        (file-name (git-file-name name version))
        (sha256
         (base32
-         "0aiyrcrxln4v6qm2dmigb54wl0mj499q3g18pz87m1s2lfgicpb1"))))
+         "009siqmn76r2l17hnjqmr6ap8nw969hd5fyqigb4p3i8cvjq7gmx"))))
     (build-system qt-build-system)
     (arguments
      (list

gnu/packages/games.scm

@@ -6148,39 +6148,22 @@ have a steep learning curve.")))
 (define-public openrct2-title-sequences
   (package
    (name "openrct2-title-sequences")
-   (version "0.1.2")
+   (version "0.4.26")
    (source
     (origin
      (method url-fetch)
-     (uri (string-append "https://github.com/OpenRCT2/title-sequences/releases/download/v"
-                         version "/title-sequence-v" version ".zip"))
+     (uri (string-append "https://github.com/OpenRCT2/title-sequences"
+                         "/releases/download/v" version
+                         "/title-sequences.zip"))
      (file-name (string-append name "-" version ".zip"))
      (sha256
       (base32
-       "0qbyxrsw8hlgaq0r5d7lx7an3idy4qbfv7yiw9byhldk763n9cfw"))))
-   (build-system trivial-build-system)
-   (native-inputs
-    `(("bash" ,bash)
-      ("coreutils" ,coreutils)
-      ("unzip" ,unzip)))
+       "0n680llpcyzl22bbphp9diz4m86gz2rn97yxlky44qspn63rgfys"))))
+   (build-system copy-build-system)
    (arguments
-    `(#:modules ((guix build utils))
-      #:builder
-      (begin
-        (use-modules (guix build utils))
-        (let* ((out (assoc-ref %outputs "out"))
-               (openrct2-title-sequences (string-append out
-                                         "/share/openrct2/title-sequences"))
-               (source (assoc-ref %build-inputs "source"))
-               (unzip (search-input-file %build-inputs "/bin/unzip")))
-          (copy-file source (string-append ,name "-" ,version ".zip"))
-          (invoke unzip (string-append ,name "-" ,version ".zip"))
-          (delete-file (string-append ,name "-" ,version ".zip"))
-          (mkdir-p openrct2-title-sequences)
-          (copy-recursively "."
-                            openrct2-title-sequences)
-          #t))))
-   (home-page "https://github.com/OpenRCT2/OpenRCT2")
+    (list #:install-plan #~'(("." "/share/openrct2/title-sequences"))))
+   (native-inputs (list unzip))
+   (home-page "https://openrct2.io")
    (synopsis "Title sequences for OpenRCT2")
    (description
     "openrct2-title-sequences is a set of title sequences for OpenRCT2.")
@@ -6190,38 +6173,22 @@ have a steep learning curve.")))
 (define-public openrct2-objects
   (package
    (name "openrct2-objects")
-   (version "1.0.20")
+   (version "1.7.9")
    (source
     (origin
      (method url-fetch)
-     (uri (string-append "https://github.com/OpenRCT2/objects/releases/download/v"
-                         version "/objects.zip"))
+     (uri (string-append "https://github.com/OpenRCT2/objects"
+                         "/releases/download/v" version "/objects.zip"))
      (file-name (string-append name "-" version ".zip"))
      (sha256
-      (base32 "1q7a38kcwrfijav6app1gf253yfv8b0rljbkah8040y6i7snw9mw"))))
-   (build-system trivial-build-system)
-   (native-inputs
-    `(("bash" ,bash)
-      ("coreutils" ,coreutils)
-      ("unzip" ,unzip)))
+      (base32 "1mpa4vpgs4m9izak8h5rkfcn80jbcm2di717k97g30kf1k91wijm"))))
+   (build-system copy-build-system)
    (arguments
-    `(#:modules ((guix build utils))
-      #:builder
-      (begin
-        (use-modules (guix build utils))
-        (let* ((out (assoc-ref %outputs "out"))
-               (openrct2-objects (string-append out
-                                         "/share/openrct2/objects"))
-               (source (assoc-ref %build-inputs "source"))
-               (unzip (search-input-file %build-inputs "/bin/unzip")))
-          (copy-file source (string-append ,name "-" ,version ".zip"))
-          (invoke unzip (string-append ,name "-" ,version ".zip"))
-          (delete-file (string-append ,name "-" ,version ".zip"))
-          (mkdir-p openrct2-objects)
-          (copy-recursively "."
-                            openrct2-objects)
-          #t))))
-   (home-page "https://github.com/OpenRCT2/OpenRCT2")
+    ;; zip has multiple top-level directories to install.
+    (list #:install-plan #~'((".." "/share/openrct2/objects"
+                              #:exclude ("environment-variables")))))
+   (native-inputs (list unzip))
+   (home-page "https://openrct2.io")
    (synopsis "Objects for OpenRCT2")
    (description
     "openrct2-objects is a set of objects for OpenRCT2.")
@@ -6317,7 +6284,7 @@ that follows two aliens who come to Earth in search of a stolen artifact.")
 (define-public openrct2
   (package
     (name "openrct2")
-    (version "0.3.3")
+    (version "0.5.0")
     (source
      (origin
        (method git-fetch)
@@ -6326,53 +6293,88 @@ that follows two aliens who come to Earth in search of a stolen artifact.")
              (commit (string-append "v" version))))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "01nanpbz5ycdhkyd46fjfvj18sw729l4vk7xg12600f9rjngjk76"))))
+        (base32 "0pxlk3a8akl0ghcbqqq5xw8chmxss7kwbvi52ixfqri68n46srxh"))
+       (modules '((guix build utils)))
+       (snippet
+        #~(begin
+            (with-directory-excursion "src/thirdparty"
+              (for-each delete-file-recursively
+                        '("quickjs-ng" "sfl")))
+            (substitute* "src/openrct2/CMakeLists.txt"
+              ;; use sys quickjs for scripting features
+              (("if \\(ENABLE_SCRIPTING\\)") "if (false)")
+              (("add_library\\(OpenRCT2[^\n]+" all)
+               (string-join
+                `(,all
+                  "find_library(QJS_L NAMES qjs REQUIRED)"
+                  "find_path(QJS_I NAMES quickjs.h REQUIRED)"
+                  "target_link_libraries(libopenrct2 ${QJS_L})"
+                  "target_include_directories(libopenrct2 SYSTEM PRIVATE ${QJS_I})")
+                "\n")))))))
     (build-system cmake-build-system)
     (arguments
-     `(#:configure-flags (list "-DDOWNLOAD_OBJECTS=OFF"
-                               "-DDOWNLOAD_TITLE_SEQUENCES=OFF")
-       #:tests? #f                      ; tests require network access
-       #:phases
-       (modify-phases %standard-phases
-         (add-after 'unpack 'fix-usr-share-paths&add-data
-           (lambda* (#:key inputs outputs #:allow-other-keys)
-             (let ((titles (assoc-ref inputs "openrct2-title-sequences"))
-                   (objects (assoc-ref inputs "openrct2-objects")))
-               ;; Fix some references to /usr/share.
-               (substitute* "src/openrct2/platform/Platform.Linux.cpp"
-                 (("/usr/share")
-                  (string-append (assoc-ref %outputs "out") "/share")))
-               (copy-recursively
-                (string-append titles "/share/openrct2/title-sequences")
-                "data/title")
-               (copy-recursively
-                (string-append objects "/share/openrct2/objects")
-                "data/object"))))
-         (add-before 'configure 'get-rid-of-errors
-           (lambda _
-             ;; Don't treat warnings as errors.
-             (substitute* "CMakeLists.txt"
-               (("-Werror") ""))
-             #t)))))
-    (inputs `(("curl" ,curl)
-              ("duktape" ,duktape)
-              ("fontconfig" ,fontconfig)
-              ("freetype" ,freetype)
-              ("icu4c" ,icu4c)
-              ("jansson" ,jansson)
-              ("nlohmann-json" ,nlohmann-json)
-              ("libpng" ,libpng)
-              ("libzip" ,libzip)
-              ("mesa" ,mesa)
-              ("openrct2-objects" ,openrct2-objects)
-              ("openrct2-title-sequences" ,openrct2-title-sequences)
-              ("openssl" ,openssl)
-              ("sdl2" ,sdl2)
-              ("speexdsp" ,speexdsp)
-              ("zlib" ,zlib)))
-    (native-inputs
-     (list pkg-config))
-    (home-page "https://github.com/OpenRCT2/OpenRCT2")
+     (list
+      #:configure-flags #~(list "-DDOWNLOAD_OBJECTS=OFF"
+                                "-DDOWNLOAD_TITLE_SEQUENCES=OFF"
+                                "-DDOWNLOAD_OPENSFX=OFF"
+                                "-DDOWNLOAD_OPENMUSIC=OFF"
+                                "-DDISABLE_DISCORD_RPC=ON"
+                                "-DDISABLE_VERSION_CHECKER=ON")
+      ;; many issues such as https://github.com/OpenRCT2/OpenRCT2/issues/12719
+      #:tests? #f
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'unpack 'fix-usr-share-paths&add-data
+            ;; TODO: OpenRCT2 can optionally use free music and sounds!
+            ;; https://github.com/OpenRCT2/OpenMusic
+            ;; https://github.com/OpenRCT2/OpenSoundEffects
+            ;; ideally we package these instead of the ones the user is supposed
+            ;; to supply.
+            (lambda* (#:key inputs #:allow-other-keys)
+              (let ((titles (assoc-ref inputs "openrct2-title-sequences"))
+                    (objects (assoc-ref inputs "openrct2-objects"))
+                    (sfl (assoc-ref inputs "sfl-library")))
+                ;; Fix some references to /usr/share.
+                (substitute* "src/openrct2/platform/Platform.Linux.cpp"
+                  (("/usr/share")
+                   (string-append #$output "/share")))
+                (copy-recursively
+                 (string-append titles "/share/openrct2/title-sequences")
+                 "data/title")
+                (copy-recursively
+                 (string-append objects "/share/openrct2/objects")
+                 "data/object")
+                (copy-recursively
+                 (string-append sfl "/include")
+                 "src/thirdparty"))))
+          (add-before 'configure 'get-rid-of-errors
+            (lambda _
+              ;; Don't treat warnings as errors.
+              (substitute* "CMakeLists.txt"
+                (("-Werror") "")))))))
+    (inputs
+     (list curl
+           flac
+           fontconfig
+           freetype
+           icu4c
+           jansson
+           libpng
+           libvorbis
+           libzip
+           mesa
+           nlohmann-json-no-char8-t
+           openrct2-objects
+           openrct2-title-sequences
+           openssl
+           quickjs-ng
+           sdl2
+           sfl-library
+           speexdsp
+           zlib
+           (list zstd "lib")))
+    (native-inputs (list pkg-config))
+    (home-page "https://openrct2.io")
     (synopsis "Free software re-implementation of RollerCoaster Tycoon 2")
     (description "OpenRCT2 is a free software re-implementation of
 RollerCoaster Tycoon 2 (RCT2).  The gameplay revolves around building and
@@ -6380,8 +6382,8 @@ maintaining an amusement park containing attractions, shops and facilities.
 
 Note that this package does @emph{not} provide the game assets (sounds,
 images, etc.)")
-    ;; See <https://github.com/OpenRCT2/OpenRCT2/wiki/Required-RCT2-files>
-    ;; regarding assets.
+    ;; See bottom of:
+    ;; https://github.com/OpenRCT2/OpenRCT2/blob/develop/distribution/readme.txt
     (license license:gpl3+)))
 
 (define-public openriichi

gnu/packages/image-processing.scm

@@ -1521,7 +1521,7 @@ libraries designed for computer vision research and implementation.")
                     python
                     onetbb
                     vxl-1
-                    zlib))
+                    zlib-ng-compat))
       (native-inputs
        (list castxml
              git-minimal

gnu/packages/linux.scm

@@ -1218,6 +1218,12 @@ Linux kernel.  It has been modified to remove all non-free binary blobs.")
                        "aarch64-linux" "powerpc64le-linux" "riscv64-linux")
                      #:configuration-file kernel-config))
 
+(define-public linux-libre-version         linux-libre-7.0-version)
+(define-public linux-libre-gnu-revision    linux-libre-7.0-gnu-revision)
+(define-public linux-libre-pristine-source linux-libre-7.0-pristine-source)
+(define-public linux-libre-source          linux-libre-7.0-source)
+(define-public linux-libre                 linux-libre-7.0)
+
 (define-public linux-libre-6.19
   (make-linux-libre* linux-libre-6.19-version
                      linux-libre-6.19-gnu-revision
@@ -1234,12 +1240,6 @@ Linux kernel.  It has been modified to remove all non-free binary blobs.")
                        "aarch64-linux" "powerpc64le-linux" "riscv64-linux")
                      #:configuration-file kernel-config))
 
-(define-public linux-libre-version         linux-libre-6.18-version)
-(define-public linux-libre-gnu-revision    linux-libre-6.18-gnu-revision)
-(define-public linux-libre-pristine-source linux-libre-6.18-pristine-source)
-(define-public linux-libre-source          linux-libre-6.18-source)
-(define-public linux-libre                 linux-libre-6.18)
-
 (define-public linux-libre-6.12
   (make-linux-libre* linux-libre-6.12-version
                      linux-libre-6.12-gnu-revision
@@ -1979,6 +1979,8 @@ dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-reform2-dsi.dtb
 dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-reform-next.dtb
 dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-pocket-reform.dtb")))))))))))
 
+(define-public linux-libre-arm64-mnt-reform linux-libre-arm64-mnt-reform-7.0)
+
 (define-public linux-libre-arm64-mnt-reform-6.19
   ;; Kernel for use on the MNT/Reform systems
   ;; https://mntre.com/reform.html
@@ -2315,8 +2317,6 @@ dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-reform2-dsi.dtb
 dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-reform-next.dtb
 dtb-$(CONFIG_ARCH_ROCKCHIP) += rk3588-mnt-pocket-reform.dtb")))))))))))
 
-(define-public linux-libre-arm64-mnt-reform linux-libre-arm64-mnt-reform-6.18)
-
 (define-public linux-libre-arm64-mnt-reform-6.12
   ;; Kernel for use on the MNT/Reform systems
   ;; https://mntre.com/reform.html

gnu/packages/patches/nlohmann_json_fix_char8_t.patch

@@ -0,0 +1,141 @@
+From 756ca22ec5b0d89b5d107b4c30891d1293650c87 Mon Sep 17 00:00:00 2001
+From: Sergiu Deitsch <sergiud@users.noreply.github.com>
+Date: Wed, 23 Apr 2025 18:36:41 +0200
+Subject: [PATCH] Provide fallback for missing `char8_t` support (#4736)
+
+---
+ .../nlohmann/detail/conversions/from_json.hpp |  5 +++-
+ .../nlohmann/detail/conversions/to_json.hpp   | 21 ++++++++++-----
+ single_include/nlohmann/json.hpp              | 26 +++++++++++++------
+ tests/src/unit-deserialization.cpp            |  5 ++--
+ 4 files changed, 39 insertions(+), 18 deletions(-)
+
+diff --git a/include/nlohmann/detail/conversions/from_json.hpp b/include/nlohmann/detail/conversions/from_json.hpp
+index 797f714dfae1dcc7fd8d2435ae7015023da76b97..3a24a6f4d26c0162531d8100a99a05291d8a2090 100644
+--- a/include/nlohmann/detail/conversions/from_json.hpp
++++ b/include/nlohmann/detail/conversions/from_json.hpp
+@@ -539,7 +539,10 @@ inline void from_json(const BasicJsonType& j, std_fs::path& p)
+         JSON_THROW(type_error::create(302, concat("type must be string, but is ", j.type_name()), &j));
+     }
+     const auto& s = *j.template get_ptr<const typename BasicJsonType::string_t*>();
+-#ifdef JSON_HAS_CPP_20
++    // Checking for C++20 standard or later can be insufficient in case the
++    // library support for char8_t is either incomplete or was disabled
++    // altogether. Use the __cpp_lib_char8_t feature test instead.
++#if defined(__cpp_lib_char8_t) && (__cpp_lib_char8_t >= 201907L)
+     p = std_fs::path(std::u8string_view(reinterpret_cast<const char8_t*>(s.data()), s.size()));
+ #else
+     p = std_fs::u8path(s); // accepts UTF-8 encoded std::string in C++17, deprecated in C++20
+diff --git a/include/nlohmann/detail/conversions/to_json.hpp b/include/nlohmann/detail/conversions/to_json.hpp
+index f8413850d5d7f8dd4bd6d2f174959a8ddd5c233a..8b910dd1615b710308392eed4999d3b7533a26e7 100644
+--- a/include/nlohmann/detail/conversions/to_json.hpp
++++ b/include/nlohmann/detail/conversions/to_json.hpp
+@@ -15,7 +15,8 @@
+ 
+ #include <algorithm> // copy
+ #include <iterator> // begin, end
+-#include <string> // string
++#include <memory> // allocator_traits
++#include <string> //  basic_string, char_traits
+ #include <tuple> // tuple, get
+ #include <type_traits> // is_same, is_constructible, is_floating_point, is_enum, underlying_type
+ #include <utility> // move, forward, declval, pair
+@@ -440,15 +441,21 @@ inline void to_json(BasicJsonType& j, const T& t)
+ }
+ 
+ #if JSON_HAS_FILESYSTEM || JSON_HAS_EXPERIMENTAL_FILESYSTEM
++#if defined(__cpp_lib_char8_t)
++template<typename BasicJsonType, typename Tr, typename Allocator>
++inline void to_json(BasicJsonType& j, const std::basic_string<char8_t, Tr, Allocator>& s)
++{
++    using OtherAllocator = typename std::allocator_traits<Allocator>::template rebind_alloc<char>;
++    j = std::basic_string<char, std::char_traits<char>, OtherAllocator>(s.begin(), s.end(), s.get_allocator());
++}
++#endif
++
+ template<typename BasicJsonType>
+ inline void to_json(BasicJsonType& j, const std_fs::path& p)
+ {
+-#ifdef JSON_HAS_CPP_20
+-    const std::u8string s = p.u8string();
+-    j = std::string(s.begin(), s.end());
+-#else
+-    j = p.u8string(); // returns std::string in C++17
+-#endif
++    // Returns either a std::string or a std::u8string depending whether library
++    // support for char8_t is enabled.
++    j = p.u8string();
+ }
+ #endif
+ 
+diff --git a/single_include/nlohmann/json.hpp b/single_include/nlohmann/json.hpp
+index 13b07c0fbc87e5c24127922fb2ef45fc3ea2bff5..93e5983cf1b1cdbe0452d89dcfa487c7b18dd4df 100644
+--- a/single_include/nlohmann/json.hpp
++++ b/single_include/nlohmann/json.hpp
+@@ -5324,7 +5324,10 @@ inline void from_json(const BasicJsonType& j, std_fs::path& p)
+         JSON_THROW(type_error::create(302, concat("type must be string, but is ", j.type_name()), &j));
+     }
+     const auto& s = *j.template get_ptr<const typename BasicJsonType::string_t*>();
+-#ifdef JSON_HAS_CPP_20
++    // Checking for C++20 standard or later can be insufficient in case the
++    // library support for char8_t is either incomplete or was disabled
++    // altogether. Use the __cpp_lib_char8_t feature test instead.
++#if defined(__cpp_lib_char8_t) && (__cpp_lib_char8_t >= 201907L)
+     p = std_fs::path(std::u8string_view(reinterpret_cast<const char8_t*>(s.data()), s.size()));
+ #else
+     p = std_fs::u8path(s); // accepts UTF-8 encoded std::string in C++17, deprecated in C++20
+@@ -5379,7 +5382,8 @@ NLOHMANN_JSON_NAMESPACE_END
+ 
+ #include <algorithm> // copy
+ #include <iterator> // begin, end
+-#include <string> // string
++#include <memory> // allocator_traits
++#include <string> //  basic_string, char_traits
+ #include <tuple> // tuple, get
+ #include <type_traits> // is_same, is_constructible, is_floating_point, is_enum, underlying_type
+ #include <utility> // move, forward, declval, pair
+@@ -6086,15 +6090,21 @@ inline void to_json(BasicJsonType& j, const T& t)
+ }
+ 
+ #if JSON_HAS_FILESYSTEM || JSON_HAS_EXPERIMENTAL_FILESYSTEM
++#if defined(__cpp_lib_char8_t)
++template<typename BasicJsonType, typename Tr, typename Allocator>
++inline void to_json(BasicJsonType& j, const std::basic_string<char8_t, Tr, Allocator>& s)
++{
++    using OtherAllocator = typename std::allocator_traits<Allocator>::template rebind_alloc<char>;
++    j = std::basic_string<char, std::char_traits<char>, OtherAllocator>(s.begin(), s.end(), s.get_allocator());
++}
++#endif
++
+ template<typename BasicJsonType>
+ inline void to_json(BasicJsonType& j, const std_fs::path& p)
+ {
+-#ifdef JSON_HAS_CPP_20
+-    const std::u8string s = p.u8string();
+-    j = std::string(s.begin(), s.end());
+-#else
+-    j = p.u8string(); // returns std::string in C++17
+-#endif
++    // Returns either a std::string or a std::u8string depending whether library
++    // support for char8_t is enabled.
++    j = p.u8string();
+ }
+ #endif
+ 
+diff --git a/tests/src/unit-deserialization.cpp b/tests/src/unit-deserialization.cpp
+index 84a970a183e4392166a8fe9bf76b582a53b76dd5..5c450c23d3042991cfc8959d4632208cfb21f400 100644
+--- a/tests/src/unit-deserialization.cpp
++++ b/tests/src/unit-deserialization.cpp
+@@ -1134,9 +1134,10 @@ TEST_CASE("deserialization")
+     }
+ }
+ 
+-// select the types to test - char8_t is only available in C++20
++// select the types to test - char8_t is only available since C++20 if and only
++// if __cpp_char8_t is defined.
+ #define TYPE_LIST(...) __VA_ARGS__
+-#ifdef JSON_HAS_CPP_20
++#if defined(__cpp_char8_t) && (__cpp_char8_t >= 201811L)
+     #define ASCII_TYPES TYPE_LIST(char, wchar_t, char16_t, char32_t, char8_t)
+ #else
+     #define ASCII_TYPES TYPE_LIST(char, wchar_t, char16_t, char32_t)

gnu/packages/xfce.scm

@@ -94,6 +94,8 @@
   #:use-module (guix packages)
   #:use-module (guix utils))
 
+(define %xfce-stable-version "^4[.][0-9]*[02468][.]")
+
 (define-public libxfce4util
   (package
     (name "libxfce4util")
@@ -123,7 +125,8 @@
      "A general-purpose utility library with core application support for the
 Xfce Desktop Environment.")
     (license lgpl2.0+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfconf
   (package
@@ -166,7 +169,8 @@ Xfce Desktop Environment.")
      "Settings daemon for Xfce, implemented as a D-Bus-based configuration
 storage system.")
     (license lgpl2.0+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public libxfce4ui
   (package
@@ -200,7 +204,8 @@ storage system.")
      "Libxfce4ui is the replacement of the old libxfcegui4 library.  It is used
 to share commonly used Xfce widgets among the Xfce applications.")
     (license lgpl2.0+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public catfish
   (package
@@ -254,7 +259,8 @@ to share commonly used Xfce widgets among the Xfce applications.")
 intentionally lightweight and simple, using only GTK+ 3.  You can configure
 it to your needs by using several command line options.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public elementary-xfce-icon-theme
   (package
@@ -322,7 +328,8 @@ that are targeted at desktop development, libexo is targeted at application
 development.")
     ;; Libraries are under LGPLv2+, and programs under GPLv2+.
     (license (list gpl2+ lgpl2.1+))
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public garcon
   (package
@@ -355,7 +362,8 @@ GLib and GIO.  It was started as a complete rewrite of the former Xfce menu
 library called libxfce4menu, which, in contrast to garcon, was lacking menu
 merging features essential for loading menus modified with menu editors.")
     (license lgpl2.0+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public tumbler
   (package
@@ -391,7 +399,8 @@ merging features essential for loading menus modified with menu editors.")
 various URI schemes and MIME types.  It is an implementation of the thumbnail
 management D-Bus specification.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public libxfce4windowing
   (package
@@ -425,7 +434,8 @@ management D-Bus specification.")
 windowing concepts (screens, toplevel windows, workspaces, etc.) in a
 windowing-system-independent manner.")
     (license lgpl2.1+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-panel
   (package
@@ -474,7 +484,8 @@ windowing-system-independent manner.")
 applications menu, workspace switcher and more.")
     ;; Libraries are under LGPLv2.1+, and programs under GPLv2+.
     (license (list gpl2+ lgpl2.1+))
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-battery-plugin
   (package
@@ -699,7 +710,8 @@ per window.")
      "Application finder for Xfce, it will show the applications installed on
 your system in categories, so you can quickly find and launch them.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-session
   (package
@@ -770,7 +782,8 @@ your system in categories, so you can quickly find and launch them.")
      "Session manager for Xfce, it will restore your session on startup and
 allows you to shut down the computer from Xfce.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-settings
   (package
@@ -821,7 +834,8 @@ allows you to shut down the computer from Xfce.")
      "Settings manager for Xfce, it can control various aspects of the desktop
 like appearance, display, keyboard and mouse settings.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public thunar
   (package
@@ -867,7 +881,8 @@ like appearance, display, keyboard and mouse settings.")
      "A modern file manager for graphical desktop, aiming to be easy-to-use and
 fast.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public thunar-volman
   (package
@@ -896,7 +911,8 @@ thunar-volman is installed and configured properly, and you plug in your
 digital camera, it will automatically spawn your preferred photo application
 and import the new pictures from your camera.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public thunar-archive-plugin
   (package
@@ -1076,7 +1092,8 @@ menu.")
      "Window manager for Xfce, it handles the placement of windows
 on the screen.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfwm4-themes
   (package
@@ -1163,7 +1180,8 @@ window manager.")
 optional application menu or icons for minimized applications or launchers,
 devices and folders.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public gigolo
   (package
@@ -1241,7 +1259,8 @@ local and remote file systems and manage bookmarks of such.")
 GStreamer framework and written to fit well in the Xfce desktop.  Parole
 features playback of local media files, DVD/CD and live streams.")
     (license gpl2)                      ;version 2 only
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-terminal
   (package
@@ -1436,7 +1455,8 @@ freedesktop-compliant DBus interfaces to inform other applications about current
 power level so that they can adjust their power consumption, and it provides the
 inhibit interface which allows applications to prevent automatic sleep.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public ristretto
   (package
@@ -1531,7 +1551,8 @@ calendar applications.  It also includes a panel clock plugin and an
 international clock application capable of simultaneously showing clocks from
 several different time zones.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-notifyd
   (package
@@ -1704,7 +1725,8 @@ A plugin for the Xfce panel is also available.")
      "Xfce Screensaver is a screen saver and locker that aims to have simple,
  sane, secure defaults and be well integrated with the Xfce desktop.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))
 
 (define-public xfce4-volumed-pulse
   (package
@@ -2425,4 +2447,5 @@ local weather in the panel, using forecast data provided by the
 developers and people that want to build Xfce from Git In addition it contains
 the Xfce developer's handbook.")
     (license gpl2+)
-    (properties `((release-tag-prefix . ,(string-append name "-"))))))
+    (properties `((release-tag-prefix . ,(string-append name "-"))
+                  (stable-version-regexp . ,%xfce-stable-version)))))

guix/import/git.scm

@@ -206,7 +206,14 @@ a version prefix when PARTIAL-VERSION? is #t."
          (old-reference (origin-uri (package-source package)))
          (tags (get-package-tags package))
          (versions (map car tags))
-         (version (find-version versions version partial-version?))
+         (stable-rx (and=> (assq-ref (package-properties package)
+                                     'stable-version-regexp)
+                           make-regexp))
+         (version (find-version
+                   (if (and stable-rx (not version))
+                       (filter (cut regexp-exec stable-rx <>) versions)
+                       versions)
+                   version partial-version?))
          (tag (assoc-ref tags version)))
     (and version
          (upstream-source

guix/progress.scm

@@ -23,6 +23,8 @@
   #:use-module (guix records)
   #:autoload   (guix build syscalls) (terminal-string-width)
   #:use-module (srfi srfi-19)
+  #:use-module (ice-9 ports)
+  #:use-module (ice-9 rw)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 format)
@@ -269,6 +271,50 @@ ANSI escape codes."
   ;; Default interval between subsequent outputs for rate-limited displays.
   (make-time time-duration 200000000 0))
 
+(define %maximum-atomic-trace-line-length
+  ;; POSIX guarantees writes to a pipe are atomic up to PIPE_BUF bytes.  POSIX
+  ;; requires PIPE_BUF to be at least 512 bytes; Linux uses 4096 bytes.  Guix
+  ;; trace lines are normally far smaller than this.
+  4096)
+
+(define (port-file-descriptor port)
+  "Return PORT's file descriptor, or #f if PORT is not backed by one."
+  (catch #t
+    (lambda ()
+      (fileno port))
+    (lambda _
+      #f)))
+
+(define (write-string/direct file-descriptor str)
+  "Write STR directly to FILE-DESCRIPTOR."
+  (let ((len (string-length str)))
+    (let loop ((start 0))
+      (when (< start len)
+        (let ((written (write-string/partial str file-descriptor start len)))
+          (if (zero? written)
+              (error "short trace write" str)
+              (loop (+ start written))))))))
+
+(define (write-trace-line str port)
+  "Write trace line STR to PORT.
+
+For file ports, bypass Guile's ordinary port buffering so STR is emitted as one
+kernel write in the common case.  This prevents Guix build trace lines from
+being combined with adjacent human-readable output in the daemon log stream."
+  (match (and (<= (string-length str) %maximum-atomic-trace-line-length)
+              (port-file-descriptor port))
+    (#f
+     (display str port)
+     (force-output port))
+    (file-descriptor
+     (catch #t
+       (lambda ()
+         (force-output port)
+         (write-string/direct file-descriptor str))
+       (lambda _
+         (display str port)
+         (force-output port))))))
+
 (define* (progress-reporter/file file size
                                  #:optional (log-port (current-output-port))
                                  #:key (abbreviation basename))
@@ -344,15 +390,14 @@ progress reports, write \"build trace\" lines to be processed elsewhere."
       (format #f "@ download-progress ~a ~a ~a ~a~%"
               file url (or size "-") transferred))
 
-    (display message log-port)                    ;should be atomic
-    (flush-output-port log-port))
+    (write-trace-line message log-port))
 
   (progress-reporter
    (start (lambda ()
             (set! total 0)
-            (display (format #f "@ download-started ~a ~a ~a~%"
-                             file url (or size "-"))
-                     log-port)))
+            (write-trace-line (format #f "@ download-started ~a ~a ~a~%"
+                                      file url (or size "-"))
+                              log-port)))
    (report (let ((report (rate-limited report-progress %progress-interval)))
              (lambda (transferred)
                (set! total transferred)
@@ -360,9 +405,9 @@ progress reports, write \"build trace\" lines to be processed elsewhere."
    (stop (lambda ()
            (let ((size (or size total)))
              (report-progress size)
-             (display (format #f "@ download-succeeded ~a ~a ~a~%"
-                              file url size)
-                      log-port))))))
+             (write-trace-line (format #f "@ download-succeeded ~a ~a ~a~%"
+                                       file url size)
+                               log-port))))))
 
 ;; TODO: replace '(@ (guix build utils) dump-port))'.
 (define* (dump-port* in out
@@ -425,4 +470,3 @@ the underlying connection."
                                           (stop))
                                         (when close?
                                           (close-port port))))))))
-

guix/status.scm

@@ -150,6 +150,15 @@
   (lambda (download)
     (string=? item (download-item download))))
 
+(define (valid-progress-values? size transferred)
+  "Return true when SIZE and TRANSFERRED form a sensible progress update."
+  (and (real? size)
+       (real? transferred)
+       (not (negative? size))
+       (not (negative? transferred))
+       (or (zero? size)
+           (<= transferred size))))
+
 (define %phase-start-rx
   ;; Match the "starting phase" message emitted by 'gnu-build-system'.
   (make-regexp "^starting phase [`']([^']+)'"))
@@ -271,18 +280,25 @@ compute a new status based on STATUS."
                                    #:start (current-time time-monotonic))
                          (build-status-downloading status)))))
     (('download-succeeded item uri (= string->number size))
-     (let ((current (find (matching-download item)
-                          (build-status-downloading status))))
-       (build-status
-        (inherit status)
-        (downloading (delq current (build-status-downloading status)))
-        (downloads-completed
-         (cons (download item uri
-                         #:size size
-                         #:start (download-start current)
-                         #:transferred size
-                         #:end (current-time time-monotonic))
-               (build-status-downloads-completed status))))))
+     (match (find (matching-download item)
+                  (build-status-downloading status))
+       (#f
+        ;; Download traces can arrive without a tracked 'download-started'
+        ;; event due to trace ordering or spurious duplicate completion
+        ;; events.  Ignore the completion trace instead of crashing while
+        ;; trying to read fields from #f.
+        status)
+       (current
+        (build-status
+         (inherit status)
+         (downloading (delq current (build-status-downloading status)))
+         (downloads-completed
+          (cons (download item uri
+                          #:size size
+                          #:start (download-start current)
+                          #:transferred size
+                          #:end (current-time time-monotonic))
+                (build-status-downloads-completed status)))))))
     (('substituter-succeeded item _ ...)
      (match (find (matching-download item)
                   (build-status-downloading status))
@@ -304,22 +320,24 @@ compute a new status based on STATUS."
                           #:end (current-time time-monotonic))
                 (build-status-downloads-completed status)))))))
     (('download-progress item uri
-                         (= string->number size)
-                         (= string->number transferred))
-     (let ((downloads (remove (matching-download item)
-                              (build-status-downloading status)))
-           (current   (find (matching-download item)
-                            (build-status-downloading status))))
-       (build-status
-        (inherit status)
-        (downloading (cons (download item uri
-                                     #:size size
-                                     #:start
-                                     (or (and current
-                                              (download-start current))
-                                         (current-time time-monotonic))
-                                     #:transferred transferred)
-                           downloads)))))
+                         (= string->number (? number? size))
+                         (= string->number (? number? transferred)))
+     (if (valid-progress-values? size transferred)
+         (let ((downloads (remove (matching-download item)
+                                  (build-status-downloading status)))
+               (current   (find (matching-download item)
+                                (build-status-downloading status))))
+           (build-status
+            (inherit status)
+            (downloading (cons (download item uri
+                                         #:size size
+                                         #:start
+                                         (or (and current
+                                                  (download-start current))
+                                             (current-time time-monotonic))
+                                         #:transferred transferred)
+                               downloads))))
+         status))
     (('build-log (? integer? pid) line)
      (update-build status pid line))
     (_
@@ -581,14 +599,15 @@ The channels you are pulling from are: ~a.")
          (#f #f)                                  ;shouldn't happen!
          (download
           ;; XXX: It would be nice to memoize the abbreviation.
-          (let ((uri (if (string-contains uri "/nar/")
-                         (nar-uri-abbreviation uri)
-                         (basename uri))))
-            (display-download-progress uri size
-                                       #:tty? tty?
-                                       #:start-time
-                                       (download-start download)
-                                       #:transferred transferred))))))
+          (when (valid-progress-values? size transferred)
+            (let ((uri (if (string-contains uri "/nar/")
+                           (nar-uri-abbreviation uri)
+                           (basename uri))))
+              (display-download-progress uri size
+                                         #:tty? tty?
+                                         #:start-time
+                                         (download-start download)
+                                         #:transferred transferred)))))))
     (('substituter-succeeded item _ ...)
      (when (extended-build-trace-supported?)
        ;; If there are no jobs running, we already reported download completion
@@ -704,13 +723,22 @@ found."
           ((memv (bytevector-u8-ref bv offset) numbers) offset)
           (else (loop (+ 1 offset) (- count 1))))))
 
+(define (line-delimiter? chr)
+  ;; Either '\n' or '\r' delimits a record in the daemon's trace stream:
+  ;; '\n' terminates ordinary trace events and log lines, '\r' is used by
+  ;; 'guix substitute' to redraw in-line progress.
+  (or (char=? chr #\newline)
+      (char=? chr #\return)))
+
 (define (split-lines str)
-  "Split STR into lines in a way that preserves newline characters."
+  "Split STR into lines, treating '\\n' and '\\r' as record delimiters and
+preserving the delimiter in each resulting line.  Trailing input without a
+delimiter is returned as the final element."
   (let loop ((str str)
              (result '()))
     (if (string-null? str)
         (reverse result)
-        (match (string-index str #\newline)
+        (match (string-index str line-delimiter?)
           (#f
            (loop "" (cons str result)))
           (index
@@ -744,6 +772,13 @@ The second return value is a thunk to retrieve the current state."
   (define %build-output '())
   (define %build-output-left #f)
 
+  ;; Hash table mapping PID -> partial-line string carried over from a
+  ;; previous "@ build-log" frame.  A single trace record can span
+  ;; consecutive frames when the daemon's read() of the child's pipe falls
+  ;; between bytes of the record; without per-PID carry-over the fragments
+  ;; would each be parsed as a separate (malformed) event.
+  (define %build-output-fragments (make-hash-table))
+
   (define (process-line line)
     (cond ((string-prefix? "@ " line)
            ;; Note: Drop the trailing \n, and use 'string-split' to preserve
@@ -765,7 +800,11 @@ The second return value is a thunk to retrieve the current state."
 
   (define (process-build-output pid output)
     ;; Transform OUTPUT in 'build-log' events or download events as generated
-    ;; by extended build traces.
+    ;; by extended build traces.  OUTPUT is the payload of a single
+    ;; "@ build-log PID LENGTH" frame; the daemon may have split a single
+    ;; record across consecutive frames, so combine OUTPUT with any partial
+    ;; line carried over for PID and re-buffer whatever trails the last
+    ;; delimiter.
     (define (line->event line)
       (match (and (string-prefix? "@ " line)
                   (string-tokenize (string-drop line 2)))
@@ -777,9 +816,32 @@ The second return value is a thunk to retrieve the current state."
         (_
          `(build-log ,pid ,line))))
 
-    (let* ((lines  (split-lines output))
-           (events (map line->event lines)))
-      (set! %state (fold proc %state events))))
+    (define (handle-trailing-partial partial)
+      ;; A trailing fragment without a terminator: hold it back only if it
+      ;; looks like the head of a pending trace record ('@ ' prefix), so a
+      ;; record split across frames reassembles into a single event.  Free-
+      ;; form log fragments are flushed eagerly to preserve the streamy feel
+      ;; of build output and to match prior per-frame semantics.
+      (cond
+       ((string-null? partial)
+        (hash-remove! %build-output-fragments pid))
+       ((string-prefix? "@ " partial)
+        (hash-set! %build-output-fragments pid partial))
+       (else
+        (hash-remove! %build-output-fragments pid)
+        (set! %state (proc `(build-log ,pid ,partial) %state)))))
+
+    (let* ((prev     (hash-ref %build-output-fragments pid ""))
+           (combined (if (string-null? prev) output (string-append prev output))))
+      (match (string-rindex combined line-delimiter?)
+        (#f
+         (handle-trailing-partial combined))
+        (last
+         (let* ((complete (string-take combined (+ last 1)))
+                (partial  (string-drop combined (+ last 1)))
+                (events   (map line->event (split-lines complete))))
+           (set! %state (fold proc %state events))
+           (handle-trailing-partial partial))))))
 
   (define (bytevector-range bv offset count)
     (let ((ptr (bytevector->pointer bv offset)))

guix/ui.scm

@@ -866,6 +866,23 @@ evaluating the tests and bodies of CLAUSES."
     (lambda () exp ...)
     #:unwind? #f))
 
+(define (system-error-message proc format-string format-args rest)
+  "Format a Guile 'system-error' payload, falling back to raw fields.
+
+Some low-level callers can raise malformed 'system-error' payloads.  Avoid
+masking the original failure with a second exception from the error reporter."
+  (catch #t
+    (lambda ()
+      (apply format #f format-string format-args))
+    (lambda (key . args)
+      (format #f
+              "unprintable system-error payload: proc=~s format=~s args=~s rest=~s formatter-error=~s"
+              proc
+              format-string
+              format-args
+              rest
+              (cons key args)))))
+
 (define (call-with-error-handling thunk)
   "Call THUNK within a user-friendly error handler."
   (define (port-filename* port)
@@ -1024,9 +1041,12 @@ directories:~{ ~a~}~%")
              (((exception-predicate &exception-with-kind-and-args) c)
               (if (eq? 'system-error (exception-kind c)) ;EPIPE & co.
                   (match (exception-args c)
-                    ((proc format-string format-args . _)
+                    ((proc format-string format-args . rest)
                      (leave (G_ "~a: ~a~%") proc
-                            (apply format #f format-string format-args))))
+                            (system-error-message proc
+                                                  format-string
+                                                  format-args
+                                                  rest))))
                   (raise c)))
 
              ((message-condition? c)

nix/libstore/build.cc

@@ -3719,6 +3719,19 @@ private:
        substituter.  */
     string status;
 
+    /* Wrap DATA with the '@ build-log PID LENGTH\n' framing used by
+       'multiplexedBuildOutput' and write it to the daemon's standard error,
+       or write DATA raw when multiplexing is disabled.  Used for the
+       substituter's stderr, which carries '@ download-*' progress traces. */
+    void writeFramedToStderr(const string & data);
+
+    /* Drain any bytes currently pending on the substituter's stderr and
+       forward them, framed, to the daemon's standard error.  Called before
+       waking the goal in reaction to a status reply on builderOut, so that
+       trailing progress traces reach the client before goal-emitted events
+       such as '@ substituter-succeeded'. */
+    void drainFromAgent();
+
     void tryNext();
 
 public:
@@ -4041,11 +4054,66 @@ void SubstitutionGoal::finished()
 }
 
 
+void SubstitutionGoal::writeFramedToStderr(const string & data)
+{
+    if (data.empty()) return;
+
+    if (settings.multiplexedBuildOutput) {
+	/* Wrap the chunk in an '@ build-log PID LENGTH\n<payload>' frame, the
+	   same framing 'DerivationGoal' uses for builder output.  This keeps
+	   progress traces of one substituter attributable on the client side
+	   and prevents them from being interleaved at byte granularity with
+	   unrelated daemon output. */
+	string prefix = "@ build-log "
+	    + std::to_string(substituter->pid)
+	    + " " + std::to_string(data.size()) + "\n";
+	writeToStderr(prefix + data);
+    } else {
+	writeToStderr(data);
+    }
+}
+
+
+void SubstitutionGoal::drainFromAgent()
+{
+    if (verbosity < settings.buildVerbosity || !substituter) return;
+
+    int fd = substituter->fromAgent.readSide;
+
+    while (true) {
+	fd_set readable;
+	FD_ZERO(&readable);
+	FD_SET(fd, &readable);
+
+	struct timeval timeout;
+	timeout.tv_sec = 0;
+	timeout.tv_usec = 0;
+
+	int ready = select(fd + 1, &readable, 0, 0, &timeout);
+	if (ready == -1) {
+	    if (errno == EINTR) continue;
+	    throw SysError("polling substituter stderr");
+	}
+	if (ready == 0 || !FD_ISSET(fd, &readable)) return;
+
+	unsigned char buffer[4096];
+	ssize_t rd = read(fd, buffer, sizeof(buffer));
+	if (rd == -1) {
+	    if (errno == EINTR) continue;
+	    throw SysError("reading substituter stderr");
+	}
+	if (rd == 0) return;
+
+	writeFramedToStderr(string((char *) buffer, rd));
+    }
+}
+
+
 void SubstitutionGoal::handleChildOutput(int fd, const string & data)
 {
-    if (verbosity >= settings.buildVerbosity
-	&& fd == substituter->fromAgent.readSide) {
-	writeToStderr(data);
+    if (fd == substituter->fromAgent.readSide
+	&& verbosity >= settings.buildVerbosity) {
+	writeFramedToStderr(data);
 	/* Don't write substitution output to a log file for now.  We
 	   probably should, though. */
     }
@@ -4053,6 +4121,8 @@ void SubstitutionGoal::handleChildOutput(int fd, const string & data)
     if (fd == substituter->builderOut.readSide) {
 	/* DATA may consist of several lines.  Process them one by one.  */
 	string input = data;
+	bool gotStatus = false;
+
 	while (!input.empty()) {
 	    /* Process up to the first newline.  */
 	    size_t end = input.find_first_of("\n");
@@ -4061,13 +4131,22 @@ void SubstitutionGoal::handleChildOutput(int fd, const string & data)
 	    /* Update the goal's state accordingly.  */
 	    if (status == "") {
 		status = trimmed;
-		worker.wakeUp(shared_from_this());
+		gotStatus = true;
 	    } else {
 		printMsg(lvlError, std::format("unexpected substituter message '{}'", input));
 	    }
 
 	    input = (end != string::npos) ? input.substr(end + 1) : "";
 	}
+
+	if (gotStatus) {
+	    /* Drain any trailing progress traces that the substituter wrote on
+	       'fromAgent' before its status reply, so they reach the client
+	       ahead of the '@ substituter-succeeded' the goal will emit once
+	       the wake-up advances its state machine. */
+	    drainFromAgent();
+	    worker.wakeUp(shared_from_this());
+	}
     }
 }
 
@@ -4363,7 +4442,31 @@ void Worker::waitForInput()
 
     time_t after = time(0);
 
-    /* Process all available file descriptors. */
+    /* Process all available file descriptors.
+
+       A goal's handleChildOutput may opportunistically drain another
+       descriptor that the original select() already marked ready (the
+       substituter status path does this to preserve trace ordering).  Probe
+       readiness again before each read so the worker does not block on a
+       descriptor that has been consumed in this same dispatch cycle. */
+    auto stillReadable = [](int fd) {
+	while (true) {
+	    fd_set probe;
+	    FD_ZERO(&probe);
+	    FD_SET(fd, &probe);
+
+	    struct timeval timeout;
+	    timeout.tv_sec = 0;
+	    timeout.tv_usec = 0;
+
+	    int ready = select(fd + 1, &probe, 0, 0, &timeout);
+	    if (ready == -1) {
+		if (errno == EINTR) continue;
+		throw SysError("rechecking child output readiness");
+	    }
+	    return ready > 0 && FD_ISSET(fd, &probe);
+	}
+    };
 
     /* Since goals may be canceled from inside the loop below (causing
        them go be erased from the `children' map), we have to be
@@ -4381,7 +4484,7 @@ void Worker::waitForInput()
 
         set<int> fds2(j->second.fds);
         for (auto& k : fds2) {
-            if (FD_ISSET(k, &fds)) {
+            if (FD_ISSET(k, &fds) && stillReadable(k)) {
                 unsigned char buffer[4096];
                 ssize_t rd = read(k, buffer, sizeof(buffer));
                 if (rd == -1) {

tests/status.scm

@@ -18,6 +18,9 @@
 
 (define-module (test-status)
   #:use-module (guix status)
+  #:use-module (guix progress)
+  #:use-module ((guix build utils)
+                #:select (call-with-temporary-output-file))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (srfi srfi-71)
@@ -116,6 +119,60 @@
       (display "@ substituter-succeeded baz\n" port)
       (list first (get-status)))))
 
+(test-equal "compute-status, stray download-succeeded"
+  (build-status)
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
+    (display "@ download-succeeded bar http://example.org/bar 999\n" port)
+    (get-status)))
+
+(test-equal "progress-reporter/trace, complete trace lines"
+  (string-append "@ download-started bar http://example.org/bar 999\n"
+                 "@ download-progress bar http://example.org/bar 999 42\n"
+                 "@ download-progress bar http://example.org/bar 999 999\n"
+                 "@ download-succeeded bar http://example.org/bar 999\n")
+  (call-with-temporary-output-file
+   (lambda (file port)
+     (let ((reporter (progress-reporter/trace "bar" "http://example.org/bar"
+                                              999 port)))
+       (start-progress-reporter! reporter)
+       (progress-reporter-report! reporter 42)
+       (stop-progress-reporter! reporter)
+       (force-output port)
+       (call-with-input-file file get-string-all)))))
+
+(test-equal "compute-status, overrun download-progress"
+  (build-status
+   (downloading (list (download "bar" "http://example.org/bar"
+                                #:size 999
+                                #:start 'now))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
+    (display "@ download-started bar http://example.org/bar 999\n" port)
+    (display "@ download-progress bar htt@ 999 1000\n" port)
+    (get-status)))
+
+(test-assert "print-build-event, overrun download-progress"
+  (let ((output (open-output-string)))
+    (call-with-values
+        (lambda ()
+          (build-event-output-port
+           (build-status-updater
+            (lambda (event old-status status)
+              (print-build-event/quiet event old-status status output
+                                       #:colorize? #f)))))
+      (lambda (port get-status)
+        (display "@ download-started bar http://example.org/bar 999\n" port)
+        (display "@ download-progress bar htt@ 999 1000\n" port)
+        (force-output port)
+        (build-status? (get-status))))))
+
 (test-equal "build-output-port, UTF-8"
   '((build-log #f "lambda is λ!\n"))
   (let ((port get-status (build-event-output-port cons '()))
@@ -179,7 +236,7 @@
                                                            ("bar.drv" "bar")))))))
     (display "@ build-started foo.drv - x86_64-linux  121\n" port)
     (display "@ build-started bar.drv - armhf-linux bar.log 144\n" port)
-    (display "@ build-log 121 6\nHello!" port)
+    (display "@ build-log 121 6\nHello\n" port)
     (display "@ build-log 144 50
 @ download-started bar http://example.org/bar 999\n" port)
     (let ((first (get-status)))
@@ -193,6 +250,116 @@
         (display "@ build-succeeded bar.drv\n" port)
         (list first second (get-status))))))
 
+(define (frame pid payload)
+  ;; Build an '@ build-log PID LENGTH\\n<payload>' frame for use in tests.
+  (string-append "@ build-log " (number->string pid) " "
+                 (number->string (string-length payload))
+                 "\n" payload))
+
+(test-equal "compute-status, substituter trace inside @ build-log frame"
+  ;; The daemon now wraps substituter stderr in '@ build-log PID LENGTH'
+  ;; frames.  A download trace delivered through such a frame must drive
+  ;; status as if it had arrived on the top-level stream.
+  (build-status
+   (downloading (list (download "bar" "http://example.org/bar"
+                                #:size 999
+                                #:transferred 250
+                                #:start 'now))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
+    (display (frame 7 "@ download-started bar http://example.org/bar 999\n")
+             port)
+    (display (frame 7 "@ download-progress bar http://example.org/bar 999 250\n")
+             port)
+    (get-status)))
+
+(test-equal "compute-status, trace record split across frames for same PID"
+  ;; A single trace record may straddle two consecutive '@ build-log' frames
+  ;; for the same PID when the daemon's read() of the substituter pipe falls
+  ;; mid-record.  The parser must reassemble it instead of treating each
+  ;; fragment as its own event.
+  (build-status
+   (downloading (list (download "bar" "http://example.org/bar"
+                                #:size 999
+                                #:transferred 500
+                                #:start 'now))))
+  (let* ((port get-status
+               (build-event-output-port (lambda (event status)
+                                          (compute-status event status
+                                                          #:current-time
+                                                          (const 'now)))))
+         (record "@ download-progress bar http://example.org/bar 999 500\n")
+         (mid    (quotient (string-length record) 2))
+         (head   (substring record 0 mid))
+         (tail   (substring record mid)))
+    (display (frame 7 "@ download-started bar http://example.org/bar 999\n")
+             port)
+    (display (frame 7 head) port)
+    (display (frame 7 tail) port)
+    (get-status)))
+
+(test-equal "compute-status, CR-delimited progress inside a frame"
+  ;; 'guix substitute' redraws in-line progress with '\\r' between updates;
+  ;; CRs inside a framed payload must be treated as record delimiters.
+  (build-status
+   (downloading (list (download "bar" "http://example.org/bar"
+                                #:size 999
+                                #:transferred 600
+                                #:start 'now))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
+    (display (frame 7 "@ download-started bar http://example.org/bar 999\n")
+             port)
+    (display (frame 7
+                    (string-append
+                     "@ download-progress bar http://example.org/bar 999 200\r"
+                     "@ download-progress bar http://example.org/bar 999 400\r"
+                     "@ download-progress bar http://example.org/bar 999 600\n"))
+             port)
+    (get-status)))
+
+(test-equal "compute-status, partial lines do not cross PID boundaries"
+  ;; Two substituter processes have separate per-PID buffers; a partial
+  ;; record from PID 7 must not be glued to PID 8's frame.  Both downloads
+  ;; must reach their final progress; 'one' completes last and therefore
+  ;; sits at the head of the most-recently-updated list.
+  (build-status
+   (downloading (list (download "one" "http://example.org/one"
+                                #:size 100
+                                #:transferred 50
+                                #:start 'now)
+                      (download "two" "http://example.org/two"
+                                #:size 200
+                                #:transferred 100
+                                #:start 'now))))
+  (let* ((port get-status
+               (build-event-output-port (lambda (event status)
+                                          (compute-status event status
+                                                          #:current-time
+                                                          (const 'now)))))
+         (one    "@ download-progress one http://example.org/one 100 50\n")
+         (mid    (quotient (string-length one) 2))
+         (one-head (substring one 0 mid))
+         (one-tail (substring one mid)))
+    (display (frame 7 "@ download-started one http://example.org/one 100\n")
+             port)
+    (display (frame 8 "@ download-started two http://example.org/two 200\n")
+             port)
+    ;; Partial record on PID 7.
+    (display (frame 7 one-head) port)
+    ;; A complete record on PID 8 that must not pick up PID 7's tail.
+    (display (frame 8 "@ download-progress two http://example.org/two 200 100\n")
+             port)
+    ;; Now finish PID 7's record.
+    (display (frame 7 one-tail) port)
+    (get-status)))
+
 (test-equal "compute-status, build completion"
   (list (build-status
          (building (list (build "foo.drv" "x86_64-linux" #:id 121))))
@@ -211,16 +378,16 @@
                                                          #:current-time
                                                          (const 'now))))))
     (display "@ build-started foo.drv - x86_64-linux  121\n" port)
-    (display "@ build-log 121 6\nHello!" port)
+    (display "@ build-log 121 6\nHello\n" port)
     (let ((first (get-status)))
       (display "@ build-log 121 20\n[ 0/100] building X\n" port)
-      (display "@ build-log 121 6\nHello!" port)
+      (display "@ build-log 121 6\nHello\n" port)
       (let ((second (get-status)))
         (display "@ build-log 121 20\n[50/100] building Y\n" port)
-        (display "@ build-log 121 6\nHello!" port)
+        (display "@ build-log 121 6\nHello\n" port)
         (let ((third (get-status)))
           (display "@ build-log 121 21\n[100/100] building Z\n" port)
-          (display "@ build-log 121 6\nHello!" port)
+          (display "@ build-log 121 6\nHello\n" port)
           (display "@ build-succeeded foo.drv\n" port)
           (list first second third (get-status)))))))