diff --git a/ansi-tests/define-compiler-macro.lsp b/ansi-tests/define-compiler-macro.lsp
index c27f321cd2cbe4c575b1a114412e2376ad32d927..2d9d993a7c6bc2ce7fb9664a37b5996f5247345b 100644
--- a/ansi-tests/define-compiler-macro.lsp
+++ b/ansi-tests/define-compiler-macro.lsp
@@ -86,3 +86,32 @@
 	 (declare (special *x*))
 	 (list (funcall fn 'b) *x*)))))
   t t t a (b nil))
+
+;;; Compiler macros on setf functions
+
+(deftest define-compiler-macro.4
+  (let* ((sym (gensym))
+	 (fun-def-form `(defun ,sym (x) (car x)))
+	 (setf-fun-def-form `(defun (setf ,sym) (newval x) (setf (car x) newval)))
+	 (setf-compiler-macro-def-form
+	  `(define-compiler-macro (setf ,sym) (newval x)
+	     (declare (special *x*))
+	     (setf *x* t)
+	     (return-from ,sym `(setf (car ,x) ,newval)))))
+    (values
+     (equalt (list sym) (multiple-value-list (eval fun-def-form)))
+     (equalt `((setf ,sym)) (multiple-value-list (eval setf-fun-def-form)))
+     (equalt `((setf ,sym)) (multiple-value-list (eval setf-compiler-macro-def-form)))
+     (notnot (typep (compiler-macro-function `(setf ,sym)) 'function))
+     (eval `(,sym (list 'a 'b)))
+     (eval `(let ((arg (list 1 2)))
+	      (list (setf (,sym arg) 'z) arg)))
+     (let ((fn (compile nil `(lambda (u v) (setf (,sym u) v)))))
+       (let ((*x* nil)
+	     (arg (list 1 2)))
+	 (declare (special *x*))
+	 (list (funcall fn arg 'y) arg)))))
+  t t t t a (z (z 2)) (y (y 2)))
+
+
+     
\ No newline at end of file