Raymond Toy pushed to branch master at cmucl / cmucl
Commits: e6999217 by Raymond Toy at 2015-06-22T23:08:08Z Lookup names correctly in COMPILER-MACRO-FUNCTION.
Fix #3.
The lookup for the names was not handling things like (FLET SQUARE TEST/PRESENT) correctly. Use VALID-FUNCTION-NAME to get the function name instead of a plain EQUAL test.
- - - - -
2 changed files:
- src/code/eval.lisp - tests/issues.lisp
Changes:
===================================== src/code/eval.lisp ===================================== --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -448,7 +448,8 @@ set with SETF." (let ((found (and env (cdr (assoc name (c::lexenv-functions env) - :test #'equal))))) + :key #'(lambda (e) + (nth-value 1 (valid-function-name-p e)))))))) (unless (eq (cond ((c::defined-function-p found) (c::defined-function-inlinep found)) (found :notinline)
===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -38,3 +38,39 @@ t) (t () nil)))) + +;; Functions for testing issue-3 +(defun sqr (x) + (expt x 2)) + +(define-compiler-macro sqr (x) + `(expt ,x 2)) + +(eval-when (:compile-toplevel :load-toplevel :execute) +(defmacro with-square-check (&body body &environment env) + (let ((text (if (compiler-macro-function 'sqr env) + "Yes" + "No"))) + `(progn + (format t "SQUARE compiler macro present: ~A.~%" ,text) + ,@body)))) + + +(defun test/absent () + (with-square-check + (sqr 2))) + +(defun test/present () + (flet ((sqr (x) + (print (expt x 3)))) + (with-square-check + (sqr 2)))) + +(define-test issue.3 + (:tag :issues) + (assert-prints "SQUARE compiler macro present: Yes." + (test/absent)) + (assert-prints "SQUARE compiler macro present: No. + +8" + (test/present))) \ No newline at end of file
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e69992175ccdcd7f895cff9975...