commit 34d754bdf502ed0f0aef4a289b0a18ea23dc61d1
parent 9202c25cb07aec0982d3a83854a47c46175bd3b0
Author: Bertrand BRUN <bertrand.brun@me.com>
Date: Fri, 8 Oct 2010 15:25:53 +0200
Ajout de la parti test unitaire
Diffstat:
3 files changed, 59 insertions(+), 3 deletions(-)
diff --git a/environnement.lisp b/environnement.lisp
@@ -14,8 +14,8 @@
;; répercute sur la valeur accédée par l'autre.
;; - Lorsqu'on définit une fonction, il faut mettre juste après la
;; liste des paramètres une chaîne de caractères qui documente la
-;; fonction (une docstring). http://en.wikipedia.org/wiki/Docstring
-
+;; fonction (une docstring).
+;; - L'environnement top-level est partage par tous le monde
;; Exemple de la structure env-stack après création de deux
;; environnements en plus du top-level et ajout de plusieurs laisons.
@@ -94,4 +94,3 @@ l'environnement top-level."
(3 (add-binding (add-binding (push-new-env (empty-env-stack)) 'x 42) 'y 56))
))
-(test-env 0)
diff --git a/meval.lisp b/meval.lisp
@@ -0,0 +1,37 @@
+;; meval donnee en cours
+
+(defun meval (expr env)
+ (cond ((and (atom expr) (constantp expr)) expr) ;; Literal
+ ((atom expr) ;; symboles
+ (let ((cell (assoc expr env)))
+ (if cell (cdr cell)
+ (error ""))))
+ ;; .
+ ;; .
+ ;; .
+ ((eq 'quote (car expr)) (cadr expr)) ;;Quote (' ou quote)
+ ((and (consp (car expr)) (eq 'lambda (caar expr)))
+ (meval-lambda (car expr) (cdr expr) env env)) ;; TODO : a remplir
+ ((eq 'defun (car expr))
+ (set-defun (cadr expr) (cons 'lambda (cddr expr))) ;; TODO : sera remplacer par add-top-level-binding
+ (get-defun (car expr))
+ (meval-lambda (get-defun (car expr)) (cdr expr) env ()))
+ ((eq 'if (car expr))
+ (if (meval (second expr) env)
+ (meval (third expr) env)
+ (meval (fourth expr) env)))
+ ;;cas des marcros/forme speciale deja traiter
+ ((fboundp (car expr)) ;;denier cas vrais fonctin globale predefinie
+ (apply (car expr) (map-meval (cdr expr) env))
+ )
+ ))
+
+(defun map-meval (list env)
+ (mapcar (lambda (x) (meval x env)) list))
+
+(defun meval-lambda (lbd args env-args old-env)
+ (meval (third (car lbd))
+ (make-env (second (car lbd))
+ (map-meval args env-args)
+ old-env))
+)
+\ No newline at end of file
diff --git a/test-unitaire.lisp b/test-unitaire.lisp
@@ -0,0 +1,19 @@
+(let ((tests nil))
+ (defmacro deftest (module expected test)
+ (setf tests (cons (list module expected test) tests))
+ nil)
+ (defmacro run-test (module)
+ (mapcar (lambda (test)
+ (let ((res (eval (third test))))
+ (if (equal (second test) res)
+ (print "[SUCCESS] ~a" (third test))
+ (print "[FAILURE] ~a\n got ~a\n expected ~a" (third test) res (second test)))))
+ tests) nil)
+ (defun show-test ()
+ tests))
+
+;; Test de debugage du test unitaire
+(deftest environnement nil nil)
+(show-test)
+(run-test environnement)
+
