Skip to content
Snippets Groups Projects
Commit e6999217 authored by Raymond Toy's avatar Raymond Toy
Browse files

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.
parent 1ca0a557
No related branches found
No related tags found
No related merge requests found
...@@ -448,7 +448,8 @@ ...@@ -448,7 +448,8 @@
set with SETF." set with SETF."
(let ((found (and env (let ((found (and env
(cdr (assoc name (c::lexenv-functions 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) (unless (eq (cond ((c::defined-function-p found)
(c::defined-function-inlinep found)) (c::defined-function-inlinep found))
(found :notinline) (found :notinline)
......
...@@ -38,3 +38,39 @@ ...@@ -38,3 +38,39 @@
t) t)
(t () (t ()
nil)))) 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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment