www

commit b85138b05f59564a8743513b15a9496e28e42b23
parent 9550ca53cee98824749877b0f1ec324e9314409e
Author: Georges Dupéron <jahvascriptmaniac+github@free.fr>
Date:   Mon,  1 Nov 2010 15:57:19 +0100

Corrections sur test-unitaire + paramètre optionnel fonction de test.

Diffstat:
M
environnement.lisp
 | 
1
+
M
instructions.lisp
 | 
1
+
M
lisp2li.lisp
 | 
2
+-
M
meval.lisp
 | 
2
++
M
test-unitaire.lisp
 | 
17
+++++++++++------

5 files changed, 16 insertions(+), 7 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).
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)))))
 
@@ -68,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)