[cmucl/cmucl][master] Fix issue #1. Handle funcall in compiler macro functions.

Raymond Toy rtoy at common-lisp.net
Sat Apr 25 16:15:16 UTC 2015


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/c961673a4b7bdceeff80cd5ca5739746333aee3f
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20150425/cab9a836/attachment.html>


More information about the cmucl-cvs mailing list