Améliorations sur la nouvelle version de test-unitaire, utilisation de la nouvelle version de test-unitaire.

environnement.lisp

@@ -19,7 +19,8 @@
 
 ;; Exemple de la structure env-stack après création de deux
 ;; environnements en plus du top-level et ajout de plusieurs laisons.
-(defvar exemple-env-stack 
+(load "test-unitaire")
+(deftestvar environnement exemple-env-stack 
   '(;; Environnement le plus bas (dernières définitions par ordre
     ;; chronologique).
     ("DEFUN"
@@ -100,12 +101,11 @@ l'environnement top-level."
            (print-env-stack (cdr env-stack)))))
 
 ;;Test Unitaire
-(load "test-unitaire")
 (deftest environnement
   (push-new-env (empty-env-stack) "TEST")
   '(("TEST") ("TOP-LEVEL")))
 (deftest environnement
-  (push-new-env (copytree exemple-env-stack) "TEST")
+  (push-new-env exemple-env-stack "TEST")
   (cons '("TEST") exemple-env-stack))
 (deftest environnement
   (add-binding (empty-env-stack) 'x 42)
@@ -122,22 +122,22 @@ l'environnement top-level."
   (set-binding (add-binding (empty-env-stack) 'x 42) 'x .42)
   '(("TOP-LEVEL" (x . .42))))
 (deftest environnement
-  (get-binding (copytree '(("TOP-LEVEL" (X . 42))))
+  (get-binding '(("TOP-LEVEL" (X . 42)))
                'x)
   '(x . 42))
 (deftest environnement
-  (get-binding-value (copytree '(("FOO" (Z . 42)) ("TOP-LEVEL" (x . 42))))
+  (get-binding-value '(("FOO" (Z . 42)) ("TOP-LEVEL" (x . 42)))
                      'x)
   42)
 (deftest environnement
-  (top-level-env-stack (copytree '(("BAR" (X . 42))
-                                   ("TOP-LEVEL" (X . 24) (Z . 73)))))
+  (top-level-env-stack '(("BAR" (X . 42))
+                         ("TOP-LEVEL" (X . 24) (Z . 73))))
   '(("TOP-LEVEL" (X . 24) (Z . 73))))
 (deftest environnement
-  (add-top-level-binding (copytree '(("TEST" (X . 42)) ("TOP-LEVEL" (Y . 56))))
+  (add-top-level-binding (copy-tree '(("TEST" (X . 42)) ("TOP-LEVEL" (Y . 56))))
                          'Z 78)
   '(("TEST" (X . 42)) ("TOP-LEVEL" (Z . 78) (Y . 56))))
 (deftest environnement
-  (set-top-level-binding (copytree '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56))))
+  (set-top-level-binding (copy-tree '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56))))
                          'Y "42")
   '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . "42"))))

instructions.lisp

@@ -203,75 +203,70 @@ et termine par la liste APPEND."
 ;; TODO : Faire deftestvar
 ;; TODO : Finir le test unitaire
 (load "test-unitaire")
-(defvar vm (make-vm (+ 10 (random 10))))
-(defvar t-address (random (size-memory vm)))
-(defvar t-value (random 42))
+(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))
+(deftestvar virtual-machine t-vm-size (+ 10 (random 10)))
+(deftestvar virtual-machine t-adress (random t-vm-size))
+(deftestvar virtual-machine vm
+  (progn
+	(make-vm t-vm-size)
+	(set-register vm 'R0 t-r0-value)
+	(set-memory vm t-adress t-m-value)))
 
-(set-memory vm t-address t-value)
 (deftest virtual-machine
   (progn (ISN-LOAD vm t-address 'R0)
          (get-register vm 'R0))
-  (get-memory vm t-address))
+  t-m-value)
 
-(setf t-address (random (size-memory vm)))
 (deftest virtual-machine
   (progn (ISN-STORE vm 'R0 t-address)
          (get-memory vm t-address))
-  (get-register vm 'R0))
+  t-r0-value)
 
-(setf t-value (random 42))
-(set-register vm 'R0 t-value)
 (deftest virtual-machine
   (progn (ISN-MOVE vm 'R0 'R1)
          (get-register vm 'R1))
-  t-value)
+  t-r0-value)
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 21)
-         (set-register vm 'R1 21)
-         (ISN-ADD vm 'R0 'R1)
+  (progn (ISN-ADD vm 'R0 'R1)
          (get-register vm 'R1))
-  42)
+  (+ t-r1-value t-r0-value))
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 21)
-         (set-register vm 'R1 21)
-         (ISN-SUB vm 'R0 'R1)
+  (progn (ISN-SUB vm 'R0 'R1)
          (get-register vm 'R1))
-  0)
+  (- t-r1-value t-r0-value))
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 21)
-         (set-register vm 'R1 2)
-         (ISN-MULT vm 'R0 'R1)
+  (progn
+	;; Multiplication par un petit nombre (on ne
+	;; gère pas d'éventuels overflows pour l'instant).
+	(set-register vm 'R0 2)
+	(ISN-MULT vm 'R0 'R1)
+	(get-register vm 'R1))
+  (* 2 t-r0-value))
+
+(deftest virtual-machine
+  (progn (ISN-DIV vm 'R0 'R1) ;; R0 > 0 (voir t-r0-value ci-dessus).
          (get-register vm 'R1))
-  42)
+  (/ t-r1-value t-r0-value))
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 2)
-         (set-register vm 'R1 84)
-         (ISN-DIV vm 'R0 'R1)
+  (progn (ISN-INCR vm 'R1)
          (get-register vm 'R1))
-  42)
+  (+ t-r1-value 1))
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 0)
-         (ISN-INCR vm 'R0)
+  (progn (ISN-DECR vm 'R0) ;; R0 > 0 (on ne gère pas les négatifs)
          (get-register vm 'R0))
-  1)
+  (- t-r0-value 1))
 
 (deftest virtual-machine
-  (progn (set-register vm 'R0 1)
-         (ISN-DECR vm 'R0)
-         (get-register vm 'R0))
-  0)
-
-(deftest virtual-machine
-  (progn (set-register vm 'R1 42)
-         (ISN-PUSH vm 'R1)
+  (progn (ISN-PUSH vm 'R1)
          (get-memory vm (get-register vm 'SP)))
-  42)
-
+  (t-r1-value))
 
 
 (dump-vm vm)

main.lisp

@@ -1,11 +1,5 @@
-;; todo : utiliser copy-seq à la place.
-(defun copytree (l)
-  (if (atom l)
-      l
-    (cons (copytree (car l))
-          (copytree (cdr l)))))
 (load "environnement")
 (load "instructions")
 ;; ...
-(run-test t)
+(run-tests)
 ;(print-env-stack exemple-env-stack)

test-unitaire.lisp

@@ -41,7 +41,8 @@
   `(progn
      (if (not (assoc ',module all-tests))
          (setf all-tests (cons (list ',module nil nil) all-tests)))
-     (push (list ',name ',value)
+	 ;; TODO : utiliser copy-seq ou copy-tree ???
+     (push (list ',name (list 'copy-tree ',value))
            (second (assoc ',module all-tests)))))
 
 (defmacro run-tests (&rest modules)