conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

passing tests-1.4

This commit is contained in:
Abdulaziz Ghuloum 2008-01-04 04:21:02 -05:00
parent 2ea7321e6b
commit 71fcccd764
2 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1321 1322

5
scheme/test64.ss
View File

@ -54,7 +54,7 @@
(or (number? x) (char? x) (boolean? x) (null? x) (string? x))) (or (number? x) (char? x) (boolean? x) (null? x) (string? x)))
(define (primitive? x) (define (primitive? x)
(memq x '($fxadd1 $fixnum->char $char->fixnum fixnum? $fxzero? (memq x '($fxadd1 $fxsub1 $fixnum->char $char->fixnum fixnum? $fxzero?
null? boolean? char? not $fxlognot))) null? boolean? char? not $fxlognot)))
(define (fixup x) (define (fixup x)
@ -63,6 +63,8 @@
[(,prim ,[args] ...) [(,prim ,[args] ...)
(guard (primitive? prim)) (guard (primitive? prim))
`((primitive ,prim) ,args ...)] `((primitive ,prim) ,args ...)]
[(if ,[e0] ,[e1] ,[e2])
`(if ,e0 ,e1 ,e2)]
[,_ (error 'fixup "invalid expression" _)])) [,_ (error 'fixup "invalid expression" _)]))
(define-syntax add-tests-with-string-output (define-syntax add-tests-with-string-output
@ -78,6 +80,7 @@
(include "tests/tests-1.1-req.scm") (include "tests/tests-1.1-req.scm")
(include "tests/tests-1.2-req.scm") (include "tests/tests-1.2-req.scm")
(include "tests/tests-1.3-req.scm") (include "tests/tests-1.3-req.scm")
(include "tests/tests-1.4-req.scm")
(test-all) (test-all)
(printf "Passed ~s tests\n" (length all-tests)) (printf "Passed ~s tests\n" (length all-tests))