From fd8efd6e53412bb30ece02cf36e2b3ba752ed262 Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Sun, 10 Aug 2014 23:32:47 +0200
Subject: [PATCH] Add WITH-TEST, improve test for DOCUMENTATION on (SETF ...)

---
 tests/interface.impure.lisp | 50 ++++++++++++++++++++++++++++++++-------------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index bef91c2f2..f9e479d53 100644
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -16,19 +16,6 @@
 (use-package "ASSERTOID")
 (use-package "TEST-UTIL")
 
-(defun (setf foo) (x)
-  "(setf foo) documentation"
-  x)
-
-(assert (string= (documentation '(setf foo) 'function)
-                 "(setf foo) documentation"))
-(assert (string= (documentation #'(setf foo) 'function)
-                 "(setf foo) documentation"))
-
-(assert (string= (documentation '(setf foo) 'function)
-                 "(setf foo) documentation"))
-(assert (string= (documentation #'(setf foo) 'function)
-                 "(setf foo) documentation"))
 
 (with-test (:name :disassemble)
 ;;; DISASSEMBLE shouldn't fail on closures or unpurified functions
@@ -143,7 +130,13 @@
 ;;; Tests of documentation on types and classes
 
 (defun assert-documentation (thing doc-type expected)
-  (assert (equal (documentation thing doc-type) expected)))
+  ;; This helper function makes ASSERT errors print THING, DOC-TYPE,
+  ;; the return value of DOCUMENTATION and EXPECTED.
+  (flet ((assert-documentation-helper (thing doc-type documentation expected)
+           (declare (ignore thing doc-type))
+           (equal documentation expected)))
+    (assert (assert-documentation-helper
+             thing doc-type (documentation thing doc-type) expected))))
 
 (defclass foo ()
   ()
@@ -226,6 +219,35 @@
   (assert-documentation 'cmacro 'compiler-macro "compiler macro")
   (assert-documentation '(setf cmacro) 'compiler-macro "setf compiler macro"))
 
+(defun (setf documentation.setf) (x)
+  "(setf foo) documentation"
+  x)
+
+(with-test (:name (documentation function setf))
+  (flet ((expect (documentation)
+           (assert-documentation
+            '(setf documentation.setf) 'function documentation)
+           (assert-documentation
+            #'(setf documentation.setf) 'function documentation)
+           (assert-documentation
+            #'(setf documentation.setf) t documentation)))
+    (expect "(setf foo) documentation")
+    ;; The original test checked this twice. No idea why.
+    (expect "(setf foo) documentation")
+
+    ;; Modification
+    (setf (documentation '(setf documentation.setf) 'function)
+          "(setf bar) documentation")
+    (expect "(setf bar) documentation")
+
+    (setf (documentation #'(setf documentation.setf) 'function)
+          "(setf baz) documentation")
+    (expect "(setf baz) documentation")
+
+    (setf (documentation #'(setf documentation.setf) t)
+          "(setf fez) documentation")
+    (expect "(setf fez) documentation")))
+
 (with-test (:name (documentation lambda))
   (let ((f (lambda () "aos the zos" t))
         (g (sb-int:named-lambda fii () "zoot the fruit" t)))
-- 
2.11.4.GIT