From 3fb8c995a3cb6541bda5c587f6201b3f2c54e38d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Le=20Barbier?=
 <michael.le-barbier@melusina.org>
Date: Mon, 15 Apr 2024 08:54:26 +0200
Subject: [PATCH] Correctly handle FLET and dotted lists in DEFINE-TESTCASE

---
 src/testcase.lisp       | 15 ++++++++-------
 testsuite/testcase.lisp | 21 +++++++++++++++++----
 2 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/src/testcase.lisp b/src/testcase.lisp
index a311eb2..998cbc6 100644
--- a/src/testcase.lisp
+++ b/src/testcase.lisp
@@ -455,9 +455,9 @@ guarantees that conditions triggered by the evaluation of arguments are recorded
 	 (cond
 	   ((symbolp form)
 	    form)
-	   ((and (listp form) (eq (first form) 'quote))
+	   ((and (listp form) (eq (first form) 'quote) (eq 2 (length form)))
 	    (second form))
-	   ((and (listp form) (eq (first form) 'function))
+	   ((and (listp form) (eq (first form) 'function) (eq 2 (length form)))
 	    (second form))))
        (is-funcall-p (form)
 	 "Predicate recognising forms which are function calls.
@@ -480,15 +480,16 @@ symbol of this function."
 	      :org.melusina.confidence/assertion))
        (wrap-assertion-forms (form)
          (cond
+	   ((atom form)
+	    form)
 	   ((eq 'without-confidence (is-funcall-p form))
 	    `(progn ,@(rest form)))
 	   ((is-assert-form-p form)
             `(instrument-assertion ,form))
-           ((is-funcall-p form)
-            (cons (first form) (mapcar #'wrap-assertion-forms (rest form))))
-           (t
-	    form))))
-    (mapcar #'wrap-assertion-forms body-forms)))
+           ((consp form)
+	    (cons (wrap-assertion-forms (car form))
+		  (wrap-assertion-forms (cdr form)))))))
+    (wrap-assertion-forms body-forms)))
 
 (defun testcase-outcome-pathname (outcome)
   "The pathname used to write OUTCOME description."
diff --git a/testsuite/testcase.lisp b/testsuite/testcase.lisp
index b1bd531..27dca8e 100644
--- a/testsuite/testcase.lisp
+++ b/testsuite/testcase.lisp
@@ -82,12 +82,24 @@
 
 (define-testcase perform-many-assertions-wrapped-with-flet (&key success failure condition)
   (flet ((wrapper ()
-	   (perform-many-assertions 
-	    :success success
-	    :failure failure
-	    :condition condition)))
+	   (when success
+	     (dotimes (_ success)
+	       (assert-t t)))
+	   (when failure
+	     (dotimes (_ failure)
+	       (assert-t nil)))
+	   (when condition
+	     (dotimes (_ condition)
+	       (assert-t (error "An error condition was signalled."))))))
     (wrapper)))
 
+(define-testcase ensure-that-define-testcase-handles-dotted-lists ()
+  (assert-t
+   (listp
+    (macroexpand-1
+     '(define-testcase example ()
+       (loop :for (a . b) :in '((1 . 1) (2 . 2)) :do (assert-equal a b)))))))
+
 (define-testcase ensure-that-testcase-is-reported-when-wrapped-in-flet ()
   (with-testcase-outcome testcase-outcome
       (perform-many-assertions-wrapped-with-flet :success 100 :failure 10 :condition 1)
@@ -101,6 +113,7 @@
   (validate-define-testcase)
   (ensure-that-define-testcase-recognises-sharpsign-single-quote-in-function-names)
   (ensure-that-testcase-is-reported-when-wrapped-in-flet)
+  (ensure-that-define-testcase-handles-dotted-lists)
   (validate-supervise-assertion))
 
 ;;;; End of file `testcase.lisp'