equiv-tests.lisp (6462B)
1 ;(require 'squash-lisp "squash-lisp") 2 (require 'mini-meval "mini-meval") 3 (require 'test-unitaire "test-unitaire") 4 5 (defmacro deftest-equiv (module test expected) 6 `(progn 7 (deftest ,(append '(equiv eval expected) module) (eval ,test) ,expected) 8 (deftest ,(append '(equiv mini-meval expected) module) (mini-meval ,test etat) ,expected) 9 (deftest ,(append '(equiv squash-lisp-1 check) module) (squash-lisp-1-check (squash-lisp-1 ,test t etat)) t) 10 (deftest ,(append '(equiv squash-lisp-1 expected) module) (eval (squash-lisp-1-wrap (squash-lisp-1 ,test t etat))) ,expected) 11 (deftest ,(append '(equiv squash-lisp-3 check) module) (squash-lisp-3-check (squash-lisp-1+3 ,test etat)) t) 12 (deftest ,(append '(equiv squash-lisp-3 expected) module) (eval (squash-lisp-3-wrap (squash-lisp-1+3 ,test etat))) ,expected))) 13 14 (erase-tests equiv) 15 16 (deftestvar (equiv) etat (push-local (make-etat list + - cons car cdr < > <= >= =) '*test-equiv-var-x* 'variable 42)) 17 (defvar *test-equiv-var-x* 42) 18 19 (deftest-equiv (constante) 20 42 21 42) 22 23 (deftest-equiv (appel-fonction) 24 '(+ 2 3) 25 5) 26 27 (deftest-equiv (appel-fonction) 28 '(+ 2 (+ 3 4)) 29 9) 30 31 (deftest-equiv (variable) 32 '*test-equiv-var-x* 33 42) 34 35 (deftest-equiv (appel-fonction-et-variable) 36 '(+ *test-equiv-var-x* *test-equiv-var-x* 3) 37 87) 38 39 (deftest-equiv (appel-fonction-et-variable) 40 '(+ *test-equiv-var-x* (+ 3 *test-equiv-var-x*)) 41 87) 42 43 (deftest-equiv (lambda immédiat) 44 '((lambda (x) (+ x 3)) 4) 45 7) 46 47 (deftest-equiv (lambda sans-params) 48 '((lambda () 42)) 49 42) 50 51 (deftest-equiv (lambda sans-body) 52 '((lambda ())) 53 nil) 54 55 (deftest-equiv (let) 56 '(let ((x 3) (y 4)) (+ x y)) 57 7) 58 59 (deftest-equiv (let) 60 '(let ((x 3) (y 4) (z 5)) (let ((z (+ x y)) (w z)) (list x y z w))) 61 '(3 4 7 5)) 62 63 (deftest-equiv (let*) 64 '(let ((x 3) (y 4) (z 5)) z (let* ((z (+ x y)) (w z)) (list x y z w))) 65 '(3 4 7 7)) 66 67 ;; TODO 68 ;; (deftest-equiv (let-nil) 69 ;; '(let (a (x 3) y) (list a x y)) 70 ;; '(nil 3 nil)) 71 72 ;; (deftest-equiv (let-nil) 73 ;; '(let* ((x 4) y (z 5)) (list a x y)) 74 ;; '(4 nil 5)) 75 76 (deftest-equiv (progn) 77 '(progn 1 2 3 4) 78 4) 79 80 (deftest-equiv (quote) 81 ''x 82 'x) 83 84 (deftest-equiv (macrolet) 85 '(labels ((qlist (a b) (list a b))) 86 (list 87 (qlist 'a 'b) 88 (macrolet ((qlist (x y) (list 'list (list 'quote x) (list 'quote y)))) 89 (qlist 'a 'b)) 90 (qlist 'a 'b))) 91 '((a b) ('a 'b) (a b))) 92 93 (deftest-equiv (setf setq) 94 '(let ((x 42)) (list x (setq x 123) x)) 95 '(42 123 123)) 96 97 (deftest-equiv (funcall) 98 '(funcall #'+ 1 2 3) 99 '6) 100 101 (deftest-equiv (apply) 102 '(apply #'+ 1 2 (list (+ 1 2) 4)) 103 '10) 104 105 (deftest-equiv (function extérieur) 106 '(funcall #'+ 1 2 3) 107 '6) 108 109 (deftest-equiv (lambda optional) 110 '((lambda (x &optional (y 2)) (list x y)) 1) 111 '(1 2)) 112 113 (deftest-equiv (lambda closure single-instance) 114 '(let ((foo (let ((y 1)) (cons (lambda (x) (list x y)) (lambda (z) (setq y (+ y z)) nil))))) 115 (list (funcall (car foo) 4) (funcall (cdr foo) 5) (funcall (car foo) 4))) 116 '((4 1) nil (4 6))) 117 118 (deftest-equiv (lambda closure multiple-instances) 119 '(labels ((counter (&optional (ctr 0)) (cons (lambda () ctr) (lambda (&optional (x 1)) (setq ctr (+ ctr x)) nil)))) 120 (let ((foo0 (counter)) 121 (foo42 (counter 42))) 122 (list 123 (funcall (car foo0)) ;; show 0 124 (funcall (car foo42)) ;; show 42 125 (funcall (cdr foo0)) ;; add 0 126 (funcall (car foo0)) ;; show 0 127 (funcall (cdr foo42)) ;; add 42 128 (funcall (car foo42)) ;; show 42 129 (funcall (car foo0)) ;; shwo 0 130 (funcall (car foo42)) ;; show 42 131 (funcall (cdr foo42) 6) ;; add 42 (+ 6) 132 (funcall (cdr foo0) 5) ;; add 0 (+ 5) 133 (funcall (car foo42)) ;; show 42 134 (funcall (car foo0))))) ;; show 0 135 '(0 42 nil 1 nil 43 1 43 nil nil 49 6)) 136 137 (deftest-equiv (labels) 138 '(labels ((foo (x) (+ x 1))) 139 (list 140 (foo 3) 141 (labels ((foo (x) (+ x 3))) 142 (foo 3)))) 143 '(4 6)) 144 145 (deftest-equiv (labels) 146 '(< 2 3) 147 t) 148 149 (deftest-equiv (flet) 150 '(labels ((foo (x) (+ x 1))) 151 (list 152 (foo 3) 153 (flet ((foo (x) (+ x 3))) 154 (foo 3)))) 155 '(4 6)) 156 157 (deftest-equiv (labels) 158 '(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ... 159 (list 160 (fibo 5) 161 (labels ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ... 162 (fibo 5)) 163 (fibo 5))) 164 '(8 5 8)) 165 166 (deftest-equiv (flet) 167 '(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ... 168 (list 169 (fibo 5) 170 (flet ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ... 171 (fibo 5)))) 172 ;; Le flet ne permet pas les définitions récursives, donc le fibo 173 ;; de l'extérieur est appellé après le 1er niveau de récursion. 174 '(8 8)) 175 176 (deftest-equiv (tagbody) 177 '(let ((x 0)) (tagbody foo (setq x 1) (go baz) bar (setq x 2) baz) x) 178 1) 179 180 (deftest-equiv (tagbody) 181 '(let ((x 0)) (tagbody foo (setq x 1) (go 42) bar (setq x 2) 42) x) 182 1) 183 184 (deftest-equiv (tagbody) 185 '(tagbody foo (list 1) 42 (list 2) baz (list 3)) 186 nil) 187 188 (deftest-equiv (block) 189 '(block foo 1 (return-from foo 4) 2) 190 4) 191 192 (deftest-equiv (block) 193 '(block foo 1 2) 194 2) 195 196 (deftest-equiv (tagbody) 197 '(let ((res nil)) 198 (tagbody 199 a 200 1 201 (setq res (cons 'x res)) 202 b 203 (setq res (cons 'y res)) 204 (go 3) 205 d 206 (setq res (cons 'z res)) 207 3 208 (setq res (cons 'f res))) 209 res) 210 '(f y x)) 211 212 (deftest-equiv (flet) 213 '(flet ((foo (x) (+ x 1)) (bar (y z) (cons y z))) (list (foo 3) (bar 4 5))) 214 '(4 (4 . 5))) 215 216 (deftest-equiv (function extérieur) 217 '#'+ 218 #'+) 219 220 (deftest-equiv (lambda captures) 221 '(funcall ((lambda (x y) x (lambda (x) (+ x y))) 1 2) 3) 222 5) 223 224 (deftest-equiv (lambda captures ycombinator) 225 '((lambda (fibo) 226 (list (funcall fibo 0) 227 (funcall fibo 1) 228 (funcall fibo 2) 229 (funcall fibo 3) 230 (funcall fibo 4) 231 (funcall fibo 5) 232 (funcall fibo 6) 233 (funcall fibo 7))) 234 ((lambda (f) (lambda (x) (funcall f f x))) (lambda (f n) (if (<= n 1) n (+ (funcall f f (- n 1)) (funcall f f (- n 2))))))) 235 '(0 1 1 2 3 5 8 13)) 236 237 (provide 'equiv-tests)