Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
2 changed files:
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)))