documentation.lsp 20.5 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Dec 14 07:30:01 2004
;;;; Contains: Tests of DOCUMENTATION

(in-package :cl-test)

8 9 10
;;; documentation (x function) (doc-type (eql 't))

(deftest documentation.function.t.1
pfdietz's avatar
pfdietz committed
11 12 13 14 15
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (documentation (symbol-function sym) t))
  nil)

16
(deftest documentation.function.t.2
pfdietz's avatar
pfdietz committed
17 18 19
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (let ((fn (symbol-function sym))
sds's avatar
sds committed
20
          (doc "FOO1"))
21 22 23
      (multiple-value-prog1
       (setf (documentation fn t) (copy-seq doc))
       (assert (or (null (documentation fn t))
sds's avatar
sds committed
24
                   (equal doc (documentation fn t)))))))
25 26 27 28 29 30 31 32 33 34 35 36
  "FOO1")

(deftest documentation.function.t.3
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
    (documentation (macro-function sym) t))
  nil)

(deftest documentation.function.t.4
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
    (let ((fn (macro-function sym))
sds's avatar
sds committed
37
          (doc "FOO2"))
pfdietz's avatar
pfdietz committed
38
      (multiple-value-prog1
39
       (setf (documentation fn t) (copy-seq doc))
pfdietz's avatar
pfdietz committed
40
       (assert (or (null (documentation fn t))
sds's avatar
sds committed
41
                   (equal doc (documentation fn t)))))))
42 43 44 45
  "FOO2")

