www

commit 7c976ddf21b17e4bca10f7c76ca8ee91529e392e
parent 26bd8b4fb9175dd554a634c16bc3f7b1eb4e30c2
Author: Georges Dupéron <jahvascriptmaniac+github@free.fr>
Date:   Sun,  7 Nov 2010 00:02:58 +0100

Correction du dernier bug :D

Diffstat:
M
match.lisp
 | 
23
++++++++++-------------
M
test-unitaire.lisp
 | 
4
+++-
M
util.lisp
 | 
8
++++++--

3 files changed, 19 insertions(+), 16 deletions(-)
diff --git a/match.lisp b/match.lisp
@@ -382,15 +382,16 @@
                 (,result-sym (pattern-match ,pattern-sym ,expr)))
            ;; Filtrage des captures nommées nil.
            (when ,result-sym
-             (let ,(mapcar (lambda (x)
-                             `(,x (cdr (assoc ',x ,result-sym))))
-                           capture-names)
-               ;; "utilisation" des variables pour éviter les warning unused variable.
-               ,@(if body
-                     (append capture-names body)
-                     (if capture-names
-                         `((list ,@capture-names))
-                         `(t)))))))))
+             ,@(if body
+                   `((let ,(mapcar (lambda (x)
+                                     `(,x (cdr (assoc ',x ,result-sym))))
+                                   capture-names)
+                       ;; "utilisation" des variables pour éviter les warning unused variable.
+                       ,@capture-names
+                       ,@body))
+                   (if capture-names
+                       `((remove nil ,result-sym :key #'car))
+                       `(t))))))))
 
 (load "test-unitaire")
 (erase-tests match)
@@ -1107,7 +1108,3 @@
   '((foo . (lambda (labels-x labels-y) (list x y)))
     (bar . (lambda (labels-z labels-w) (print z) (print w)))
     (quux . (lambda ()))))
-
-
-
-;(run-tests match)
diff --git a/test-unitaire.lisp b/test-unitaire.lisp
@@ -80,13 +80,15 @@
   `(test-add-variable ',module
                       (list ',name (list 'copy-tree ',value))))
 
+(defvar run-tests-counter 0)
+
+(declaim (ftype function real-run-tests)) ;; récursion mutuelle real-run-tests / run-tests-submodules
 (defun run-tests-submodules (module-name submodules)
   (if (endp submodules)
       t
       (and (real-run-tests (append module-name (list (caar submodules))) (cdar submodules))
            (run-tests-submodules module-name (cdr submodules)))))
 
-(defvar run-tests-counter 0)
 (defun real-run-tests (module-name from)
   (if (second from)
       (progn
diff --git a/util.lisp b/util.lisp
@@ -35,6 +35,11 @@
       (and (consp l)
            (n-consp (- n 1) (cdr l)))))
 
+(defun propper-list-p (l)
+  (or (null l)
+         (and (consp l)
+                  (propper-list-p (cdr l)))))
+
 (defun range (a &optional b)
   (cond ((null b) (range 0 a))
         ((> a b) (loop for i from a above (- b 1) collect i))
@@ -93,4 +98,4 @@
           (mposition-t symb (cdr list) counter))
           (T
            (mposition-t symb (cdr list) (+ 1 counter)))))
-  (mposition-t symb list 0))
-\ No newline at end of file
+  (mposition-t symb list 0))