summaryrefslogtreecommitdiff
path: root/test-suite/tests/compiler.test
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-06-17 17:08:06 +0200
committerAndy Wingo <wingo@pobox.com>2011-06-17 17:08:06 +0200
commit0083cb5ec441c2a6df8d6eb1710eb8a88cf9fc5a (patch)
tree17a44d7b35a067bcb60d414fc9e25048417ae2b9 /test-suite/tests/compiler.test
parentad0fedbf82786988b764492aca664664da2f85ad (diff)
downloadguile-0083cb5ec441c2a6df8d6eb1710eb8a88cf9fc5a.tar.gz
fix self tail recursion to different case-lambda clauses
http://savannah.gnu.org/bugs/?33362 * module/language/tree-il/compile-glil.scm (flatten-lambda-case): Rename from flatten, as it really just takes a particular case. Instead of iteratively compiling lambda cases through `comp', tail-call through flatten-lambda-case. This allows code to see which case it's being compiled in. Take advantage of that to limit the self-tail-call optimization to self-calls to the same case -- otherwise we might be jumping to a label without having reserved the right number of locals. (flatten-lambda): Adapt the caller. * test-suite/tests/compiler.test ("case-lambda"): Add a test.
Diffstat (limited to 'test-suite/tests/compiler.test')
-rw-r--r--test-suite/tests/compiler.test17
1 files changed, 16 insertions, 1 deletions
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 6b47086be..ee688c00a 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009, 2010, 2011 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
@@ -149,3 +149,18 @@
((y) y)
((y z) (list y z)))))))
(not (not (memv 0 (map source:addr s))))))))
+
+(with-test-prefix "case-lambda"
+ (pass-if "self recursion to different clause"
+ (equal? (with-output-to-string
+ (lambda ()
+ (let ()
+ (define t
+ (case-lambda
+ ((x)
+ (t x 'y))
+ ((x y)
+ (display (list x y))
+ (list x y))))
+ (display (t 'x)))))
+ "(x y)(x y)")))