From a7c8e68dc51144a6d3981b770aca9c4897fc7c0c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 6 Mar 2026 18:46:35 +0100
Subject: records: Let thunked fields refer to their inherited value.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/records.scm (make-syntactic-constructor)[field-index]: New procedure.
[wrap-field-value]: Add optional argument ‘parent’.  When it is true, bind F
to the inherited field value.
[field-bindings/inheritance]: New procedure.
Use it.
* tests/records.scm ("define-record-type* & thunked & no inherited value")
("define-record-type* & thunked & inherited value")
("define-record-type* & thunked & inherited value & this-record"): New tests.
* doc/guix.texi (Defining Package Variants): Update ‘modify-inputs’ example to
refer to ‘inputs’.
(Writing Manifests): Likewise.
* doc/guix-cookbook.texi (Package Variants): Likewise for
‘substitute-keyword-arguments’.

Fixes: https://issues.guix.gnu.org/50335
Change-Id: If4e18155ce203637ff9e116ee8098f8997bfebe2
---
 tests/records.scm | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 65 insertions(+), 1 deletion(-)

(limited to 'tests')

diff --git a/tests/records.scm b/tests/records.scm
index 5464892d3b..9c071334d5 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2016, 2018-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2016, 2018-2022, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -238,6 +238,70 @@
               (bar? first)
               (eq? first y)))))))
 
+(test-equal "define-record-type* & thunked & no inherited value"
+  '(baz)                                          ;the unbound variable
+  (catch 'unbound-variable
+    (lambda ()
+      (eval '(begin
+               (define-record-type* <foo> foo make-foo
+                 foo?
+                 (bar foo-bar)
+                 (baz foo-baz (thunked)))
+
+               ;; There's no inheritance here so 'baz' is unbound in the field
+               ;; body.  Call 'foo-baz' to trigger to unbound variable error.
+               (foo-baz (foo (bar 1) (baz baz))))
+            (test-module)))
+    (lambda (key proc message arguments . rest)
+      arguments)))
+
+(test-equal "define-record-type* & thunked & inherited value"
+  '(1 22)
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked)))
+
+    (let* ((parent (foo (bar 1) (baz 2)))
+           (child (foo (inherit parent)
+                       (baz (* baz 11)))))
+      (list (foo-bar child) (foo-baz child)))))
+
+(test-equal "define-record-type* & thunked & inherited value & this-record"
+  '((1 2) => (21 (inherited . 42)))
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked)))
+
+    (let* ((parent (foo (bar 1)
+                        (baz (* 2 (foo-bar this-record)))))
+           (child (foo (inherit parent)
+                       (bar 21)
+                       (baz (cons 'inherited baz)))))
+      `((,(foo-bar parent) ,(foo-baz parent))
+        =>
+        (,(foo-bar child) ,(foo-baz child))))))
+
+(test-equal "define-record-type* & thunked & inherited value & sanitizer"
+  '((1 "2") => (4 "88"))
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked) (sanitize number->string)))
+
+    (let* ((parent (foo (bar 1)
+                        (baz (* 2 (foo-bar this-record)))))
+           (child (foo (inherit parent)
+                       (bar 4)
+                       (baz (+ 80 (string->number baz))))))
+      `((,(foo-bar parent) ,(foo-baz parent))
+        =>
+        (,(foo-bar child) ,(foo-baz child))))))
+
 (test-assert "define-record-type* & delayed"
   (begin
     (define-record-type* <foo> foo make-foo
-- 
cgit v1.3