Raymond Toy pushed to branch master at cmucl / cmucl
Commits: 89074ab3 by Raymond Toy at 2015-06-24T06:50:04Z Check for function names correctly
Fix #7
The change to use extended names like (flet frob) broke the detection of local names for get-setf-expansion. Fix it. This reverts behavior back to what 18a used to do.
A test for this is also added.
- - - - -
2 changed files:
- src/code/macros.lisp - tests/issues.lisp
Changes:
===================================== src/code/macros.lisp ===================================== --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -667,7 +667,7 @@ ((and environment (let ((name (car form))) (dolist (x (c::lexenv-functions environment) nil) - (when (and (eq (car x) name) + (when (and (eq (nth-value 1 (valid-function-name-p (car x))) name) (not (c::defined-function-p (cdr x)))) (return t))))) (expand-or-get-setf-inverse form environment))
===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -73,4 +73,23 @@ (assert-prints "SQUARE compiler macro present: No.
8" - (test/present))) \ No newline at end of file + (test/present))) + +(defmacro xpop (place &environment env) + (multiple-value-bind (dummies vals new setter getter) + (get-setf-expansion place env) + `(let* (,@(mapcar #'list dummies vals) (,(car new) ,getter)) + (if ,(cdr new) (error "Can't expand this.")) + (prog1 (car ,(car new)) + (setq ,(car new) (cdr ,(car new))) + ,setter)))) + +(defsetf frob (x) (value) + `(setf (car ,x) ,value)) + +(define-test issue.7 + (:tag :issues) + (assert-error 'error + (let ((z (list 1 2))) + (flet ((frob (x) (cdr x))) + (xpop (frob z))))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/89074ab386b5ce7d2283261949...