From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 22 Jun 2009 08:05:46 +0000 (+0000)
Subject: 1.0.29.30: oops, get documentation for built-in macros right
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c8eb86a40a6542b978ef34299ac5ab2601163ff4;p=sbcl.git

1.0.29.30: oops, get documentation for built-in macros right

* Reported by Harald Hanche-Olsen.
---

diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp
index 0f43bd6..39ec97c 100644
--- a/src/code/defmacro.lisp
+++ b/src/code/defmacro.lisp
@@ -91,11 +91,9 @@
                     ;; and comparing it with the new one.
                     (style-warn "redefining ~S in DEFMACRO" name))
             (setf (sb!xc:macro-function name) definition)
-            #-sb-xc-host
-            (when doc
-              (setf (%fun-doc definition) doc))
             ,(when set-p
-                   `(setf (%fun-lambda-list definition) lambda-list
+                   `(setf (%fun-doc definition) doc
+                          (%fun-lambda-list definition) lambda-list
                           (%fun-name definition) debug-name))
             name))))
   (progn
diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 71d7bad..731d81f 100644
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -152,10 +152,9 @@ invoked. In that case it will store into PLACE and start over."
              ;; FIXME: warn about incompatible lambda list with
              ;; respect to parent function?
              (setf (sb!xc:compiler-macro-function name) definition)
-             #-sb-xc-host
-             (setf (%fun-doc definition) doc)
              ,(when set-p
-                    `(setf (%fun-lambda-list definition) lambda-list
+                    `(setf (%fun-doc definition) doc
+                           (%fun-lambda-list definition) lambda-list
                            (%fun-name definition) debug-name))
              name))))
   (progn
diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index 386441a..e67f1a2 100644
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -226,11 +226,13 @@ return NIL. Can be set with SETF when ENV is NIL."
     (variable
      (typecase x
        (symbol (values (info :variable :documentation x)))))
+    ;; FUNCTION is not used at the momemnt, just here for symmetry.
     (function
      (cond ((functionp x)
             (%fun-doc x))
-           ((legal-fun-name-p x)
-            (%fun-doc (fdefinition x)))))
+           ((and (legal-fun-name-p x) (fboundp x))
+            (%fun-doc (or (and (symbolp x) (macro-function x))
+                          (fdefinition x))))))
     (structure
      (typecase x
        (symbol (cond
diff --git a/src/pcl/documentation.lisp b/src/pcl/documentation.lisp
index b06a53c..e1b7b56 100644
--- a/src/pcl/documentation.lisp
+++ b/src/pcl/documentation.lisp
@@ -27,15 +27,15 @@
 
 (defmethod documentation ((x list) (doc-type (eql 'function)))
   (when (and (legal-fun-name-p x) (fboundp x))
-    (documentation (fdefinition x) t)))
+    (fun-doc (fdefinition x))))
 
 (defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
     (documentation it t)))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
-  (when (fboundp x)
-    (documentation (symbol-function x) t)))
+  (when (and (legal-fun-name-p x) (fboundp x))
+    (fun-doc (or (macro-function x) (fdefinition x)))))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index 785edcd..cdec390 100644
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -231,5 +231,13 @@
   (assert (string= (setf (documentation 'docfoo 'function) "baz") "baz"))
   (assert (string= (documentation 'docfoo 'function) "baz"))
   (assert (string= (documentation #'docfoo t) "baz")))
+
+#+sb-doc
+(with-test (:name (documentation built-in-macro))
+  (assert (documentation 'trace 'function)))
+
+#+sb-doc
+(with-test (:name (documentation built-in-function))
+  (assert (documentation 'cons 'function)))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 1e89aa4..19133e5 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.29.29"
+"1.0.29.30"