diff options
author | Andy Wingo <wingo@pobox.com> | 2011-08-04 19:23:49 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-08-04 19:23:49 +0200 |
commit | 335c8a89a2e1dfb362b7a52010da4a81ab9cffc9 (patch) | |
tree | c6f8bfe9c262f61337b93d045e349870bd6f4c8a | |
parent | 2b582a285af7c30dbe7a3ee167728277a745f9b7 (diff) | |
download | guile-335c8a89a2e1dfb362b7a52010da4a81ab9cffc9.tar.gz |
fix tree-il->scheme test
* module/language/tree-il.scm (tree-il->scheme): Fix incorporation of
`lambda' in a `case-lambda'.
* test-suite/tests/tree-il.test ("tree-il->scheme"): Add a test.
-rw-r--r-- | module/language/tree-il.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/tree-il.test | 17 |
2 files changed, 18 insertions, 1 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 221cf264d..decd3637c 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -383,7 +383,7 @@ (case (car alt-expansion) ((lambda) `(case-lambda (,formals ,(tree-il->scheme body)) - ,@(cdr alt-expansion))) + ,(cdr alt-expansion))) ((lambda*) `(case-lambda* (,formals ,(tree-il->scheme body)) ,(cdr alt-expansion))) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index 2dce471b5..cb609aa5e 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -55,6 +55,23 @@ (pat (guard test ...) #t) (else #f)))))))) +(define-syntax pass-if-tree-il->scheme + (syntax-rules () + ((_ in pat) + (assert-scheme->tree-il->scheme in pat #t)) + ((_ in pat guard-exp) + (pass-if 'in + (pmatch (tree-il->scheme + (compile 'in #:from 'scheme #:to 'tree-il)) + (pat (guard guard-exp) #t) + (_ #f)))))) + +(with-test-prefix "tree-il->scheme" + (pass-if-tree-il->scheme + (case-lambda ((a) a) ((b c) (list b c))) + (case-lambda ((,a) ,a1) ((,b ,c) (list ,b1 ,c1))) + (and (eq? a a1) (eq? b b1) (eq? c c1)))) + (with-test-prefix "void" (assert-tree-il->glil (void) |