Raymond Toy pushed to branch master at cmucl / cmucl

Commits: c961673a by Raymond Toy at 2015-04-25T09:15:02Z Fix issue #1. Handle funcall in compiler macro functions.

Also added tests/issues.lisp with a corresponding test.

- - - - -

2 changed files:

- src/code/defmacro.lisp - + tests/issues.lisp

Changes:

===================================== src/code/defmacro.lisp ===================================== --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -151,7 +151,12 @@ (not (and (listp ,arg-list-name) (eq 'funcall (car ,arg-list-name))))) `(progn - (setf ,arg-list-name (cdr ,arg-list-name))))) + (setf ,arg-list-name + ;; Handle the case (funcall #'foo args) + (if (consp (second ,arg-list-name)) + (list* (second (second ,arg-list-name)) + (cddr ,arg-list-name)) + (cdr ,arg-list-name)))))) (push-let-binding (car rest-of-args) arg-list-name nil)) ((and (cdr rest-of-args) (consp (cadr rest-of-args))) (pop rest-of-args)

===================================== tests/issues.lisp ===================================== --- /dev/null +++ b/tests/issues.lisp @@ -0,0 +1,25 @@ +;;; Tests from gitlab issues + +(defpackage :issues-tests + (:use :cl :lisp-unit)) + +(in-package "ISSUES-TESTS") + +(defun square (x) + (expt x 2)) + +(define-compiler-macro square (&whole form arg) + (declare (ignore arg)) + form) + +(define-test issue.1.a + (:tag :issues) + (assert-equal + '(square x) + (funcall (compiler-macro-function 'square) '(square x) nil))) + +(define-test issue.1.b + (:tag :issues) + (assert-equal + '(square x) + (funcall (compiler-macro-function 'square) '(funcall #'square x) nil)))

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/c961673a4b7bdceeff80cd5ca5...