summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2026-03-23 21:29:21 +0100
committerLudovic Courtès <ludo@gnu.org>2026-03-29 22:32:57 +0200
commitf0e22ae62c143fbf00bde368c2adbc848cff5ff5 (patch)
treec1270b04b087752a1308dfc3e603a1f4d8a1e36a
parente3a708ed79d0f3e03aed0aaf044a447df16646ea (diff)
records: Warn about shadowing due to inherited field value bindings.
This is a followup to a7c8e68dc51144a6d3981b770aca9c4897fc7c0c: this commit introduced a new binding in the body of field values, which could silently shadow outer bindings. This new warning catches potentially unwanted shadowing. * guix/records.scm (make-syntactic-constructor)[check-shadowing]: New procedure. [wrap-field-value]: Use it. * tests/records.scm ("define-record-type* & inherited value shadowing"): New test. Change-Id: I81ad14cf10da7213e9f8db987c8b0bd4c41acba2 Signed-off-by: Ludovic Courtès <ludo@gnu.org> Merges: #7424
-rw-r--r--guix/records.scm19
-rw-r--r--tests/records.scm20
2 files changed, 39 insertions, 0 deletions
diff --git a/guix/records.scm b/guix/records.scm
index bf746d3b5d9..52d03f73942 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -24,6 +24,7 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:autoload (system syntax) (syntax-local-binding)
#:export (define-record-type*
this-record
@@ -206,6 +207,23 @@ of TYPE matches the expansion-time ABI."
index
(loop rest (+ 1 index))))))))
+ (define (check-shadowing identifier)
+ ;; Warn if IDENTIFIER shadows a local binding.
+ ;; Note: not using (guix diagnostics) to remain independent of
+ ;; other Guix modules.
+ (when (eq? 'lexical (syntax-local-binding identifier))
+ (format (current-warning-port)
+ "~a: inherited field binding '~a' of \
+record type '~a' shadows local variable~%"
+ (match (syntax-source identifier)
+ (#f "<unknown-location>")
+ (lst (format #f "~a:~a:~a"
+ (assq-ref lst 'filename)
+ (and=> (assq-ref lst 'line) 1+)
+ (assq-ref lst 'column))))
+ (syntax->datum identifier)
+ (syntax->datum #'type))))
+
(define* (wrap-field-value f value #:optional parent)
;; Wrap VALUE, the value of field F, such that its sanitizer is
;; called and its properties (thunked, delayed) honored. When
@@ -222,6 +240,7 @@ of TYPE matches the expansion-time ABI."
#`((struct-ref #,parent
#,(field-index f))
#,this-identifier)))
+ (check-shadowing f)
#`(lambda (x)
(syntax-parameterize ((#,this-identifier
(lambda (s)
diff --git a/tests/records.scm b/tests/records.scm
index 9c071334d50..57a21d2effc 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -302,6 +302,26 @@
=>
(,(foo-bar child) ,(foo-baz child))))))
+(test-assert "define-record-type* & inherited value shadowing"
+ (let ((exp '(begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar)
+ (baz foo-baz (thunked)))
+
+ (let ((x (foo (bar 1) (baz 2)))
+ (baz 123))
+ ;; Below, the 'baz' binding for the inherited field value
+ ;; shadows the 'baz' above, which should trigger a warning.
+ (foo (inherit x)
+ (baz (* baz 2)))))))
+ (string-contains
+ (call-with-output-string
+ (lambda (port)
+ (parameterize ((current-warning-port port))
+ (eval exp (test-module)))))
+ "shadows local variable")))
+
(test-assert "define-record-type* & delayed"
(begin
(define-record-type* <foo> foo make-foo