From cab12e533a6a6fbebe999608a7a7f7de51efa4a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Fri, 19 Nov 2010 22:54:31 +0100 Subject: [PATCH] Utilisation de (require), correction d'un bug dans test-unitaire, 589 tests passed sucessfully. \o/ --- environnement.lisp | 4 ++- implementation/compilation.lisp | 8 +++-- implementation/lisp2cli.lisp | 4 ++- implementation/mini-meval.lisp | 8 +++-- instructions.lisp | 24 ++++++++------- lisp2li.lisp | 13 ++++---- main.lisp | 16 ++++++---- match.lisp | 6 ++-- meval.lisp | 8 +++-- test-unitaire.lisp | 53 +++++++++++++++------------------ util.lisp | 4 ++- 11 files changed, 83 insertions(+), 65 deletions(-) diff --git a/environnement.lisp b/environnement.lisp index 858388b..6906cb4 100644 --- a/environnement.lisp +++ b/environnement.lisp @@ -19,7 +19,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") +(require 'test-unitaire "test-unitaire") (erase-tests environnement) (deftestvar environnement exemple-env-stack '(;; Environnement le plus bas (dernières définitions par ordre @@ -148,3 +148,5 @@ l'environnement top-level." (set-top-level-binding (copy-tree '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56)))) 'Y "42") '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . "42")))) + +(provide 'environnement) \ No newline at end of file diff --git a/implementation/compilation.lisp b/implementation/compilation.lisp index 58581e7..17d4a1c 100644 --- a/implementation/compilation.lisp +++ b/implementation/compilation.lisp @@ -1,6 +1,6 @@ -(load "match") -(load "util") -(load "implementation/lisp2cli") +(require 'match "match") +(require 'util "util") +(require 'lisp2cli "implementation/lisp2cli") (defvar asm-fixnum-size 32) (defvar asm-max-fixnum (expt 2 asm-fixnum-size)) @@ -136,3 +136,5 @@ ;; pop r0 ;; add r1 r0 ;; retn + +(provide 'compilation) \ No newline at end of file diff --git a/implementation/lisp2cli.lisp b/implementation/lisp2cli.lisp index 3f54139..b5e3ef6 100644 --- a/implementation/lisp2cli.lisp +++ b/implementation/lisp2cli.lisp @@ -371,4 +371,6 @@ Est transformé en : [get-global-cell-value x] [set-global-cell-value x [pop]] -|# \ No newline at end of file +|# + +(provide 'lisp2cli) \ No newline at end of file diff --git a/implementation/mini-meval.lisp b/implementation/mini-meval.lisp index a87da67..c5622f3 100644 --- a/implementation/mini-meval.lisp +++ b/implementation/mini-meval.lisp @@ -1,5 +1,5 @@ -(load "match") -(load "util") +(require 'match "match") +(require 'util "util") ;; TODO (dans mini-meval et/ou compilateur) : ;; - match-automaton(tagbody+block) @@ -553,4 +553,6 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau (deftest (mini-meval block) (mini-meval '(block foo 1 2)) - 2) \ No newline at end of file + 2) + +(provide 'mini-meval) \ No newline at end of file diff --git a/instructions.lisp b/instructions.lisp index 3615a7e..558f583 100644 --- a/instructions.lisp +++ b/instructions.lisp @@ -199,18 +199,19 @@ ;;Test Unitaire ;; TODO : Faire deftestvar ;; TODO : Finir le test unitaire -(load "test-unitaire") +(require 'test-unitaire "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)) -(deftestvar virtual-machine t-vm-size (+ 10 (random 10))) -(deftestvar virtual-machine t-adress (random t-vm-size)) +(deftestvar virtual-machine t-r0-value (+ 1 (random-test 42))) ;; r0 > 0 pour la division. +(deftestvar virtual-machine t-r1-value (random-test 42)) +(deftestvar virtual-machine t-m-value (random-test 42)) +(deftestvar virtual-machine t-vm-size (+ 10 (random-test 10))) +(deftestvar virtual-machine t-address (random-test t-vm-size)) (deftestvar virtual-machine vm - (progn - (make-vm t-vm-size) + (let ((vm (make-vm t-vm-size))) (set-register vm 'R0 t-r0-value) - (set-memory vm t-adress t-m-value))) + (set-register vm 'R1 t-r1-value) + (set-memory vm t-address t-m-value) + vm)) (deftest virtual-machine (progn (ISN-LOAD vm t-address 'R0) @@ -244,7 +245,7 @@ (set-register vm 'R0 2) (ISN-MULT vm 'R0 'R1) (get-register vm 'R1)) - (* 2 t-r0-value)) + (* 2 t-r1-value)) (deftest virtual-machine (progn (ISN-DIV vm 'R0 'R1) ;; R0 > 0 (voir t-r0-value ci-dessus). @@ -264,5 +265,6 @@ (deftest virtual-machine (progn (ISN-PUSH vm 'R1) (get-memory vm (get-register vm 'SP))) - (t-r1-value)) + t-r1-value) +(provide 'instructions) \ No newline at end of file diff --git a/lisp2li.lisp b/lisp2li.lisp index 2e8db9d..83c2f87 100644 --- a/lisp2li.lisp +++ b/lisp2li.lisp @@ -1,14 +1,14 @@ -(load "util.lisp") -(load "match.lisp") +(require 'util "util.lisp") +(require 'match "match.lisp") ;; ` -(defvar my-quasiquote (car '`(,a))) +(defvar my-quasiquote nil);(car '`(,a))) ;; , -(defvar my-unquote (caaadr '`(,a))) +(defvar my-unquote nil);(caaadr '`(,a))) ;; ,@ -(defvar my-unquote-unsplice (caaadr '`(,@a))) +(defvar my-unquote-unsplice nil);(caaadr '`(,@a))) (defun map-lisp2li (expr env) (mapcar (lambda (x) (lisp2li x env)) expr)) @@ -258,7 +258,7 @@ par le compilateur et par l’interpréteur" ;; TODO : demander au prof comment corriger (or (= n 0) (= n 1)) qui rend nil car il fait 2 macroexpand 1: (COND ((= N 0)) (T (= N 1))) 2: (LET (#1=#:RESULT-7048) (IF (SETQ #1# (= N 0)) #1# (= N 1))) et 2 vaux nil car n != 0 ;; Test unitaire -(load "test-unitaire") +(require 'test-unitaire "test-unitaire") (erase-tests lisp2li) (deftest (lisp2li make-stat-env) @@ -552,3 +552,4 @@ par le compilateur et par l’interpréteur" '(:let 1 (:set-var (0 1) (:const . 2)) (:call cons (:cvar 0 1) (:cvar 1 1)))) +(provide 'lisp2li) \ No newline at end of file diff --git a/main.lisp b/main.lisp index 92ecbc6..8e81b85 100644 --- a/main.lisp +++ b/main.lisp @@ -1,8 +1,14 @@ -;(setq *print-circle* t) -(load "environnement") +;; Main + +;; Chargement de tous les fichiers, dans l'ordre du tri topologique +;; pour tous les re-charger, sans les charger deux fois. + +(load "util") +(load "test-unitaire") (load "instructions") +(load "match") (load "lisp2li") (load "meval") -;; ... -;(run-tests t) -;(print-env-stack exemple-env-stack) +(load "implementation/mini-meval") + +(provide 'main) \ No newline at end of file diff --git a/match.lisp b/match.lisp index 3ce746c..c109b0a 100644 --- a/match.lisp +++ b/match.lisp @@ -1,4 +1,4 @@ -(load "util") ;; n-consp +(require 'util "util") ;; n-consp ;; Syntaxe : (match expression) ;; ex: (match (:a ? :c) '(a b c)) => t @@ -660,7 +660,7 @@ donc seule la valeur de la dernière expression de la dernière clause est renvo (go ,to))) (_ (go reject)))))))))) -(load "test-unitaire") +(require 'test-unitaire "test-unitaire") (erase-tests match) ;;;; Tests de matching (vrai / faux) @@ -1429,3 +1429,5 @@ donc seule la valeur de la dernière expression de la dernière clause est renvo (deftest (match defmatch) (test-match-bar 42) 'i-m-else) + +(provide 'match) \ No newline at end of file diff --git a/meval.lisp b/meval.lisp index 68b9132..5993287 100644 --- a/meval.lisp +++ b/meval.lisp @@ -1,4 +1,4 @@ -(load "match") +(require 'match "match") (defun env-size (env) (if (or (equalp env #()) (eq env nil)) @@ -168,8 +168,8 @@ d’arguments dans un certain environnement." (error "form special ~S not yet implemented" expr)))) ;; Test unitaire -(load "test-unitaire") -(load "lisp2li") +(require 'test-unitaire "test-unitaire") +(require 'lisp2li "lisp2li") (erase-tests meval) (deftest (meval :const) (meval (lisp2li 3 ())) @@ -288,3 +288,5 @@ d’arguments dans un certain environnement." env) #(() 42) #'equalp) + +(provide 'meval) \ No newline at end of file diff --git a/test-unitaire.lisp b/test-unitaire.lisp index b7c70ae..d2f43a9 100644 --- a/test-unitaire.lisp +++ b/test-unitaire.lisp @@ -59,33 +59,26 @@ (if a b (not b))) (defmacro deftest (module test expected &optional (compare #'equal)) - `(test-add-test - ',module - (lambda () - (let* ((vars (test-get-variables-and-above ',module)) - (_test ',test) - (_expected ',expected) - (_compare ,compare) - ;; 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 (funcall _compare res exp) - (progn - (format t "~& [SUCCESS] ~w~&" ',test) - t) - (progn - (format t "~& [FAILURE] Test : ~w~&" ',test) - (format t "~& got : ~w~&" res) - (format t "~& expected : ~w~&" exp) - (format t "~& comparison : ~w~&" _compare) - nil)))))) + (let ((vars (test-get-variables-and-above module))) + `(test-add-test + ',module + (lambda () + (let* ((state-1 (make-random-state)) + (state-2 (make-random-state state-1)) + (res (labels ((random-test (n) (random n state-1))) + (let* ,vars ,@(mapcar #'car vars) ,test))) + (exp (labels ((random-test (n) (random n state-2))) + (let* ,vars ,@(mapcar #'car vars) ,expected)))) + (if (funcall ,compare res exp) + (progn + (format t "~& [SUCCESS] ~w~&" ',test) + t) + (progn + (format t "~& [FAILURE] Test : ~w~&" ',test) + (format t "~& got : ~w~&" res) + (format t "~& expected : ~w~&" exp) + (format t "~& comparison : ~w~&" ,compare) + nil))))))) (defvar b '(x x)) (defmacro generates-error-p (code) @@ -98,7 +91,7 @@ (defmacro deftestvar (module name value) `(test-add-variable ',module - (list ',name (list 'copy-all ',value)))) + (list ',name ',value))) (defvar run-tests-counter 0) @@ -167,7 +160,7 @@ (let* ((foo #(a b (1 #(2 4 6) 3) c)) (copy-of-foo (copy-all foo))) copy-of-foo - (setf (aref (cadr (aref copy-of-foo 2)) 1) (cons 'MODIFIED (random 42))) + (setf (aref (cadr (aref copy-of-foo 2)) 1) (cons 'MODIFIED (random-test 42))) (equalp foo #(a b (1 #(2 4 6) 3) c))) t #'booleq) @@ -194,3 +187,5 @@ ;; (run-tests ()) ;; (run-tests t) ;; (run-tests) + +(provide 'test-unitaire) \ No newline at end of file diff --git a/util.lisp b/util.lisp index 4465fad..b164a6c 100644 --- a/util.lisp +++ b/util.lisp @@ -170,7 +170,9 @@ (apply #'append (if (symbolp (car expr)) (list (car expr)) nil) - (mapcar #'find-what-is-used (cdr expr))))) + (mapcar #'find-what-is-used-1 (cdr expr))))) (defun find-what-is-used (expr) (remove-duplicates (find-what-is-used-1 expr))) + +(provide 'util) \ No newline at end of file