91d15c78eb
Quick fix to handling assigned variables originally let bound to lambda expressions, and added a test to verify the fix. c.ss. test.ss
102 lines
2.8 KiB
Scheme
102 lines
2.8 KiB
Scheme
(library (tests)
|
|
(export run-tests)
|
|
(import (c) (rnrs) (rnrs eval) (implementation-helpers))
|
|
|
|
(define-syntax define-tests
|
|
(syntax-rules ()
|
|
[(_ name test ...)
|
|
(define name
|
|
(list
|
|
(cons 'test
|
|
(eval `(canonicalize-result ,'test)
|
|
(environment '(test-lib))))
|
|
...))]))
|
|
|
|
;; NB: need to add many more tests to make sure we're fully testing the compiler.
|
|
(define-tests tests
|
|
0
|
|
-5
|
|
5
|
|
#t
|
|
#f
|
|
'()
|
|
'(3 . 4)
|
|
'(1 2 3 4)
|
|
'(1 2 . 3)
|
|
'(((1 . 2) (3 . 4)) (5 . 6))
|
|
'((0 . #t) (1 . #f) (3 . #t))
|
|
'#(1 2 3)
|
|
'#((2 . 3) #f #t (#t . 4))
|
|
(car '(1 . 2))
|
|
(cdr '(1 . 2))
|
|
(cons 1 2)
|
|
(car (cons 1 2))
|
|
(cdr (cons 1 2))
|
|
(pair? '(1 . 2))
|
|
(pair? (cons 1 2))
|
|
(null? '())
|
|
(null? (cdr (cons 1 '())))
|
|
(vector-ref '#(1 2 3) 1)
|
|
(vector-length '#(1 2 3))
|
|
(vector-length (make-vector 10))
|
|
(box 4)
|
|
(box '(1 . 2))
|
|
(unbox (box 10))
|
|
(car (unbox (box (cons 1 2))))
|
|
(+ 2 3)
|
|
(+ (+ 4 5) (+ 6 7))
|
|
(- 2 3)
|
|
(- (- (- 1 2) 3) 4)
|
|
(* 2 5)
|
|
(* 3 (* 4 5))
|
|
(/ 10 2)
|
|
(/ 7 2)
|
|
(/ (/ 10 2) 2)
|
|
(+ (- 1 20) 30)
|
|
(- 4 4)
|
|
(box? (box 4))
|
|
(box? (box #f))
|
|
(box? (cons 1 2))
|
|
(letrec ([! (lambda (n)
|
|
(if (zero? n)
|
|
1
|
|
(* n (! (- n 1)))))]
|
|
[zero? (lambda (n) (= n 1))])
|
|
(! 10))
|
|
(letrec ([f (lambda (g x) (g x))]
|
|
[a 5]
|
|
[b (+ 5 7)]
|
|
[g (lambda (h) (f h 5))]
|
|
[c (let ([x 10]) ((letrec ([zero? (lambda (n) (= n 0))]
|
|
[f (lambda (n)
|
|
(if (zero? n)
|
|
1
|
|
(* n (f (- n 1)))))])
|
|
f)
|
|
x))]
|
|
[m 10]
|
|
[z (lambda (x) x)])
|
|
(set! z (lambda (x) (+ x x)))
|
|
(set! m (+ m m))
|
|
(+ (+ (+ (f z a) (f z b)) (f z c)) (g z)))
|
|
(let ([f (lambda (x y) (* x y))])
|
|
(set! f (lambda (x y) (+ x y)))
|
|
(f 5 3)))
|
|
|
|
(define run-tests
|
|
(lambda ()
|
|
(let loop ([tests tests] [i 0])
|
|
(unless (null? tests)
|
|
(let ([test (car tests)])
|
|
(let ([expr (car test)] [result (cdr test)])
|
|
(printf "running test ~d:~%" i)
|
|
(pretty-print expr)
|
|
;; NB: when we hit an exception, report the result as part of the string.
|
|
(guard (c [else (printf "failed with exception (TBD)~%")])
|
|
(let ([actual (my-tiny-compile expr)])
|
|
(if (equal? actual result)
|
|
(printf "passed~%")
|
|
(printf "expected ~s but got ~s~%" result actual))))
|
|
(loop (cdr tests) (fx+ i 1)))))))))
|
|
|