commit cab12e533a6a6fbebe999608a7a7f7de51efa4a7
parent 138946826221f54504339f580c5906354eb9e5ac
Author: Georges Dupéron <jahvascriptmaniac+github@free.fr>
Date: Fri, 19 Nov 2010 22:54:31 +0100
Utilisation de (require), correction d'un bug dans test-unitaire, 589 tests passed sucessfully. \o/
Diffstat:
11 files changed, 94 insertions(+), 67 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1,4 +1,4 @@
-(load "util") ;; n-consp
+(require 'util "util") ;; n-consp
;; Syntaxe : (match <motif> 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
@@ -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
@@ -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
@@ -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
