diff options
author | Andy Wingo <wingo@pobox.com> | 2011-06-17 17:08:06 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-06-17 17:08:06 +0200 |
commit | 0083cb5ec441c2a6df8d6eb1710eb8a88cf9fc5a (patch) | |
tree | 17a44d7b35a067bcb60d414fc9e25048417ae2b9 /test-suite/tests/compiler.test | |
parent | ad0fedbf82786988b764492aca664664da2f85ad (diff) | |
download | guile-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.test | 17 |
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)"))) |