(deftest documentation.function.t.6
  (let* ((sym (gensym))
sds's avatar
sds committed
46 47
         (fn (eval `#'(lambda () ',sym)))
         (doc "FOO3"))
48 49 50
    (multiple-value-prog1
       (setf (documentation fn t) (copy-seq doc))
       (assert (or (null (documentation fn t))
sds's avatar
sds committed
51
                   (equal doc (documentation fn t))))))
52 53
  "FOO3")

54 55
(deftest documentation.function.t.6a
  (let* ((sym (gensym))
sds's avatar
sds committed
56 57
         (fn (compile nil `(lambda () ',sym)))
         (doc "FOO3A"))
58 59 60
    (multiple-value-prog1
       (setf (documentation fn t) (copy-seq doc))
       (assert (or (null (documentation fn t))
sds's avatar
sds committed
61
                   (equal doc (documentation fn t))))))
62 63 64 65 66 67
  "FOO3A")

;; Reorder 5, 5a and 6, 6a to expose possible interaction bug

(deftest documentation.function.t.5
  (let* ((sym (gensym))
sds's avatar
sds committed
68
         (fn (eval `#'(lambda () ',sym))))
69 70 71 72 73
    (documentation fn t))
  nil)

(deftest documentation.function.t.5a
  (let* ((sym (gensym))
sds's avatar
sds committed
74
         (fn (compile nil `(lambda () ',sym))))
75 76 77
    (documentation fn t))
  nil)

78 79
(deftest documentation.function.t.7
  (let* ((sym (gensym))
sds's avatar
sds committed
80
         (fn (eval `(defgeneric ,sym (x)))))
81 82
    (documentation fn t))
  nil)
sds's avatar
sds committed
83

84 85
(deftest documentation.function.t.8
  (let* ((sym (gensym))
sds's avatar
sds committed
86 87
         (fn (eval `(defgeneric ,sym (x))))
         (doc "FOO4"))
88 89 90
    (multiple-value-prog1
       (setf (documentation fn t) (copy-seq doc))
       (assert (or (null (documentation fn t))
sds's avatar
sds committed
91
                   (equal doc (documentation fn t))))))
92 93
  "FOO4")

94 95
(deftest documentation.function.t.9
  (loop for s in *cl-function-symbols*
sds's avatar
sds committed
96 97 98 99
        for fn = (symbol-function s)
        for doc = (documentation fn t)
        unless (or (null doc) (string doc))
        collect (list s doc))
100 101 102 103
  nil)

(deftest documentation.function.t.10
  (loop for s in *cl-accessor-symbols*
sds's avatar
sds committed
104 105 106 107
        for fn = (symbol-function s)
        for doc = (documentation fn t)
        unless (or (null doc) (string doc))
        collect (list s doc))
108 109 110 111
  nil)

(deftest documentation.function.t.11
  (loop for s in *cl-macro-symbols*
sds's avatar
sds committed
112 113 114 115
        for fn = (macro-function s)
        for doc = (documentation fn t)
        unless (or (null doc) (string doc))
        collect (list s doc))
116 117 118 119
  nil)

(deftest documentation.function.t.12
  (loop for s in *cl-standard-generic-function-symbols*
sds's avatar
sds committed
120 121 122 123
        for fn = (symbol-function s)
        for doc = (documentation fn t)
        unless (or (null doc) (string doc))
        collect (list s doc))
124 125
  nil)

126
;;; documentation (x function) (doc-type (eql 'function))
pfdietz's avatar
pfdietz committed
127

128
(deftest documentation.function.function.1
pfdietz's avatar
pfdietz committed
129 130 131 132 133
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (documentation (symbol-function sym) 'function))
  nil)

134
(deftest documentation.function.function.2
pfdietz's avatar
pfdietz committed
135 136 137
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (let ((fn (symbol-function sym))
sds's avatar
sds committed
138
          (doc "FOO5"))
139 140 141
      (multiple-value-prog1
       (setf (documentation fn 'function) (copy-seq doc))
       (assert (or (null (documentation fn 'function))
sds's avatar
sds committed
142
                   (equal doc (documentation fn 'function)))))))
143 144 145 146 147
  "FOO5")

(deftest documentation.function.function.3
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
148
    (documentation (macro-function sym) 'function))
149 150 151 152 153 154
  nil)

(deftest documentation.function.function.4
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
    (let ((fn (macro-function sym))
sds's avatar
sds committed
155
          (doc "FOO6"))
pfdietz's avatar
pfdietz committed
156
      (multiple-value-prog1
157 158
       (setf (documentation fn t) (copy-seq doc))
       (assert (or (null (documentation fn 'function))
sds's avatar
sds committed
159
                   (equal doc (documentation fn 'function)))))))
160 161 162 163
  "FOO6")

(deftest documentation.function.function.5
  (let* ((sym (gensym))
sds's avatar
sds committed
164
         (fn (eval `(defgeneric ,sym (x)))))
165 166
    (documentation fn 'function))
  nil)
sds's avatar
sds committed
167

168 169
(deftest documentation.function.function.8
  (let* ((sym (gensym))
sds's avatar
sds committed
170 171
         (fn (eval `(defgeneric ,sym (x))))
         (doc "FOO4A"))
172 173
    (multiple-value-prog1
       (setf (documentation fn t) (copy-seq doc))
pfdietz's avatar
pfdietz committed
174
       (assert (or (null (documentation fn 'function))
sds's avatar
sds committed
175
                   (equal doc (documentation fn 'function))))))
176 177 178 179 180 181 182 183 184 185 186 187 188 189
  "FOO4A")

;;; documentation (x list) (doc-type (eql 'function))

(deftest documentation.list.function.1
  (let* ((sym (gensym)))
    (eval `(defun (setf ,sym) (&rest args) (declare (ignore args)) nil))
    (documentation `(setf ,sym) 'function))
  nil)

(deftest documentation.list.function.2
  (let* ((sym (gensym)))
    (eval `(defun (setf ,sym) (&rest args) (declare (ignore args)) nil))
    (let ((fn `(setf ,sym))
sds's avatar
sds committed
190
          (doc "FOO7"))
191 192
      (multiple-value-prog1
       (setf (documentation fn 'function) (copy-seq doc))
193
       (assert (or (null (documentation fn 'function))
sds's avatar
sds committed
194
                   (equal doc (documentation fn 'function)))))))
195
  "FOO7")
pfdietz's avatar
pfdietz committed
196

197
;;; documentation (x list) (doc-type (eql 'compiler-macro))
pfdietz's avatar
pfdietz committed
198

199 200 201 202 203
(deftest documentation.list.compiler-macro.1
  (let* ((sym (gensym)))
    (eval `(define-compiler-macro (setf ,sym) (&rest args) (declare (ignore args)) nil))
    (documentation `(setf ,sym) 'compiler-macro))
  nil)
pfdietz's avatar
pfdietz committed
204

205 206 207 208
(deftest documentation.list.compiler-macro.2
  (let* ((sym (gensym)))
    (eval `(define-compiler-macro (setf ,sym) (&rest args) (declare (ignore args)) nil))
    (let ((fn `(setf ,sym))
sds's avatar
sds committed
209
          (doc "FOO8"))
210 211
      (multiple-value-prog1
       (setf (documentation fn 'compiler-macro) (copy-seq doc))
212
       (assert (or (null (documentation fn 'function))
sds's avatar
sds committed
213
                   (equal doc (documentation fn 'compiler-macro)))))))
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
  "FOO8")

;;; documentation (x symbol) (doc-type (eql 'function))

(deftest documentation.symbol.function.1
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (documentation sym 'function))
  nil)

(deftest documentation.symbol.function.2
  (let* ((sym (gensym)))
    (eval `(defun ,sym () nil))
    (let ((doc "FOO9"))
      (multiple-value-prog1
       (setf (documentation sym 'function) (copy-seq doc))
       (assert (or (null (documentation sym 'function))
sds's avatar
sds committed
231
                   (equal doc (documentation sym 'function)))))))
232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
  "FOO9")

(deftest documentation.symbol.function.3
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
    (documentation sym 'function))
  nil)

(deftest documentation.symbol.function.4
  (let* ((sym (gensym)))
    (eval `(defmacro ,sym () nil))
    (let ((doc "FOO9A"))
      (multiple-value-prog1
       (setf (documentation sym 'function) (copy-seq doc))
       (assert (or (null (documentation sym 'function))
sds's avatar
sds committed
247
                   (equal doc (documentation sym 'function)))))))
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
  "FOO9A")

(deftest documentation.symbol.function.5
  (let* ((sym (gensym)))
    (eval `(defgeneric ,sym (x)))
    (documentation sym 'function))
  nil)

(deftest documentation.symbol.function.6
  (let* ((sym (gensym)))
    (eval `(defgeneric ,sym (x)))
    (let ((doc "FOO9B"))
      (multiple-value-prog1
       (setf (documentation sym 'function) (copy-seq doc))
       (assert (or (null (documentation sym 'function))
sds's avatar
sds committed
263
                   (equal doc (documentation sym 'function)))))))
264 265
  "FOO9B")

266 267
(deftest documentation.symbol.function.7
  (loop for s in *cl-special-operator-symbols*
sds's avatar
sds committed
268 269 270
        for doc = (documentation s 'function)
        unless (or (null doc) (stringp doc))
        collect (list s doc))
271 272 273 274
  nil)

(deftest documentation.symbol.function.8
  (loop for s in *cl-function-or-accessor-symbols*
sds's avatar
sds committed
275 276 277
        for doc = (documentation s 'function)
        unless (or (null doc) (stringp doc))
        collect (list s doc))
278 279 280 281
  nil)

(deftest documentation.symbol.function.9
  (loop for s in *cl-macro-symbols*
sds's avatar
sds committed
282 283 284
        for doc = (documentation s 'function)
        unless (or (null doc) (stringp doc))
        collect (list s doc))
285 286
  nil)

287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
;;; documentation (x symbol) (doc-type (eql 'compiler-macro))

(deftest documentation.symbol.compiler-macro.1
  (let* ((sym (gensym)))
    (eval `(define-compiler-macro ,sym (&rest args) (declare (ignore args)) nil))
    (documentation sym 'compiler-macro))
  nil)

(deftest documentation.symbol.compiler-macro.2
  (let* ((sym (gensym)))
    (eval `(define-compiler-macro ,sym (&rest args) (declare (ignore args)) nil))
    (let ((doc "FOO10"))
      (multiple-value-prog1
       (setf (documentation sym 'compiler-macro) (copy-seq doc))
       (assert (or (null (documentation sym 'compiler-macro))
sds's avatar
sds committed
302
                   (equal doc (documentation sym 'compiler-macro)))))))
303
  "FOO10")
sds's avatar
sds committed
304

305 306 307 308
;;; documentation (x symbol) (doc-type (eql 'setf))

(deftest documentation.symbol.setf.1
  (let* ((sym (gensym))
sds's avatar
sds committed
309
         (doc "FOO11"))
310 311
    (eval `(defun ,sym () (declare (special *x*)) *x*))
    (eval `(define-setf-expander ,sym ()
sds's avatar
sds committed
312 313 314
             (let ((g (gemsym)))
               (values nil nil (list g) `(locally (declare (special *x*)) (setf *x* ,g))
                       '(locally (declare (special *x*)) *x*)))))
315 316 317 318 319
    (multiple-value-prog1
     (values
      (documentation sym 'setf)
      (setf (documentation sym 'setf) (copy-seq doc)))
     (assert (or (null (documentation sym 'setf))
sds's avatar
sds committed
320
                 (equal doc (documentation sym 'setf))))))
321 322 323 324
  nil "FOO11")

(deftest documentation.symbol.setf.2
  (let* ((sym (gensym))
sds's avatar
sds committed
325
         (doc "FOO12"))
326 327
    (eval `(defmacro ,sym () `(locally (declare (special *x*)) *x*)))
    (eval `(define-setf-expander ,sym ()
sds's avatar
sds committed
328 329 330
             (let ((g (gemsym)))
               (values nil nil (list g) `(locally (declare (special *x*)) (setf *x* ,g))
                       '(locally (declare (special *x*)) *x*)))))
331 332 333 334 335
    (multiple-value-prog1
     (values
      (documentation sym 'setf)
      (setf (documentation sym 'setf) (copy-seq doc)))
     (assert (or (null (documentation sym 'setf))
sds's avatar
sds committed
336
                 (equal doc (documentation sym 'setf))))))
337 338 339 340 341 342
  nil "FOO12")

;;; documentation (x method-combination) (doc-type (eql 't))
;;; documentation (x method-combination) (doc-type (eql 'method-combination))
;;; There's no portable way to test those, since there's no portable way to
;;; get a method combination object
pfdietz's avatar
pfdietz committed
343

344 345 346 347
;;; documentation (x symbol) (doc-type (eql 'method-combination))

(deftest documentation.symbol.method-combination.1
  (let* ((sym (gensym))
sds's avatar
sds committed
348
         (doc "FOO13"))
349 350 351 352 353 354
    (eval `(define-method-combination ,sym :identity-with-one-argument t))
    (multiple-value-prog1
     (values
      (documentation sym 'method-combination)
      (setf (documentation sym 'method-combination) (copy-seq doc)))
     (assert (or (null (documentation sym 'method-combination))
sds's avatar
sds committed
355
                 (equal doc (documentation sym 'method-combination))))))
356 357 358 359 360 361
  nil "FOO13")

;;; documentation (x standard-method) (doc-type (eql 't))

(deftest documentation.standard-method.t.1
  (let* ((sym (gensym))
sds's avatar
sds committed
362
         (doc "FOO14"))
363 364 365 366
    (eval `(defgeneric ,sym (x)))
    (let ((method (eval `(defmethod ,sym ((x t)) nil))))
      (multiple-value-prog1
       (values
sds's avatar
sds committed
367 368
        (documentation method t)
        (setf (documentation method t) (copy-seq doc)))
369
       (assert (or (null (documentation method 't))
sds's avatar
sds committed
370
                   (equal doc (documentation method 't)))))))
371
  nil "FOO14")
pfdietz's avatar
pfdietz committed
372

373
;;; documentation (x package) (doc-type (eql 't))
pfdietz's avatar
pfdietz committed
374

375 376 377
(deftest documentation.package.t.1
  (let ((package-name "PACKAGE-NAME-FOR-DOCUMENATION-TESTS-1"))
    (unwind-protect
sds's avatar
sds committed
378 379 380 381 382 383 384 385 386 387 388
        (progn
          (eval `(defpackage ,package-name (:use)))
          (let ((pkg (find-package package-name))
                (doc "FOO15"))
            (assert pkg)
            (multiple-value-prog1
             (values
              (documentation pkg t)
              (setf (documentation pkg t) (copy-seq doc)))
             (assert (or (null (documentation pkg t))
                         (equal doc (documentation pkg t)))))))
389 390
      (delete-package package-name)))
  nil "FOO15")
391 392 393 394 395

;;; documentation (x standard-class) (doc-type (eql 't))

(deftest documentation.standard-class.t.1
  (let* ((sym (gensym))
sds's avatar
sds committed
396
         (class-form `(defclass ,sym () ())))
397 398
    (eval class-form)
    (let ((class (find-class sym))
sds's avatar
sds committed
399
          (doc "FOO16"))
400 401
      (multiple-value-prog1
       (values
sds's avatar
sds committed
402 403
        (documentation class t)
        (setf (documentation class t) (copy-seq doc)))
404
       (assert (or (null (documentation class t))
sds's avatar
sds committed
405
                   (equal doc (documentation class t)))))))
406 407 408 409 410 411
  nil "FOO16")

;;; documentation (x standard-class) (doc-type (eql 'type))

(deftest documentation.standard-class.type.1
  (let* ((sym (gensym))
sds's avatar
sds committed
412
         (class-form `(defclass ,sym () ())))
413 414
    (eval class-form)
    (let ((class (find-class sym))
sds's avatar
sds committed
415
          (doc "FOO17"))
416 417
      (multiple-value-prog1
       (values
sds's avatar
sds committed
418 419
        (documentation class 'type)
        (setf (documentation class 'type) (copy-seq doc)))
420
       (assert (or (null (documentation class 'type))
sds's avatar
sds committed
421
                   (equal doc (documentation class 'type)))))))
422 423
  nil "FOO17")

424

425
;;; documentation (x structure-class) (doc-type (eql 't))
sds's avatar
sds committed
426

427 428
(deftest documentation.struct-class.t.1
  (let* ((sym (gensym))
sds's avatar
sds committed
429
         (class-form `(defstruct ,sym a b c)))
430 431
    (eval class-form)
    (let ((class (find-class sym))
sds's avatar
sds committed
432
          (doc "FOO18"))
433 434
      (multiple-value-prog1
       (values
sds's avatar
sds committed
435 436
        (documentation class t)
        (setf (documentation class t) (copy-seq doc)))
437
       (assert (or (null (documentation class t))
sds's avatar
sds committed
438
                   (equal doc (documentation class t)))))))
439 440 441 442 443 444
  nil "FOO18")

;;; documentation (x structure-class) (doc-type (eql 'type))

(deftest documentation.struct-class.type.1
  (let* ((sym (gensym))
sds's avatar
sds committed
445
         (class-form `(defstruct ,sym a b c)))
446 447
    (eval class-form)
    (let ((class (find-class sym))
sds's avatar
sds committed
448
          (doc "FOO19"))
449 450
      (multiple-value-prog1
       (values
sds's avatar
sds committed
451 452
        (documentation class 'type)
        (setf (documentation class 'type) (copy-seq doc)))
453
       (assert (or (null (documentation class 'type))
sds's avatar
sds committed
454
                   (equal doc (documentation class 'type)))))))
455 456 457 458 459 460
  nil "FOO19")

;;; documentation (x symbol) (doc-type (eql 'type))

(deftest documentation.symbol.type.1
  (let* ((sym (gensym))
sds's avatar
sds committed
461 462
         (class-form `(defclass ,sym () ()))
         (doc "FOO20"))
463 464 465 466 467 468
    (eval class-form)
    (multiple-value-prog1
     (values
      (documentation sym 'type)
      (setf (documentation sym 'type) (copy-seq doc)))
     (assert (or (null (documentation sym 'type))
sds's avatar
sds committed
469
                 (equal doc (documentation sym 'type))))))
470 471 472 473
  nil "FOO20")

(deftest documentation.symbol.type.2
  (let* ((sym (gensym))
sds's avatar
sds committed
474 475
         (class-form `(defstruct ,sym a b c))
         (doc "FOO21"))
476 477 478 479 480 481
    (eval class-form)
    (multiple-value-prog1
     (values
      (documentation sym 'type)
      (setf (documentation sym 'type) (copy-seq doc)))
     (assert (or (null (documentation sym 'type))
sds's avatar
sds committed
482
                 (equal doc (documentation sym 'type))))))
483 484 485 486
  nil "FOO21")

(deftest documentation.symbol.type.3
  (let* ((sym (gensym))
sds's avatar
sds committed
487 488
         (type-form `(deftype ,sym () t))
         (doc "FOO21A"))
489 490 491 492 493 494
    (eval type-form)
    (multiple-value-prog1
     (values
      (documentation sym 'type)
      (setf (documentation sym 'type) (copy-seq doc)))
     (assert (or (null (documentation sym 'type))
sds's avatar
sds committed
495
                 (equal doc (documentation sym 'type))))))
496 497
  nil "FOO21A")

498 499
(deftest documentation.symbol.type.4
  (loop for s in *cl-all-type-symbols*
sds's avatar
sds committed
500 501 502
        for doc = (documentation s 'type)
        unless (or (null doc) (stringp doc))
        collect (list doc))
503 504 505
  nil)


506 507 508 509
;;; documentation (x symbol) (doc-type (eql 'structure))

(deftest documentation.symbol.structure.1
  (let* ((sym (gensym))
sds's avatar
sds committed
510 511
         (class-form `(defstruct ,sym a b c))
         (doc "FOO22"))
512 513 514 515 516 517
    (eval class-form)
    (multiple-value-prog1
     (values
      (documentation sym 'structure)
      (setf (documentation sym 'structure) (copy-seq doc)))
     (assert (or (null (documentation sym 'structure))
sds's avatar
sds committed
518
                 (equal doc (documentation sym 'structure))))))
519 520 521 522
  nil "FOO22")

(deftest documentation.symbol.structure.2
  (let* ((sym (gensym))
sds's avatar
sds committed
523 524
         (class-form `(defstruct (,sym (:type list)) a b c))
         (doc "FOO23"))
525 526 527 528 529 530
    (eval class-form)
    (multiple-value-prog1
     (values
      (documentation sym 'structure)
      (setf (documentation sym 'structure) (copy-seq doc)))
     (assert (or (null (documentation sym 'structure))
sds's avatar
sds committed
531
                 (equal doc (documentation sym 'structure))))))
532 533 534 535
  nil "FOO23")

(deftest documentation.symbol.structure.3
  (let* ((sym (gensym))
sds's avatar
sds committed
536 537
         (class-form `(defstruct (,sym (:type vector)) a b c))
         (doc "FOO24"))
538 539 540 541 542 543
    (eval class-form)
    (multiple-value-prog1
     (values
      (documentation sym 'structure)
      (setf (documentation sym 'structure) (copy-seq doc)))
     (assert (or (null (documentation sym 'structure))
sds's avatar
sds committed
544
                 (equal doc (documentation sym 'structure))))))
545 546 547 548 549 550
  nil "FOO24")

;;; documentation (x symbol) (doc-type (eql 'variable))

(deftest documentation.symbol.variable.1
  (let* ((sym (gensym))
sds's avatar
sds committed
551 552
         (form `(defvar ,sym))
         (doc "FOO25"))
553 554 555 556 557 558
    (eval form)
    (multiple-value-prog1
     (values
      (documentation sym 'variable)
      (setf (documentation sym 'variable) (copy-seq doc)))
     (assert (or (null (documentation sym 'variable))
sds's avatar
sds committed
559
                 (equal doc (documentation sym 'variable))))))
560 561 562 563
  nil "FOO25")

(deftest documentation.symbol.variable.2
  (let* ((sym (gensym))
sds's avatar
sds committed
564 565
         (form `(defvar ,sym t))
         (doc "FOO26"))
566 567 568 569 570 571
    (eval form)
    (multiple-value-prog1
     (values
      (documentation sym 'variable)
      (setf (documentation sym 'variable) (copy-seq doc)))
     (assert (or (null (documentation sym 'variable))
sds's avatar
sds committed
572
                 (equal doc (documentation sym 'variable))))))
573 574 575 576
  nil "FOO26")

(deftest documentation.symbol.variable.3
  (let* ((sym (gensym))
sds's avatar
sds committed
577 578
         (form `(defparameter ,sym t))
         (doc "FOO27"))
579 580 581 582 583 584
    (eval form)
    (multiple-value-prog1
     (values
      (documentation sym 'variable)
      (setf (documentation sym 'variable) (copy-seq doc)))
     (assert (or (null (documentation sym 'variable))
sds's avatar
sds committed
585
                 (equal doc (documentation sym 'variable))))))
586 587 588 589
  nil "FOO27")

(deftest documentation.symbol.variable.4
  (let* ((sym (gensym))
sds's avatar
sds committed
590 591
         (form `(defconstant ,sym t))
         (doc "FOO27"))
592 593 594 595 596 597
    (eval form)
    (multiple-value-prog1
     (values
      (documentation sym 'variable)
      (setf (documentation sym 'variable) (copy-seq doc)))
     (assert (or (null (documentation sym 'variable))
sds's avatar
sds committed
598
                 (equal doc (documentation sym 'variable))))))
599 600
  nil "FOO27")

601 602
(deftest documentation.symbol.variable.5
  (loop for s in *cl-variable-symbols*
sds's avatar
sds committed
603 604 605
        for doc = (documentation s 'variable)
        unless (or (null doc) (stringp doc))
        collect (list s doc))
606 607 608 609
  nil)

(deftest documentation.symbol.variable.6
  (loop for s in *cl-constant-symbols*
sds's avatar
sds committed
610 611 612
        for doc = (documentation s 'variable)
        unless (or (null doc) (stringp doc))
        collect (list s doc))
613
  nil)
614 615 616

;;; Defining new methods for DOCUMENTATION

617 618 619
(ignore-errors
  (defgeneric documentation-test-class-1-doc-accessor (obj))
  (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
sds's avatar
sds committed
622 623 624
                                                 :type (or null string)
                                                 :initform nil)))

625 626 627 628
  (defmethod documentation-test-class-1-doc-accessor ((obj documentation-test-class-1) )
    (slot-value obj 'my-doc))
  (defmethod (setf documentation-test-class-1-doc-accessor) ((newdoc string) (obj documentation-test-class-1))
    (setf (slot-value obj 'my-doc) newdoc))
sds's avatar
sds committed
629

camm's avatar
camm committed
630 631
  (defmethod documentation ((obj documentation-test-class-1) (doctype (eql t)))
    (documentation-test-class-1-doc-accessor obj))
632

633 634
  (defmethod (setf documentation) ((newdoc string) (obj documentation-test-class-1) (doctype (eql t)))
    (setf (documentation-test-class-1-doc-accessor obj) newdoc)))
635 636 637 638 639 640 641 642 643

(deftest documentation.new-method.1
  (let ((obj (make-instance 'documentation-test-class-1)))
    (values
     (documentation obj t)
     (setf (documentation obj t) "FOO28")
     (documentation obj t)))
  nil "FOO28" "FOO28")