1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00

Fix hygiene issues with `define-record-type'

* module/rnrs/records/syntactic.scm (define-record-type0, process-fields):
  Preserve hygiene of record clauses.

* test-suite/tests/r6rs-records-syntactic.test ("record hygiene"):
  Add tests.
This commit is contained in:
Ian Price 2011-06-11 02:43:08 +01:00 committed by Andy Wingo
parent d1f2417102
commit 5f09e4ba3c
2 changed files with 181 additions and 157 deletions

View file

@ -19,10 +19,13 @@
(define-module (test-suite test-rnrs-records-syntactic)
:use-module ((rnrs records syntactic) :version (6))
:use-module ((rnrs records procedural) :version (6))
:use-module ((rnrs records inspection) :version (6))
:use-module (test-suite lib))
#:use-module ((rnrs records syntactic) #:version (6))
#:use-module ((rnrs records procedural) #:version (6))
#:use-module ((rnrs records inspection) #:version (6))
#:use-module ((rnrs conditions) #:version (6))
#:use-module ((rnrs exceptions) #:version (6))
#:use-module ((system base compile) #:select (compile))
#:use-module (test-suite lib))
(define-record-type simple-rtd)
(define-record-type
@ -115,3 +118,34 @@
(pass-if "record-constructor-descriptor returns rcd"
(procedure? (record-constructor (record-constructor-descriptor simple-rtd))))
(with-test-prefix "record hygiene"
(pass-if-exception "using shadowed record keywords fails" exception:syntax-pattern-unmatched
(compile '(let ((fields #f))
(define-record-type foo (fields bar))
#t)
#:env (current-module)))
(pass-if "using shadowed record keywords fails 2"
(guard (condition ((syntax-violation? condition) #t))
(compile '(let ((immutable #f))
(define-record-type foo (fields (immutable bar)))
#t)
#:env (current-module))
#f))
(pass-if "hygiene preserved when using macros"
(compile '(begin
(define pass #t)
(define-syntax define-record
(syntax-rules ()
((define-record name field)
(define-record-type name
(protocol
(lambda (x)
(lambda ()
;; pass refers to pass in scope of macro not use
(x pass))))
(fields field)))))
(let ((pass #f))
(define-record foo bar)
(foo-bar (make-foo))))
#:env (current-module))))