diff options
-rw-r--r-- | module/srfi/srfi-9.scm | 9 | ||||
-rw-r--r-- | test-suite/tests/srfi-9.test | 9 |
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!)) |