diff options
author | Mark H Weaver <mhw@netris.org> | 2014-09-28 12:51:11 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-09-28 23:51:20 -0400 |
commit | 7a71a45cfd6092402d540e9bc5d2432941a8a336 (patch) | |
tree | d2928613b8ed1f48ad293fba13c340d860bfc9e8 /test-suite | |
parent | ff4af3df238815e434b62693a3c02b8213667ebe (diff) | |
download | guile-7a71a45cfd6092402d540e9bc5d2432941a8a336.tar.gz |
peval: Handle optional argument inits that refer to previous arguments.
Fixes <http://bugs.gnu.org/17634>.
Reported by Josep Portella Florit <jpf@primfilat.com>.
* module/language/tree-il/peval.scm (inlined-application): When inlining
an application whose operator is a lambda expression with optional
arguments that rely on default initializers, expand into a series of
nested let expressions, to ensure that previous arguments are in scope
when the default initializers are evaluated.
* test-suite/tests/peval.test ("partial evaluation"): Add tests.
Diffstat (limited to 'test-suite')
-rw-r--r-- | test-suite/tests/peval.test | 86 |
1 files changed, 85 insertions, 1 deletions
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test index 5b003d26d..21834290e 100644 --- a/test-suite/tests/peval.test +++ b/test-suite/tests/peval.test @@ -1,7 +1,7 @@ ;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*- ;;;; Andy Wingo <wingo@pobox.com> --- May 2009 ;;;; -;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -411,6 +411,90 @@ (const 7)) (pass-if-peval + ;; Higher order with optional argument (default uses earlier argument). + ;; <http://bugs.gnu.org/17634> + ((lambda* (f x #:optional (y (+ 3 (car x)))) + (+ y (f (* (car x) (cadr x))))) + (lambda (x) + (+ x 1)) + '(2 3)) + (const 12)) + + (pass-if-peval + ;; Higher order with optional arguments + ;; (default uses earlier optional argument). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) + (+ y z (f (* (car x) (cadr x))))) + (lambda (x) + (+ x 1)) + '(2 3)) + (const 20)) + + (pass-if-peval + ;; Higher order with optional arguments (one caller-supplied value, + ;; one default that uses earlier optional argument). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) + (+ y z (f (* (car x) (cadr x))))) + (lambda (x) + (+ x 1)) + '(2 3) + -3) + (const 4)) + + (pass-if-peval + ;; Higher order with optional arguments (caller-supplied values). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))) + (+ y z (f (* (car x) (cadr x))))) + (lambda (x) + (+ x 1)) + '(2 3) + -3 + 17) + (const 21)) + + (pass-if-peval + ;; Higher order with optional and rest arguments (one + ;; caller-supplied value, one default that uses earlier optional + ;; argument). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) + #:rest r) + (list r (+ y z (f (* (car x) (cadr x)))))) + (lambda (x) + (+ x 1)) + '(2 3) + -3) + (apply (primitive list) (const ()) (const 4))) + + (pass-if-peval + ;; Higher order with optional and rest arguments + ;; (caller-supplied values for optionals). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) + #:rest r) + (list r (+ y z (f (* (car x) (cadr x)))))) + (lambda (x) + (+ x 1)) + '(2 3) + -3 + 17) + (apply (primitive list) (const ()) (const 21))) + + (pass-if-peval + ;; Higher order with optional and rest arguments + ;; (caller-supplied values for optionals and rest). + ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)) + #:rest r) + (list r (+ y z (f (* (car x) (cadr x)))))) + (lambda (x) + (+ x 1)) + '(2 3) + -3 + 17 + 8 + 3) + (let (r) (_) ((apply (primitive list) (const 8) (const 3))) + (apply (primitive list) (lexical r _) (const 21)))) + + (pass-if-peval ;; Higher order with optional argument (caller-supplied value). ((lambda* (f x #:optional (y 0)) (+ y (f (* (car x) (cadr x))))) |