From 9550ca53cee98824749877b0f1ec324e9314409e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Mon, 1 Nov 2010 15:30:35 +0100 Subject: [PATCH 1/2] =?UTF-8?q?Utilisation=20de=20copy-seq=20au=20lieu=20d?= =?UTF-8?q?e=20copy-tree=20(copy-seq=20marche=20aussi=20avec=20les=20cha?= =?UTF-8?q?=C3=AEnes=20etc.)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- environnement.lisp | 4 ++-- test-unitaire.lisp | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/environnement.lisp b/environnement.lisp index 4ea2e9d..162da09 100644 --- a/environnement.lisp +++ b/environnement.lisp @@ -143,10 +143,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/test-unitaire.lisp b/test-unitaire.lisp index c24d55a..1e31d58 100644 --- a/test-unitaire.lisp +++ b/test-unitaire.lisp @@ -41,8 +41,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) From b85138b05f59564a8743513b15a9496e28e42b23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Mon, 1 Nov 2010 15:57:19 +0100 Subject: [PATCH 2/2] =?UTF-8?q?Corrections=20sur=20test-unitaire=20+=20par?= =?UTF-8?q?am=C3=A8tre=20optionnel=20fonction=20de=20test.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- environnement.lisp | 1 + instructions.lisp | 1 + lisp2li.lisp | 2 +- meval.lisp | 2 ++ test-unitaire.lisp | 17 +++++++++++------ 5 files changed, 16 insertions(+), 7 deletions(-) diff --git a/environnement.lisp b/environnement.lisp index 162da09..1984f27 100644 --- 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 index f105907..1009c43 100644 --- 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 index 41c3d96..0f6d342 100644 --- 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 index 5aac6fe..c0a107f 100644 --- 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 index 1e31d58..2354fbc 100644 --- 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)