From 43d869ffe24e0bd1659de2cef173e3040fab32b6 Mon Sep 17 00:00:00 2001 From: "Thomas M. Hermann" Date: Fri, 8 Feb 2013 14:56:29 -0600 Subject: [PATCH] Correct the macro expansion assertion to number GENSYMS from 1. Improve the comparison of the expanded forms. --- internal-test/example-tests.lisp | 15 +++++++++++++++ lisp-unit.lisp | 34 +++++++++++++++++++++++++++------- 2 files changed, 42 insertions(+), 7 deletions(-) diff --git a/internal-test/example-tests.lisp b/internal-test/example-tests.lisp index 448c1f4..6312be0 100644 --- a/internal-test/example-tests.lisp +++ b/internal-test/example-tests.lisp @@ -57,6 +57,21 @@ (dotimes (i 5) (assert-equal i (my-sqrt (* i i)) i))) +;;; Macro + +(defmacro my-macro (arg1 arg2) + (let ((g1 (gensym)) + (g2 (gensym))) + `(let ((,g1 ,arg1) + (,g2 ,arg2)) + "Start" + (+ ,g1 ,g2 3)))) + +(define-test test-macro + (assert-expands + (let ((#:G1 A) (#:G2 B)) "Start" (+ #:G1 #:G2 3)) + (my-macro a b))) + ;;; Tags (defun add-integer (integer1 integer2) diff --git a/lisp-unit.lisp b/lisp-unit.lisp index 45c1116..3f99e51 100644 --- a/lisp-unit.lisp +++ b/lisp-unit.lisp @@ -332,7 +332,7 @@ assertion.") "Assert whether form expands to expansion." `(expand-assert :macro ,form (expand-macro-form ,form nil) - ,expansion ,extras)) + ',expansion ,extras)) (defmacro assert-false (form &rest extras) "Assert whether the form is false." @@ -375,7 +375,8 @@ assertion.") (defmacro expand-macro-form (form env) "Expand the macro form once." - `(macroexpand-1 ',form ,env)) + `(let ((*gensym-counter* 1)) + (macroexpand-1 ',form ,env))) (defmacro expand-extras (extras) "Expand extra forms." @@ -433,11 +434,28 @@ assertion.") (:documentation "Result of a failed macro expansion assertion.")) -;;; FIXME: Review the internal tests for macros. +(defun %expansion-equal (form1 form2) + "Descend into the forms checking for equality." + (let ((item1 (first form1)) + (item2 (first form2))) + (cond + ((and (null item1) (null item2))) + ((and (listp item1) (listp item2)) + (and + (%expansion-equal item1 item2) + (%expansion-equal (rest form1) (rest form2)))) + ((and (symbolp item1) (symbolp item2)) + (and + (string= (symbol-name item1) (symbol-name item2)) + (%expansion-equal (rest form1) (rest form2)))) + (t (and + (equal item1 item2) + (%expansion-equal (rest form1) (rest form2))))))) + (defun macro-result (test expected actual) "Return the result of a macro assertion." (declare (ignore test)) - (equal (car actual) (car expected))) + (%expansion-equal (first expected) (first actual))) (defclass boolean-result (failure-result) () @@ -517,9 +535,11 @@ assertion.") (exerr :initarg :exerr :reader exerr) - (run-time :initarg :run-time - :reader run-time - :documentation "run time measured in internal time units")) + (run-time + :initarg :run-time + :reader run-time + :documentation + "Test run time measured in internal time units")) (:default-initargs :exerr nil) (:documentation "Store the results of the unit test.")) -- 2.11.4.GIT