commit bfa02e486facb3417f393835ce95b9609df54418
parent 72578b6e9ea2a9ab558d2a488006f657b439f16e
Author: SliTaz User <tux@slitaz.(none)>
Date: Sun, 24 Oct 2010 19:23:43 +0200
Améliorations sur la nouvelle version de test-unitaire, utilisation de la nouvelle version de test-unitaire.
Diffstat:
4 files changed, 45 insertions(+), 55 deletions(-)
diff --git a/environnement.lisp b/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"))))
diff --git a/instructions.lisp b/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)
- (get-register vm 'R1))
- 42)
+ (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 (set-register vm 'R0 2)
- (set-register vm 'R1 84)
- (ISN-DIV vm 'R0 'R1)
+ (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 0)
- (ISN-INCR vm 'R0)
- (get-register vm 'R0))
- 1)
+ (progn (ISN-INCR vm 'R1)
+ (get-register vm 'R1))
+ (+ t-r1-value 1))
(deftest virtual-machine
- (progn (set-register vm 'R0 1)
- (ISN-DECR vm 'R0)
+ (progn (ISN-DECR vm 'R0) ;; R0 > 0 (on ne gère pas les négatifs)
(get-register vm 'R0))
- 0)
+ (- t-r0-value 1))
(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)
diff --git a/main.lisp b/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)
diff --git a/test-unitaire.lisp b/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)
