commit 2baa47016d9c7b7e4924ed97d5cefb06cc546725
parent 02dd04e7a9ad3d30d7e07df4b603a5e0ca2762a5
Author: Bertrand BRUN <bertrand.brun@me.com>
Date: Mon, 1 Nov 2010 16:01:50 +0100
Merge branch 'master' of https://github.com/dumbs/2010-m1s1-compilation
Diffstat:
5 files changed, 19 insertions(+), 11 deletions(-)
diff --git a/environnement.lisp b/environnement.lisp
@@ -20,6 +20,7 @@
;; Exemple de la structure env-stack après création de deux
;; environnements en plus du top-level et ajout de plusieurs laisons.
(load "test-unitaire")
+(erase-tests environnement)
(deftestvar environnement exemple-env-stack
'(;; Environnement le plus bas (dernières définitions par ordre
;; chronologique).
@@ -143,10 +144,10 @@ l'environnement top-level."
("TOP-LEVEL" (X . 24) (Z . 73))))
'(("TOP-LEVEL" (X . 24) (Z . 73))))
(deftest environnement
- (add-top-level-binding (copy-tree '(("TEST" (X . 42)) ("TOP-LEVEL" (Y . 56))))
+ (add-top-level-binding (copy-seq '(("TEST" (X . 42)) ("TOP-LEVEL" (Y . 56))))
'Z 78)
'(("TEST" (X . 42)) ("TOP-LEVEL" (Z . 78) (Y . 56))))
(deftest environnement
- (set-top-level-binding (copy-tree '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56))))
+ (set-top-level-binding (copy-seq '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56))))
'Y "42")
'(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . "42"))))
diff --git a/instructions.lisp b/instructions.lisp
@@ -203,6 +203,7 @@ et termine par la liste APPEND."
;; TODO : Faire deftestvar
;; TODO : Finir le test unitaire
(load "test-unitaire")
+(erase-tests virtual-machine)
(deftestvar virtual-machine t-r0-value (+ 1 (random 42))) ;; r0 > 0 pour la division.
(deftestvar virtual-machine t-r1-value (random 42))
(deftestvar virtual-machine t-m-value (random 42))
diff --git a/lisp2li.lisp b/lisp2li.lisp
@@ -68,7 +68,7 @@ par le compilateur et par l’interpréteur"
;; Test unitaire
(load "test-unitaire")
-;(erase-tests)
+(erase-tests lisp2li)
(deftest lisp2li
(lisp2li '3 ())
diff --git a/meval.lisp b/meval.lisp
@@ -19,6 +19,8 @@
(mapcar (lambda (x) (meval x env)) list))
;; Test unitaire
+(load "test-unitaire")
+(erase-tests meval)
(deftest meval
(meval '(:lit . 3) ())
3)
diff --git a/test-unitaire.lisp b/test-unitaire.lisp
@@ -8,7 +8,10 @@
;(defun eval-in-env-2 (qexpr env)
; '(eval `(let ,env ,qexpr)))
-(defmacro deftest (module test expected)
+(defun booleq (a b)
+ (if a b (not b)))
+
+(defmacro deftest (module test expected &optional (compare #'equal))
`(progn
(if (not (assoc ',module all-tests))
(setf all-tests (cons (list ',module nil nil) all-tests)))
@@ -16,6 +19,7 @@
(let* ((vars (second (assoc ',module all-tests)))
(_test ',test)
(_expected ',expected)
+ (_compare ,compare)
;; Les "eval" ci-dessous exécutent :
;; (let ((var1 val1) (var2 val2) ...) ;; On définit les
;; ;; variables de deftestvar.
@@ -26,14 +30,15 @@
;; ;; sont accessibles.
(res (eval `(let ,vars ,@(mapcar #'car vars) ,_test)))
(exp (eval `(let ,vars ,@(mapcar #'car vars) ,_expected))))
- (if (equal res exp)
+ (if (funcall _compare res exp)
(progn
(format t "~& [SUCCESS] ~w~&" ',test)
t)
(progn
- (format t "~& [FAILURE] Test : ~w~&" ',test)
- (format t "~& got : ~w~&" (list res (random 10)))
- (format t "~& expected : ~w~&" exp)
+ (format t "~& [FAILURE] Test : ~w~&" ',test)
+ (format t "~& got : ~w~&" res)
+ (format t "~& expected : ~w~&" exp)
+ (format t "~& comparison : ~w~&" _compare)
nil))))
(third (assoc ',module all-tests)))))
@@ -41,8 +46,7 @@
`(progn
(if (not (assoc ',module all-tests))
(setf all-tests (cons (list ',module nil nil) all-tests)))
- ;; TODO : utiliser copy-seq ou copy-tree ???
- (push (list ',name (list 'copy-tree ',value))
+ (push (list ',name (list 'copy-seq ',value))
(second (assoc ',module all-tests)))))
(defmacro run-tests (&rest modules)
@@ -69,7 +73,7 @@
(defun erase-tests-1 (module)
(if module
- (setf (assoc module all-tests) nil)
+ (setf (cdr (assoc module all-tests)) (list nil nil))
(setf all-tests nil)))
(defmacro erase-tests (&optional module)
