Regression testing macroexpansions
l...@healy.washington.dc.us
compare macroexpansions to see if they're identical, e.g. in a
regression test where an old expansion is stored in a file and a new
one is being tested. The use of gensyms and make-symbol makes this a
bit tricky. Kent Pitman posted code which I have modified. I renamed
things, using "symbol-test" instead of "test-case", and fixed a bug in
symbol-test-equal; this bug caused all uninterned (gensymed) symbols
to match each other. Also, I print out the symbol mapping between the
two forms and return the hash table as a second value. Erik Naggum
made me realize that setting *print-circle* to T is necessary before
doing the macroexpansion so that when it's read from a file, the right
symbols are identified as the same.
(setf *print-circle* t)
(defvar *symbol-test-equivalents*)
(defmacro with-symbol-test (&body forms)
`(call-with-symbol-test #'(lambda () ,@forms)))
(defparameter *print-gensym-mapping* nil)
(defun call-with-symbol-test (thunk)
(let* ((*symbol-test-equivalents* (make-hash-table))
(called (funcall thunk)))
(if *print-gensym-mapping*
(maphash (lambda (k v) (format t "~&~s -> ~s" k v))
*symbol-test-equivalents*))
(values
called
*symbol-test-equivalents*)))
(defun gensym-p (x)
(and (symbolp x)
(not (symbol-package x))))
(defun equivalent-gensym (x)
(and (gensym-p x)
(gethash x *symbol-test-equivalents*)))
(defun register-equivalent-gensym (x y)
(setf (gethash x *symbol-test-equivalents*) y))
(defun symbol-test-equal (x y)
(or (equal x y)
(let ((eqv (equivalent-gensym x)))
(if eqv
(eq eqv y)
(when (and (gensym-p x) (gensym-p y))
(register-equivalent-gensym x y)
t)))))
#|
;;; This should return T
(with-symbol-test
(tree-equal '(ZOOP #1=#:X #2=#:X #1#)
(let ((a (make-symbol "X")) (b (make-symbol "X")))
`(zoop ,a ,b ,a))
:test #'symbol-test-equal))
;;; This should return NIL
(with-symbol-test
(tree-equal '(ZOOP #1=#:X #2=#:X #1#)
(let ((a (make-symbol "X")) (b (make-symbol "X")))
`(zoop ,a ,a ,b))
:test #'symbol-test-equal))
|#