-
Notifications
You must be signed in to change notification settings - Fork 1
/
tests.lisp
119 lines (112 loc) · 5.51 KB
/
tests.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
(in-package :minerva)
;; Set this variable to your desired intermediates directory before running tests
(defvar *intermediates-pathname* (assert *intermediates-pathname*))
(defparameter *test-output* *standard-output*)
(defun clean-test ()
(let ((test-s-pathname (make-pathname :name "test" :type "s" :defaults *intermediates-pathname*)))
(when (probe-file test-s-pathname) (delete-file test-s-pathname)))
(let ((main-exe-pathname (make-pathname :name "main" :type "exe" :defaults *intermediates-pathname*)))
(when (probe-file main-exe-pathname) (delete-file main-exe-pathname))))
(defun run-executable (test-pathname)
#+win32
(uiop:run-program (list (make-pathname :type "exe" :defaults test-pathname)) :output *test-output*)
#+linux
(uiop:run-program (list test-pathname) :output *test-output*))
(defun test-case (input expected-output)
(let* ((test-pathname (make-pathname :name "test" :defaults *intermediates-pathname*))
(raw-output
(with-output-to-string (*test-output*)
(progn
(clean-test)
(compile-scheme-expr input test-pathname)
(run-executable test-pathname))))
#+win32
(output (subseq raw-output 0 (- (length raw-output) 2)))
#+linux
(output (subseq raw-output 0 (- (length raw-output) 1)))
(result (string= expected-output output)))
(format t "~:[FAILED~;passed~] case: ~s | expected output: ~a ~:[| actual output: ~a~;~]~%" result input expected-output result output)
result))
(defun test-section (string)
(format t "~a~%" string)
t)
(defun run-all-tests ()
(let ((*package* (find-package :minerva))) ;; hide the package name in the test output
(and
(test-section "Immediate Constants:")
(test-case 1337 "1337")
(test-case #\F "F")
(test-case #t "#t")
(test-case #f "#f")
(test-case nil "()")
(test-section "Unary Primitives:")
(test-case '(add1 80084) "80085")
(test-case '(integer->char 90) "Z")
(test-case '(char->integer #\Z) "90")
(test-case '(zero? 0) "#t")
(test-case '(zero? 1) "#f")
(test-case '(null? nil) "#t")
(test-case '(null? #\n) "#f")
(test-case '(not #f) "#t")
(test-case '(not 1) "#f")
(test-case '(integer? 1337) "#t")
(test-case '(integer? #t) "#f")
(test-case '(boolean? #f) "#t")
(test-case '(boolean? 1337) "#f")
(test-case '(add1 (char->integer #\Z)) "91")
(test-case '(add1 (char->integer (integer->char 90))) "91")
(test-section "Binary Primitives:")
(test-case '(+ 5 23) "28")
(test-case '(- 1340 3) "1337")
(test-case '(+ (- 4 3) (- 2 1)) "2")
(test-case '(* 25 4) "100")
(test-case '(* (+ 4 3) (- 2 1)) "7")
(test-case '(= 13 37) "#f")
(test-case '(= 3 (+ 2 1)) "#t")
(test-case '(> 23 5) "#t")
(test-case '(> 13 37) "#f")
(test-case '(> 11 11) "#f")
(test-section "Local Variables:")
(test-case '(let ((a 1337)) a) "1337")
(test-case '(let ((b #\V)) b) "V")
(test-case '(let ((c nil)) c) "()")
(test-case '(let ((d #f)) d) "#f")
(test-case '(let ((foo 3)) (* foo foo)) "9")
(test-case '(let ((one 4) (two 3) (three 2) (four 1)) (* (+ two four) (- one three))) "8")
(test-case '(let ((a 1330)) (let ((b 7)) (+ a b))) "1337")
(test-section "Conditional Expressions:")
(test-case '(if (zero? 0) (+ 1330 7) (* 21 2)) "1337")
(test-case '(if (zero? 1) (+ 1330 7) (* 21 2)) "42")
(test-case '(let ((a (integer? 1))) (if a #\F 0)) "F")
(test-section "Heap Allocation:")
(test-case '(cons 1 2) "(1 . 2)")
(test-case '(car (cons 10 20)) "10")
(test-case '(cdr (cons 10 20)) "20")
(test-case '(car (cons #t #f)) "#t")
(test-case '(cdr (cons #\P #\Q)) "Q")
(test-case '(cdr (cons 1 ())) "()")
(test-case '(car (cdr (cons 10 (cons 20 ())))) "20")
(test-case '(let ((a (cons #t #f))) (if (car a) 1 2)) "1")
(test-case '(make-vector 3) "#(0 0 0)")
(test-case '(let ((a (make-vector 3))) (let ((b (vector-set! a 1 1337))) a)) "#(0 1337 0)")
(test-case '(let ((a (make-vector 128))) (let ((b (vector-set! a 127 #f))) (vector-ref a 127))) "#f")
(test-case '(let ((s (make-string 3))) (let ((a (string-set! s 0 #\b)) (b (string-set! s 1 #\a)) (c (string-set! s 2 #\z))) s)) "\"baz\"")
(test-case '(let ((s (make-string 3))) (let ((a (string-set! s 0 #\h)) (b (string-set! s 1 #\i))) (string-ref s 1))) "i")
(test-case '(let ((v (make-vector 1))) (vector-set! v 0 1337) (vector-ref v 0)) "1337")
(test-section "Closures:")
(test-case '(lambda (x) x) "#<procedure>")
(test-case '(funcall (lambda (x) x) 1337) "1337")
(test-case '(funcall (lambda () 1337)) "1337")
(test-case '(let ((x 5)) (lambda () (+ x 1))) "#<procedure>")
(test-case '(let ((x 5)) (let ((foo (lambda () (+ x 1)))) (funcall foo))) "6")
(test-case '(funcall (lambda (x) (* x x)) 4) "16")
(test-case '(let ((x 5)) (lambda (y) (lambda () (+ x y)))) "#<procedure>")
(test-case '(let ((sqr (lambda (x) (* x x)))) (funcall sqr 4)) "16")
(test-case '(let ((v (make-vector 1))) (funcall (lambda () (vector-set! v 0 1337) (vector-ref v 0)))) "1337")
(test-section "Complex Constants:")
(test-case '(quote (1 . 2)) "(1 . 2)")
(test-case '(car (quote (1 . 2))) "1")
(test-case '(let ((f (lambda () (quote (1 . "H"))))) (eq? (funcall f) (funcall f))) "#t")
(test-section "Assignment:")
(test-case '(let ((a 1333)) (set! a (+ a 2)) (funcall (lambda (a b) (set! a (+ a 1)) (+ a b)) 1 a)) "1337")
(test-case '(let ((z 1)) (let ((z (let ((z z)) (set! z (+ z 1)) z))) (+ z 1))) "3"))))