From 34d754bdf502ed0f0aef4a289b0a18ea23dc61d1 Mon Sep 17 00:00:00 2001
From: Bertrand BRUN <bertrand.brun@me.com>
Date: Fri, 8 Oct 2010 15:25:53 +0200
Subject: [PATCH] Ajout de la parti test unitaire

---
 environnement.lisp |  5 ++---
 meval.lisp         | 37 +++++++++++++++++++++++++++++++++++++
 test-unitaire.lisp | 19 +++++++++++++++++++
 3 files changed, 58 insertions(+), 3 deletions(-)
 create mode 100755 meval.lisp
 create mode 100755 test-unitaire.lisp

diff --git a/environnement.lisp b/environnement.lisp
index 506bf9c..29fbf39 100644
--- 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
new file mode 100755
index 0000000..bd3dffc
--- /dev/null
+++ 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
new file mode 100755
index 0000000..e43c29e
--- /dev/null
+++ 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)
+