From 18ed22536d08121c3d8f27a001d4d877c08340b2 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Mon, 5 May 2025 13:30:29 +0900
Subject: [PATCH] ui: Allow evaluating multi-expressions strings with
 read/eval.

This can be useful when evaluating a scheme-file store output for example,
which has multiple top level expressions.

* guix/ui.scm (read/eval): Also accept a port object as argument.  Read and
evaluate all expressions from input port or string.

Change-Id: I0213706fa4824c3a8ffe5d93f44f263048cb62c2
---
 guix/ui.scm         | 35 ++++++++++++++++++++++++++---------
 tests/guix-build.sh | 17 +++++++++++++++++
 2 files changed, 43 insertions(+), 9 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index d462f7133e..cd9eb1013d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -15,7 +15,7 @@
 ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019, 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
-;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
 ;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;; Copyright © 2022 Liliana Marie Prikler <liliana.prikler@gmail.com>
@@ -926,13 +926,18 @@ similar."
       module)))
 
 (define (read/eval str)
-  "Read and evaluate STR, raising an error if something goes wrong."
-  (let ((exp (catch #t
-               (lambda ()
-                 (call-with-input-string str read))
-               (lambda args
-                 (leave (G_ "failed to read expression ~s: ~s~%")
-                        str args)))))
+  "Read and evaluate STR, which can also be a port, raising an error if
+something goes wrong.  STR may contain one or more expressions; the return
+value is that of the last evaluated expression."
+  (define (read/safe port)
+    (catch #t
+      (lambda ()
+        (read port))
+      (lambda args
+        (leave (G_ "failed to read expression ~s: ~s~%")
+               str args))))
+
+  (define (eval/safe exp)
     (catch #t
       (lambda ()
         (eval exp (force %guix-user-module)))
@@ -956,7 +961,19 @@ similar."
           ((error args ...)
            (apply display-error #f (current-error-port) args))
           (what? #f))
-        (exit 1)))))
+        (exit 1))))
+
+  (let ((call-with-port-or-string (if (port? str)
+                                      call-with-port
+                                      call-with-input-string)))
+    (call-with-port-or-string
+     str
+     (lambda (port)
+       (let loop ((exp (read/safe port))
+                  (result #f))
+         (if (eof-object? exp)
+             result
+             (loop (read/safe port) (eval/safe exp))))))))
 
 (define (read/eval-package-expression str)
   "Read and evaluate STR and return the package it refers to, or exit an
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 343e6662a3..79306c8998 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -2,6 +2,7 @@
 # Copyright © 2012-2014, 2016-2025 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 # Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+# Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 #
 # This file is part of GNU Guix.
 #
@@ -420,6 +421,22 @@ then
     guix build -m <(echo '(specifications->manifest (list "guile"))') -n
 fi
 
+# Build a scheme->file object via multiple expressions, and validate it
+# produces the correct result when evaluated.
+scheme_file=$(guix build -e \
+     "(use-modules (guix gexp)) \
+      (scheme-file \"mathematics\" \
+       '(begin \
+         (define add +) \
+         (define multiply *) \
+         (add 5 (multiply 2 10)))
+       #:guile (@@ (gnu packages bootstrap) %bootstrap-guile))")
+guile -c \
+     "(begin \
+       (use-modules (guix ui) (rnrs base) (srfi srfi-26)) \
+       (assert (= 25 (call-with-input-file \"$scheme_file\" \
+                      (cut read/eval <>)))))"
+
 # Using 'GUIX_BUILD_OPTIONS'.
 GUIX_BUILD_OPTIONS="--dry-run --no-grafts"
 export GUIX_BUILD_OPTIONS