Sélection des modules pour lesquerls on veut faire les tests. Correction des erreurs. Messages plus explicites. Arrêt quand un des modules fail.

test-unitaire.lisp

@@ -1,19 +1,48 @@
+;; Mutation cons.
 (let ((tests nil))
-  (defmacro deftest (module expected test)
-    (setf tests (cons (list module expected test) tests))
-     nil)
-  (defmacro run-test (module)
-    (mapcar (lambda (test)
-              (let ((res (eval (third test))))
-                (if (equal (second test) res)
-                    (print "[SUCCESS] ~a" (third test))
-                  (print  "[FAILURE] ~a\n           got ~a\n           expected ~a" (third test) res (second test)))))
-              tests) nil)
+  (defmacro deftest (module test expected)
+    (if (not (assoc module tests))
+        (setf tests (cons `(,module . ()) tests)))
+    (let ((mod-tests (assoc module tests)))
+      (setf (cdr mod-tests)
+            (cons (cons test expected)
+                  (cdr mod-tests))))
+    nil)
+  (defmacro run-test (&rest modules)
+    (let ((failures 0)
+          (modules (if (eq T (car modules))
+                       (mapcar #'car tests)
+                       modules)))
+      (if (every (lambda (mod)
+                   (if (member (car mod) modules)
+                       (progn
+                         (format t "Module ~a :~&" (car mod))
+                         (mapcar (lambda (test)
+                                   (let ((res (eval (car test))))
+                                     (if (equal (cdr test) res)
+                                         (format t "    [SUCCESS] ~a~&" (car test))
+                                         (progn (format t "    [FAILURE] Test     : ~a~&              got      : ~a~&              expected : ~a~&" (car test) res (cdr test))
+                                                (setf failures (+ failures 1))))))
+                                 (cdr mod))))
+                   (if (not (= failures 0))
+                       (format t "Module ~a failed ~a tests. Stopping." (car mod) failures))
+                   (= failures 0))
+                 tests)
+          (progn (format t "All modules passed all tests successfully.")
+                 t)
+          nil)))
   (defun show-test ()
     tests))
 
 ;; Test de debugage du test unitaire
 (deftest environnement nil nil)
+(deftest environnement (eq 42 42) T) ;; Test qui fail
+(deftest vm T T)
+(deftest environnement2 (eq 42 42) nil)
 (show-test)
 (run-test environnement)
-
+;; TODO : every ne mappe pas la liste dans le bon ordre, et vm est
+;; exécuté avant environnement quel que soit l'ordre des paramètres.
+(run-test environnement vm)
+(run-test environnement vm environnement2)
+(run-test t) ;; t => tous