From b075a6d766c2ffe7c575b63648d8ae0d51b5dd3a Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 11 Mar 2011 21:01:35 +0100 Subject: [PATCH] Fix `define-inlinable' in SRFI-9 so that arguments are evaluated only once. * module/srfi/srfi-9.scm (define-inlinable): When inlining, evaluate the arguments only once. Reported by Andreas Rottmann; thanks to Andy Wingo for the elegant solution. * test-suite/tests/srfi-9.test ("side-effecting arguments"): New test prefix. --- module/srfi/srfi-9.scm | 9 ++++++--- 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!)) -- 2.20.1