614 |
|
|
615 |
;;; Defining new methods for DOCUMENTATION |
;;; Defining new methods for DOCUMENTATION |
616 |
|
|
617 |
(defgeneric documentation-test-class-1-doc-accessor (obj)) |
(ignore-errors |
618 |
(defgeneric (setf documentation-test-class-1-doc-accessor) (newdoc obj)) |
(defgeneric documentation-test-class-1-doc-accessor (obj)) |
619 |
|
(defgeneric (setf documentation-test-class-1-doc-accessor) (newdoc obj)) |
620 |
|
|
621 |
(defclass documentation-test-class-1 () ((my-doc :accessor documentation-test-class-1-doc-accessor |
(defclass documentation-test-class-1 () ((my-doc :accessor documentation-test-class-1-doc-accessor |
622 |
:type (or null string) |
:type (or null string) |
623 |
:initform nil))) |
:initform nil))) |
624 |
|
|
625 |
(defmethod documentation-test-class-1-doc-accessor ((obj documentation-test-class-1) ) |
(defmethod documentation-test-class-1-doc-accessor ((obj documentation-test-class-1) ) |
626 |
(slot-value obj 'my-doc)) |
(slot-value obj 'my-doc)) |
627 |
(defmethod (setf documentation-test-class-1-doc-accessor) ((newdoc string) (obj documentation-test-class-1)) |
(defmethod (setf documentation-test-class-1-doc-accessor) ((newdoc string) (obj documentation-test-class-1)) |
628 |
(setf (slot-value obj 'my-doc) newdoc)) |
(setf (slot-value obj 'my-doc) newdoc)) |
629 |
|
|
630 |
(defmethod documentation ((obj documentation-test-class-1) (doctype (eql t))) |
(defmethod documentation ((obj documentation-test-class-1) (doctype (eql t))) |
631 |
(documentation-test-class-1-doc-accessor obj)) |
(documentation-test-class-1-doc-accessor obj)) |
632 |
|
|
633 |
(defmethod (setf documentation) ((newdoc string) (obj documentation-test-class-1) (doctype (eql t))) |
(defmethod (setf documentation) ((newdoc string) (obj documentation-test-class-1) (doctype (eql t))) |
634 |
(setf (documentation-test-class-1-doc-accessor obj) newdoc)) |
(setf (documentation-test-class-1-doc-accessor obj) newdoc))) |
635 |
|
|
636 |
(deftest documentation.new-method.1 |
(deftest documentation.new-method.1 |
637 |
(let ((obj (make-instance 'documentation-test-class-1))) |
(let ((obj (make-instance 'documentation-test-class-1))) |