summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/srfi/srfi-9.scm9
-rw-r--r--test-suite/tests/srfi-9.test9
2 files changed, 14 insertions, 4 deletions
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index fad570b26..f9449a66f 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -80,15 +80,18 @@
(syntax-case x ()
((_ (name formals ...) body ...)
(identifier? #'name)
- (with-syntax ((proc-name (make-procedure-name #'name)))
+ (with-syntax ((proc-name (make-procedure-name #'name))
+ ((args ...) (generate-temporaries #'(formals ...))))
#`(begin
(define (proc-name formals ...)
body ...)
(define-syntax name
(lambda (x)
(syntax-case x ()
- ((_ formals ...)
- #'(begin body ...))
+ ((_ args ...)
+ #'((lambda (formals ...)
+ body ...)
+ args ...))
(_
(identifier? x)
#'proc-name))))))))))
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index f8006c440..f26a7a2cd 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -94,8 +94,15 @@
(pass-if-exception "set-y! on bar" exception:wrong-type-arg
(set-y! b 99)))
+(with-test-prefix "side-effecting arguments"
+
+ (pass-if "predicate"
+ (let ((x 0))
+ (and (foo? (begin (set! x (+ x 1)) f))
+ (= x 1)))))
+
(with-test-prefix "non-toplevel"
-
+
(define-record-type :frotz (make-frotz a b) frotz?
(a frotz-a) (b frotz-b set-frotz-b!))