From 72578b6e9ea2a9ab558d2a488006f657b439f16e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Sat, 23 Oct 2010 13:59:08 +0200 Subject: [PATCH] =?UTF-8?q?Nouvelle=20version=20de=20test=20unitaire,=20il?= =?UTF-8?q?=20y=20a=20une=20d=C3=A9mo=20en=20bas=20du=20fichier.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitignore | 1 + fonctions-utiles | 8 +++ test-unitaire.lisp | 149 ++++++++++++++++++++------------------------- 3 files changed, 75 insertions(+), 83 deletions(-) create mode 100644 .gitignore create mode 100644 fonctions-utiles diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..be303db --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*.fasl diff --git a/fonctions-utiles b/fonctions-utiles new file mode 100644 index 0000000..07d126c --- /dev/null +++ b/fonctions-utiles @@ -0,0 +1,8 @@ +(rplacd x val) = (setf (cdr x) val) +(rplaca x val) = (setf (car x) val) +(intersection l1 l2) = évident +(acons clé valeur liste-associative) = (cons (cons clé valeur) liste-associative) ;; Ne gère pas les doublons !!! +(push x liste) = (setf liste (cons x liste)) +(remove-if-not predicate list) filtre la liste en fonction de predicate. +(incf x) incrémente x, (decf x) décrémente x. +(loop ......) lire la doc... \ No newline at end of file diff --git a/test-unitaire.lisp b/test-unitaire.lisp index 4a7a6f9..0a818e3 100644 --- a/test-unitaire.lisp +++ b/test-unitaire.lisp @@ -2,96 +2,79 @@ ;; Mutation cons. (defvar all-tests nil "Liste de tous les tests") +;(defmacro eval-in-env (expr env) +; `(eval-in-env-2 ',expr ,env)) +; +;(defun eval-in-env-2 (qexpr env) +; '(eval `(let ,env ,qexpr))) + (defmacro deftest (module test expected) `(progn (if (not (assoc ',module all-tests)) - (setf all-tests (cons '(,module . nil) all-tests))) - (setf (cdr (assoc ',module all-tests)) - (cons - (lambda () - (let ((res ,expected)) - (if (equal ,test res) - (progn - (format t "~& [SUCCESS] ~w~&" ',test) - t) - (progn - (format t "~& [FAILURE] Test : ~w~&" - ',test) - (format t "~& got : ~w~&" - res) - (format t "~& expected : ~w~&" - ',expected) - nil)))) - (cdr (assoc ',module all-tests)))))) + (setf all-tests (cons (list ',module nil nil) all-tests))) + (push (lambda () + (let* ((vars (second (assoc ',module all-tests))) + (_test ',test) + (_expected ',expected) + ;; Les "eval" ci-dessous exécutent : + ;; (let ((var1 val1) (var2 val2) ...) ;; On définit les + ;; ;; variables de deftestvar. + ;; var1 var2 ... ;; On "utilise" les variables pour + ;; ;; éviter le unused variable warning + ;; corps-du-test) ;; On évalue le corps du test dans + ;; ;; un environement où les deftestvar + ;; ;; sont accessibles. + (res (eval `(let ,vars ,@(mapcar #'car vars) ,_test))) + (exp (eval `(let ,vars ,@(mapcar #'car vars) ,_expected)))) + (if (equal 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) + nil)))) + (third (assoc ',module all-tests))))) + +(defmacro deftestvar (module name value) + `(progn + (if (not (assoc ',module all-tests)) + (setf all-tests (cons (list ',module nil nil) all-tests))) + (push (list ',name ',value) + (second (assoc ',module all-tests))))) (defmacro run-tests (&rest modules) (if (or (not modules) - (eq (car modules) t)) - `(real-run-tests ',(mapcar #'car all-tests)) - `(real-run-tests ',modules))) + (eq (car modules) t)) + `(real-run-tests all-tests) + `(real-run-tests (remove-if-not (lambda (x) + (member (car x) ',modules)) + all-tests)))) +;; OMFG that's not lisp, that's english o_O (defun real-run-tests (modules) - (mapcar (lambda (module) - (if (member (car module) modules) - (mapcar (cdr module) #'funcall))) - all-tests - ) + (loop + for (module vars tests) in (reverse modules) + for nb-fail = (loop + initially (format t "~&Module ~w :~&" module) + for test + in (reverse tests) + count (not (funcall test))) + when (> nb-fail 0) + do (format t "Module ~w failed ~w tests. Stopping.~&" module nb-fail) + and return nil + finally (return t))) -(let ((tests nil)) - (defmacro deftest (module test expected) - (if (not (assoc module tests)) - (setf tests (cons `(,module . (() . ())) tests))) - (let ((mod-tests (assoc module tests))) - (setf (cddr mod-tests) - (cons (cons test expected) - (cddr 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 ~w :~&" (car mod)) - (let ((vars (cadr mod))) - (mapcar (lambda (test) - (let* ((res (eval `(let ,vars ,(car test)))) - (expect (eval `(let ,vars ,(cdr test))))) - (if (equal expect res) - (format t "~& [SUCCESS] ~w~&" (car test)) - (progn (format t " [FAILURE] Test : ~w~& got : ~w~& expected : ~w~&" (car test) res expect) - (setf failures (+ failures 1)))))) - (reverse (cddr mod)))))) - (if (not (= failures 0)) - (format t "Module ~w failed ~w tests. Stopping.~&" (car mod) failures)) - (= failures 0)) - tests) - (progn (format t "All modules passed all tests successfully.~&") - t) - nil))) - (defun show-test () - tests) - (defmacro deftestvar (module nom valeur) - (if (not (assoc module tests)) - (setf tests (cons `(,module . (() . ())) tests))) - (let ((mod-vars (assoc module tests))) - (setf (cadr mod-vars) - (cons (list nom valeur) - (cadr mod-vars)))) - nil)) +(defun erase-tests () + (setf all-tests nil)) -;; 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 +(deftest moda nil nil) +(deftest moda (eq 42 42) t) +(deftest modb (eq 'a 'a) t) +(deftest modb (eq 'a 'b) nil) +(deftest modb (eq 'a 'c) t) +(deftest modb 1 1) +(deftest modc (+ 1 2) (+ 2 1)) +(deftestvar modc x 1) +(deftest modc (+ x 2) (+ 2 1))