From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 16 Oct 2010 10:06:18 +0000 (+0000)
Subject: 1.0.43.63: storing function documentation under names as well
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ce2a580a469d285e7054ada13ef456e3dad08a34;p=sbcl.git

1.0.43.63: storing function documentation under names as well

 Since 1.0.29.24 we have stored function documentation exclusively in
 the function objects. Turns out this isn't a pure win:

   (setf (symbol-function 'foo) #'car)

   (setf (documentation 'foo 'function) "Return the name of frobniz.")

 should not change the docstring of #'CAR.

 So, when setting the docstring of a function name, store it in
 RANDOM-DOCUMENTATION instead of in the simple-fun.

 Conversely, when looking up the docstring for a function name, first
 look in RANDOM-DOCUMENTATION and only then in the bound function.
---

diff --git a/NEWS b/NEWS
index 7d7c01f..b38b0a4 100644
--- a/NEWS
+++ b/NEWS
@@ -72,6 +72,8 @@ changes relative to sbcl-1.0.43:
     (lp#655824, thanks to Roman Marynchak)
   * bug fix: (SETF MACRO-FUNCTION) clobbered macro-definitions before
     package-lock violation was detected. (lp#660752)
+  * bug fix: the system can store different docstrings for a single function
+    under different names. (lp#661631, regression from 1.0.29.24)
 
 changes in sbcl-1.0.43 relative to sbcl-1.0.42:
   * incompatible change: FD-STREAMS no longer participate in the serve-event
diff --git a/src/pcl/documentation.lisp b/src/pcl/documentation.lisp
index 7bc2e58..a625221 100644
--- a/src/pcl/documentation.lisp
+++ b/src/pcl/documentation.lisp
@@ -25,17 +25,22 @@
 (defmethod documentation ((x function) (doc-type (eql 'function)))
   (fun-doc x))
 
-(defmethod documentation ((x list) (doc-type (eql 'function)))
-  (when (and (legal-fun-name-p x) (fboundp x))
-    (fun-doc (fdefinition x))))
-
 (defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
     (documentation it t)))
 
+(defmethod documentation ((x list) (doc-type (eql 'function)))
+  (when (legal-fun-name-p x)
+    (or (random-documentation x 'function)
+        (when (fboundp x)
+          (fun-doc (fdefinition x))))))
+
 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
-  (when (and (legal-fun-name-p x) (fboundp x))
-    (fun-doc (or (macro-function x) (fdefinition x)))))
+  (when (legal-fun-name-p x)
+    (or (random-documentation x 'function)
+        ;; Nothing under the name, check the function object.
+        (when (fboundp x)
+          (fun-doc (or (macro-function x) (fdefinition x)))))))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
@@ -54,17 +59,16 @@
   (setf (fun-doc x) new-value))
 
 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
-  (when (and (legal-fun-name-p x) (fboundp x))
-    (setf (documentation (fdefinition x) t) new-value)))
+  (when (legal-fun-name-p x)
+    (setf (random-documentation x 'function) new-value)))
 
 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
     (setf (documentation it t) new-value)))
 
 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
-  (when (and (legal-fun-name-p x) (fboundp x))
-    (setf (documentation (or (macro-function x) (symbol-function x)) t)
-          new-value)))
+  (when (legal-fun-name-p x)
+    (setf (random-documentation x 'function) new-value)))
 
 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'compiler-macro)))
   (awhen (compiler-macro-function x)
@@ -235,6 +239,22 @@
 ;;; set the documentation for the machinery for setting documentation.
 #+sb-doc
 (setf (documentation 'documentation 'function)
-      "Return the documentation string of Doc-Type for X, or NIL if
-  none exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE,
-  SETF, and T.")
+      "Return the documentation string of Doc-Type for X, or NIL if none
+exists. System doc-types are VARIABLE, FUNCTION, STRUCTURE, TYPE, SETF, and T.
+
+Function documentation is stored separately for function names and objects:
+DEFUN, LAMBDA, &co create function objects with the specified documentation
+strings.
+
+ \(SETF (DOCUMENTATION NAME 'FUNCTION) STRING)
+
+sets the documentation string stored under the specified name, and
+
+ \(SETF (DOCUMENTATION FUNC T) STRING)
+
+sets the documentation string stored in the function object.
+
+ \(DOCUMENTATION NAME 'FUNCTION)
+
+returns the documentation stored under the function name if any, and
+falls back on the documentation in the function object if necessary.")
diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp
index 3837060..cbb9ae3 100644
--- a/tests/interface.impure.lisp
+++ b/tests/interface.impure.lisp
@@ -232,7 +232,12 @@
   (assert (string= (documentation #'docfoo t) "bar"))
   (assert (string= (setf (documentation 'docfoo 'function) "baz") "baz"))
   (assert (string= (documentation 'docfoo 'function) "baz"))
-  (assert (string= (documentation #'docfoo t) "baz")))
+  (assert (string= (documentation #'docfoo t) "bar"))
+  (assert (string= (setf (documentation #'docfoo t) "zot") "zot"))
+  (assert (string= (documentation #'docfoo t) "zot"))
+  (assert (string= (documentation 'docfoo 'function) "baz"))
+  (assert (not (setf (documentation 'docfoo 'function) nil)))
+  (assert (string= (documentation 'docfoo 'function) "zot")))
 
 #+sb-doc
 (with-test (:name (documentation built-in-macro))
diff --git a/version.lisp-expr b/version.lisp-expr
index 148ae33..f184272 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.43.62"
+"1.0.43.63"