Signal a style-warning instead when trying to set documentation of NIL
for all other documentation types (except TYPE).
Reported by Zach Beane. Regression since
2e52fa05.
anymore. (Minimal test case provided by James M. Lawrence on sbcl-devel)
* bug fix: no more bogus ## references when pretty printing backquoted
forms with non-trivial structure sharing. (lp#1161218)
anymore. (Minimal test case provided by James M. Lawrence on sbcl-devel)
* bug fix: no more bogus ## references when pretty printing backquoted
forms with non-trivial structure sharing. (lp#1161218)
+ * bug fix: Don't signal an error on (setf (documentation nil 'function) "doc").
+ Signal a style-warning instead when trying to set documentation of NIL
+ for all other documentation types.
+ Reported by Zach Beane. Regression since 2e52fa05.
changes in sbcl-1.1.6 relative to sbcl-1.1.5:
changes in sbcl-1.1.6 relative to sbcl-1.1.5:
- * enhancement: the continuable error when defknown-ing over extant
+ * enhancement: the continuable error when defknown-ing over extant
fndb entries can be ignored by passing :overwrite-fndb-silently t
as a keyword argument to sb-c:defknown (after attributes). Useful
to allow defknown to be re-loaded. Use with :allow-other-keys t
fndb entries can be ignored by passing :overwrite-fndb-silently t
as a keyword argument to sb-c:defknown (after attributes). Useful
to allow defknown to be re-loaded. Use with :allow-other-keys t
(t
(fun-name (fdefinition name)))))
(t
(fun-name (fdefinition name)))))
+(defun ignore-nil-doc (type)
+ (style-warn "Ignoring documentation of type ~a for ~a."
+ type nil))
+
(defun set-function-name-documentation (name documentation)
(defun set-function-name-documentation (name documentation)
- (cond ((not (legal-fun-name-p name))
+ (cond ((not name)
+ (ignore-nil-doc 'function))
+ ((not (legal-fun-name-p name))
nil)
((not (equal (real-function-name name) name))
(setf (random-documentation name 'function) documentation))
nil)
((not (equal (real-function-name name) name))
(setf (random-documentation name 'function) documentation))
(setf (fun-doc (or (and (symbolp name)
(macro-function name))
(fdefinition name)))
(setf (fun-doc (or (and (symbolp name)
(macro-function name))
(fdefinition name)))
+ documentation)))
+ documentation)
;;; functions, macros, and special forms
(defmethod documentation ((x function) (doc-type (eql 't)))
;;; functions, macros, and special forms
(defmethod documentation ((x function) (doc-type (eql 't)))
(set-function-name-documentation x new-value))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'compiler-macro)))
(set-function-name-documentation x new-value))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'compiler-macro)))
- (awhen (compiler-macro-function x)
- (setf (documentation it t) new-value)))
+ (cond (x
+ (awhen (compiler-macro-function x)
+ (setf (documentation it t) new-value)))
+ (t
+ (ignore-nil-doc 'compiler-macro)
+ new-value)))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
- (setf (fdocumentation x 'setf) new-value))
+ (cond (x
+ (setf (fdocumentation x 'setf) new-value))
+ (t
+ (ignore-nil-doc 'setf)
+ new-value)))
\f
;;; method combinations
(defmethod documentation ((x method-combination) (doc-type (eql 't)))
\f
;;; method combinations
(defmethod documentation ((x method-combination) (doc-type (eql 't)))
(defmethod (setf documentation)
(new-value (x symbol) (doc-type (eql 'method-combination)))
(defmethod (setf documentation)
(new-value (x symbol) (doc-type (eql 'method-combination)))
- (setf (random-documentation x 'method-combination) new-value))
+ (cond (x
+ (setf (random-documentation x 'method-combination) new-value))
+ (t
+ (ignore-nil-doc 'method-combination)
+ new-value)))
\f
;;; methods
(defmethod documentation ((x standard-method) (doc-type (eql 't)))
\f
;;; methods
(defmethod documentation ((x standard-method) (doc-type (eql 't)))
(defmethod (setf documentation) (new-value
(x symbol)
(doc-type (eql 'structure)))
(defmethod (setf documentation) (new-value
(x symbol)
(doc-type (eql 'structure)))
- (setf (fdocumentation x 'structure) new-value))
+ (cond (x
+ (setf (fdocumentation x 'structure) new-value))
+ (t
+ (ignore-nil-doc 'structure)
+ new-value)))
\f
;;; variables
(defmethod documentation ((x symbol) (doc-type (eql 'variable)))
\f
;;; variables
(defmethod documentation ((x symbol) (doc-type (eql 'variable)))
(defmethod (setf documentation) (new-value
(x symbol)
(doc-type (eql 'variable)))
(defmethod (setf documentation) (new-value
(x symbol)
(doc-type (eql 'variable)))
- (setf (fdocumentation x 'variable) new-value))
+ (cond (x
+ (setf (fdocumentation x 'variable) new-value))
+ (t
+ (ignore-nil-doc 'variable)
+ new-value)))
\f
;;; default if DOC-TYPE doesn't match one of the specified types
(defmethod documentation (object doc-type)
\f
;;; default if DOC-TYPE doesn't match one of the specified types
(defmethod documentation (object doc-type)
(equal (documentation 'test 'function)
(documentation 'test2 'function)))))
(equal (documentation 'test 'function)
(documentation 'test2 'function)))))
+(with-test (:name :setf-documentation-on-nil)
+ (assert
+ (handler-case
+ (assert (equal (setf (documentation nil 'function) "foo") "foo"))
+ (style-warning () t)
+ (:no-error (x)
+ (declare (ignore x))
+ nil))))
+