mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

fix tree-il->scheme test

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-08-04 19:23:49 +02:00
parent 2b582a285a
commit 335c8a89a2
2 changed files with 18 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/tree-il.scm
View file

@ -383,7 +383,7 @@
(case (car alt-expansion) (case (car alt-expansion)
((lambda) ((lambda)
`(case-lambda (,formals ,(tree-il->scheme body)) `(case-lambda (,formals ,(tree-il->scheme body))
,@(cdr alt-expansion))) ,(cdr alt-expansion)))
((lambda*) ((lambda*)
`(case-lambda* (,formals ,(tree-il->scheme body)) `(case-lambda* (,formals ,(tree-il->scheme body))
,(cdr alt-expansion))) ,(cdr alt-expansion)))

17
test-suite/tests/tree-il.test
View file

@ -55,6 +55,23 @@
(pat (guard test ...) #t) (pat (guard test ...) #t)
(else #f)))))))) (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" (with-test-prefix "void"
(assert-tree-il->glil (assert-tree-il->glil
(void) (void)