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)))