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

Passing tests-1.2 in 64-bit.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-04 02:50:45 -05:00
parent eb224d3548
commit 61dfef0cea
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1318 1320

10
scheme/test64.ss
View File

@ -22,14 +22,14 @@
(define (compile1 x) (define (compile1 x)
(printf "Compiling ~s\n" x) (printf "Compiling ~s\n" x)
(let ([p (open-file-output-port "test64.boot" (file-options no-fail))]) (let ([p (open-file-output-port "test64.fasl" (file-options no-fail))])
(parameterize ([assembler-output #t]) (parameterize ([assembler-output #t])
(compile-core-expr-to-port x p)) (compile-core-expr-to-port x p))
(close-output-port p))) (close-output-port p)))
(define (compile-and-run x) (define (compile-and-run x)
(compile1 x) (compile1 x)
(let ([rs (system "../src/ikarus -b test64.boot > test64.out")]) (let ([rs (system "../src/ikarus -b test64.fasl > test64.out")])
(unless (= rs 0) (error 'run1 "died")) (unless (= rs 0) (error 'run1 "died"))
(with-input-from-file "test64.out" (with-input-from-file "test64.out"
(lambda () (get-string-all (current-input-port)))))) (lambda () (get-string-all (current-input-port))))))
@ -50,9 +50,12 @@
[(quote #f) "#f\n"] [(quote #f) "#f\n"]
[(quote ()) "()\n"])) [(quote ()) "()\n"]))
(define (self-evaluating? x)
(or (number? x) (char? x) (boolean? x) (null? x) (string? x)))
(define (fixup x) (define (fixup x)
(match x (match x
[,n (guard (number? n)) `(quote ,n)] [,n (guard (self-evaluating? n)) `(quote ,n)]
[,_ (error 'fixup "invalid expression" _)])) [,_ (error 'fixup "invalid expression" _)]))
(define-syntax add-tests-with-string-output (define-syntax add-tests-with-string-output
@ -66,6 +69,7 @@
...)))]))) ...)))])))
(include "tests/tests-1.1-req.scm") (include "tests/tests-1.1-req.scm")
(include "tests/tests-1.2-req.scm")
(test-all) (test-all)
(printf "Passed ~s tests\n" (length all-tests)) (printf "Passed ~s tests\n" (length all-tests))