[cmucl/cmucl][master] Lookup names correctly in COMPILER-MACRO-FUNCTION.

[Raymond Toy]

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)
+       , at 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/e69992175ccdcd7f895cff99752b809057c615df
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20150622/e9e696f2/attachment.html>