source: trunk/tests/ansi-tests/documentation.lsp @ 14368

Last change on this file since 14368 was 14368, checked in by gz, 9 years ago

Don't muffle warnings when running test, as that affects the return values from compile-file. Tweak tests to not cause warnings

File size: 19.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Dec 14 07:30:01 2004
4;;;; Contains: Tests of DOCUMENTATION
5
6(in-package :cl-test)
7
8;;; documentation (x function) (doc-type (eql 't))
9
10(deftest documentation.function.t.1
11  (let* ((sym (gensym)))
12    (eval `(defun ,sym () nil))
13    (documentation (symbol-function sym) t))
14  nil)
15
16(deftest documentation.function.t.2
17  (let* ((sym (gensym)))
18    (eval `(defun ,sym () nil))
19    (let ((fn (symbol-function sym))
20          (doc "FOO1"))
21      (multiple-value-prog1
22       (setf (documentation fn t) (copy-seq doc))
23       (assert (or (null (documentation fn t))
24                   (equal doc (documentation fn t)))))))
25  "FOO1")
26
27(deftest documentation.function.t.3
28  (let* ((sym (gensym)))
29    (eval `(defmacro ,sym () nil))
30    (documentation (macro-function sym) t))
31  nil)
32
33(deftest documentation.function.t.4
34  (let* ((sym (gensym)))
35    (eval `(defmacro ,sym () nil))
36    (let ((fn (macro-function sym))
37          (doc "FOO2"))
38      (multiple-value-prog1
39       (setf (documentation fn t) (copy-seq doc))
40       (assert (or (null (documentation fn t))
41                   (equal doc (documentation fn t)))))))
42  "FOO2")
43
44(deftest documentation.function.t.6
45  (let* ((sym (gensym))
46         (fn (eval `#'(lambda () ',sym)))
47         (doc "FOO3"))
48    (multiple-value-prog1
49       (setf (documentation fn t) (copy-seq doc))
50       (assert (or (null (documentation fn t))
51                   (equal doc (documentation fn t))))))
52  "FOO3")
53
54(deftest documentation.function.t.6a
55  (let* ((sym (gensym))
56         (fn (compile nil `(lambda () ',sym)))
57         (doc "FOO3A"))
58    (multiple-value-prog1
59       (setf (documentation fn t) (copy-seq doc))
60       (assert (or (null (documentation fn t))
61                   (equal doc (documentation fn t))))))
62  "FOO3A")
63
64;; Reorder 5, 5a and 6, 6a to expose possible interaction bug
65
66(deftest documentation.function.t.5
67  (let* ((sym (gensym))
68         (fn (eval `#'(lambda () ',sym))))
69    (documentation fn t))
70  nil)
71
72(deftest documentation.function.t.5a
73  (let* ((sym (gensym))
74         (fn (compile nil `(lambda () ',sym))))
75    (documentation fn t))
76  nil)
77
78(deftest documentation.function.t.7
79  (let* ((sym (gensym))
80         (fn (eval `(defgeneric ,sym (x)))))
81    (documentation fn t))
82  nil)
83   
84(deftest documentation.function.t.8
85  (let* ((sym (gensym))
86         (fn (eval `(defgeneric ,sym (x))))
87         (doc "FOO4"))
88    (multiple-value-prog1
89       (setf (documentation fn t) (copy-seq doc))
90       (assert (or (null (documentation fn t))
91                   (equal doc (documentation fn t))))))
92  "FOO4")
93
94(deftest documentation.function.t.9
95  (loop for s in *cl-function-symbols*
96        for fn = (symbol-function s)
97        for doc = (documentation fn t)
98        unless (or (null doc) (string doc))
99        collect (list s doc))
100  nil)
101
102(deftest documentation.function.t.10
103  (loop for s in *cl-accessor-symbols*
104        for fn = (symbol-function s)
105        for doc = (documentation fn t)
106        unless (or (null doc) (string doc))
107        collect (list s doc))
108  nil)
109
110(deftest documentation.function.t.11
111  (loop for s in *cl-macro-symbols*
112        for fn = (macro-function s)
113        for doc = (documentation fn t)
114        unless (or (null doc) (string doc))
115        collect (list s doc))
116  nil)
117
118(deftest documentation.function.t.12
119  (loop for s in *cl-standard-generic-function-symbols*
120        for fn = (symbol-function s)
121        for doc = (documentation fn t)
122        unless (or (null doc) (string doc))
123        collect (list s doc))
124  nil)
125
126;;; documentation (x function) (doc-type (eql 'function))
127
128(deftest documentation.function.function.1
129  (let* ((sym (gensym)))
130    (eval `(defun ,sym () nil))
131    (documentation (symbol-function sym) 'function))
132  nil)
133
134(deftest documentation.function.function.2
135  (let* ((sym (gensym)))
136    (eval `(defun ,sym () nil))
137    (let ((fn (symbol-function sym))
138          (doc "FOO5"))
139      (multiple-value-prog1
140       (setf (documentation fn 'function) (copy-seq doc))
141       (assert (or (null (documentation fn 'function))
142                   (equal doc (documentation fn 'function)))))))
143  "FOO5")
144
145(deftest documentation.function.function.3
146  (let* ((sym (gensym)))
147    (eval `(defmacro ,sym () nil))
148    (documentation (macro-function sym) 'function))
149  nil)
150
151(deftest documentation.function.function.4
152  (let* ((sym (gensym)))
153    (eval `(defmacro ,sym () nil))
154    (let ((fn (macro-function sym))
155          (doc "FOO6"))
156      (multiple-value-prog1
157       (setf (documentation fn t) (copy-seq doc))
158       (assert (or (null (documentation fn 'function))
159                   (equal doc (documentation fn 'function)))))))
160  "FOO6")
161
162(deftest documentation.function.function.5
163  (let* ((sym (gensym))
164         (fn (eval `(defgeneric ,sym (x)))))
165    (documentation fn 'function))
166  nil)
167   
168(deftest documentation.function.function.8
169  (let* ((sym (gensym))
170         (fn (eval `(defgeneric ,sym (x))))
171         (doc "FOO4A"))
172    (multiple-value-prog1
173       (setf (documentation fn t) (copy-seq doc))
174       (assert (or (null (documentation fn 'function))
175                   (equal doc (documentation fn 'function))))))
176  "FOO4A")
177
178;;; documentation (x list) (doc-type (eql 'function))
179
180(deftest documentation.list.function.1
181  (let* ((sym (gensym)))
182    (eval `(defun (setf ,sym) (&rest args) (declare (ignore args)) nil))
183    (documentation `(setf ,sym) 'function))
184  nil)
185
186(deftest documentation.list.function.2
187  (let* ((sym (gensym)))
188    (eval `(defun (setf ,sym) (&rest args) (declare (ignore args)) nil))
189    (let ((fn `(setf ,sym))
190          (doc "FOO7"))
191      (multiple-value-prog1
192       (setf (documentation fn 'function) (copy-seq doc))
193       (assert (or (null (documentation fn 'function))
194                   (equal doc (documentation fn 'function)))))))
195  "FOO7")
196
197;;; documentation (x list) (doc-type (eql 'compiler-macro))
198
199(deftest documentation.list.compiler-macro.1
200  (let* ((sym (gensym)))
201    (eval `(define-compiler-macro (setf ,sym) (&rest args) (declare (ignore args)) nil))
202    (documentation `(setf ,sym) 'compiler-macro))
203  nil)
204
205(deftest documentation.list.compiler-macro.2
206  (let* ((sym (gensym)))
207    (eval `(define-compiler-macro (setf ,sym) (&rest args) (declare (ignore args)) nil))
208    (let ((fn `(setf ,sym))
209          (doc "FOO8"))
210      (multiple-value-prog1
211       (setf (documentation fn 'compiler-macro) (copy-seq doc))
212       (assert (or (null (documentation fn 'function))
213                   (equal doc (documentation fn 'compiler-macro)))))))
214  "FOO8")
215
216;;; documentation (x symbol) (doc-type (eql 'function))
217
218(deftest documentation.symbol.function.1
219  (let* ((sym (gensym)))
220    (eval `(defun ,sym () nil))
221    (documentation sym 'function))
222  nil)
223
224(deftest documentation.symbol.function.2
225  (let* ((sym (gensym)))
226    (eval `(defun ,sym () nil))
227    (let ((doc "FOO9"))
228      (multiple-value-prog1
229       (setf (documentation sym 'function) (copy-seq doc))
230       (assert (or (null (documentation sym 'function))
231                   (equal doc (documentation sym 'function)))))))
232  "FOO9")
233
234(deftest documentation.symbol.function.3
235  (let* ((sym (gensym)))
236    (eval `(defmacro ,sym () nil))
237    (documentation sym 'function))
238  nil)
239
240(deftest documentation.symbol.function.4
241  (let* ((sym (gensym)))
242    (eval `(defmacro ,sym () nil))
243    (let ((doc "FOO9A"))
244      (multiple-value-prog1
245       (setf (documentation sym 'function) (copy-seq doc))
246       (assert (or (null (documentation sym 'function))
247                   (equal doc (documentation sym 'function)))))))
248  "FOO9A")
249
250(deftest documentation.symbol.function.5
251  (let* ((sym (gensym)))
252    (eval `(defgeneric ,sym (x)))
253    (documentation sym 'function))
254  nil)
255
256(deftest documentation.symbol.function.6
257  (let* ((sym (gensym)))
258    (eval `(defgeneric ,sym (x)))
259    (let ((doc "FOO9B"))
260      (multiple-value-prog1
261       (setf (documentation sym 'function) (copy-seq doc))
262       (assert (or (null (documentation sym 'function))
263                   (equal doc (documentation sym 'function)))))))
264  "FOO9B")
265
266(deftest documentation.symbol.function.7
267  (loop for s in *cl-special-operator-symbols*
268        for doc = (documentation s 'function)
269        unless (or (null doc) (stringp doc))
270        collect (list s doc))
271  nil)
272
273(deftest documentation.symbol.function.8
274  (loop for s in *cl-function-or-accessor-symbols*
275        for doc = (documentation s 'function)
276        unless (or (null doc) (stringp doc))
277        collect (list s doc))
278  nil)
279
280(deftest documentation.symbol.function.9
281  (loop for s in *cl-macro-symbols*
282        for doc = (documentation s 'function)
283        unless (or (null doc) (stringp doc))
284        collect (list s doc))
285  nil)
286
287;;; documentation (x symbol) (doc-type (eql 'compiler-macro))
288
289(deftest documentation.symbol.compiler-macro.1
290  (let* ((sym (gensym)))
291    (eval `(define-compiler-macro ,sym (&rest args) (declare (ignore args)) nil))
292    (documentation sym 'compiler-macro))
293  nil)
294
295(deftest documentation.symbol.compiler-macro.2
296  (let* ((sym (gensym)))
297    (eval `(define-compiler-macro ,sym (&rest args) (declare (ignore args)) nil))
298    (let ((doc "FOO10"))
299      (multiple-value-prog1
300       (setf (documentation sym 'compiler-macro) (copy-seq doc))
301       (assert (or (null (documentation sym 'compiler-macro))
302                   (equal doc (documentation sym 'compiler-macro)))))))
303  "FOO10")
304       
305;;; documentation (x symbol) (doc-type (eql 'setf))
306
307(deftest documentation.symbol.setf.1
308  (let* ((sym (gensym))
309         (doc "FOO11"))
310    (eval `(defun ,sym () (declare (special *x*)) *x*))
311    (eval `(define-setf-expander ,sym ()
312             (let ((g (gensym)))
313               (values nil nil (list g) `(locally (declare (special *x*)) (setf *x* ,g))
314                       '(locally (declare (special *x*)) *x*)))))
315    (multiple-value-prog1
316     (values
317      (documentation sym 'setf)
318      (setf (documentation sym 'setf) (copy-seq doc)))
319     (assert (or (null (documentation sym 'setf))
320                 (equal doc (documentation sym 'setf))))))
321  nil "FOO11")
322
323(deftest documentation.symbol.setf.2
324  (let* ((sym (gensym))
325         (doc "FOO12"))
326    (eval `(defmacro ,sym () `(locally (declare (special *x*)) *x*)))
327    (eval `(define-setf-expander ,sym ()
328             (let ((g (gensym)))
329               (values nil nil (list g) `(locally (declare (special *x*)) (setf *x* ,g))
330                       '(locally (declare (special *x*)) *x*)))))
331    (multiple-value-prog1
332     (values
333      (documentation sym 'setf)
334      (setf (documentation sym 'setf) (copy-seq doc)))
335     (assert (or (null (documentation sym 'setf))
336                 (equal doc (documentation sym 'setf))))))
337  nil "FOO12")
338
339;;; documentation (x method-combination) (doc-type (eql 't))
340;;; documentation (x method-combination) (doc-type (eql 'method-combination))
341;;; There's no portable way to test those, since there's no portable way to
342;;; get a method combination object
343
344;;; documentation (x symbol) (doc-type (eql 'method-combination))
345
346(deftest documentation.symbol.method-combination.1
347  (let* ((sym (gensym))
348         (doc "FOO13"))
349    (eval `(define-method-combination ,sym :identity-with-one-argument t))
350    (multiple-value-prog1
351     (values
352      (documentation sym 'method-combination)
353      (setf (documentation sym 'method-combination) (copy-seq doc)))
354     (assert (or (null (documentation sym 'method-combination))
355                 (equal doc (documentation sym 'method-combination))))))
356  nil "FOO13")
357
358;;; documentation (x standard-method) (doc-type (eql 't))
359
360(deftest documentation.standard-method.t.1
361  (let* ((sym (gensym))
362         (doc "FOO14"))
363    (eval `(defgeneric ,sym (x)))
364    (let ((method (eval `(defmethod ,sym ((x t)) nil))))
365      (multiple-value-prog1
366       (values
367        (documentation method t)
368        (setf (documentation method t) (copy-seq doc)))
369       (assert (or (null (documentation method 't))
370                   (equal doc (documentation method 't)))))))
371  nil "FOO14")
372
373;;; documentation (x package) (doc-type (eql 't))
374
375(deftest documentation.package.t.1
376  (let ((package-name "PACKAGE-NAME-FOR-DOCUMENATION-TESTS-1"))
377    (unwind-protect
378        (progn
379          (eval `(defpackage ,package-name (:use)))
380          (let ((pkg (find-package package-name))
381                (doc "FOO15"))
382            (assert pkg)
383            (multiple-value-prog1
384             (values
385              (documentation pkg t)
386              (setf (documentation pkg t) (copy-seq doc)))
387             (assert (or (null (documentation pkg t))
388                         (equal doc (documentation pkg t)))))))
389      (delete-package package-name)))
390  nil "FOO15")
391
392;;; documentation (x standard-class) (doc-type (eql 't))
393
394(deftest documentation.standard-class.t.1
395  (let* ((sym (gensym))
396         (class-form `(defclass ,sym () ())))
397    (eval class-form)
398    (let ((class (find-class sym))
399          (doc "FOO16"))
400      (multiple-value-prog1
401       (values
402        (documentation class t)
403        (setf (documentation class t) (copy-seq doc)))
404       (assert (or (null (documentation class t))
405                   (equal doc (documentation class t)))))))
406  nil "FOO16")
407
408;;; documentation (x standard-class) (doc-type (eql 'type))
409
410(deftest documentation.standard-class.type.1
411  (let* ((sym (gensym))
412         (class-form `(defclass ,sym () ())))
413    (eval class-form)
414    (let ((class (find-class sym))
415          (doc "FOO17"))
416      (multiple-value-prog1
417       (values
418        (documentation class 'type)
419        (setf (documentation class 'type) (copy-seq doc)))
420       (assert (or (null (documentation class 'type))
421                   (equal doc (documentation class 'type)))))))
422  nil "FOO17")
423
424
425;;; documentation (x structure-class) (doc-type (eql 't))
426       
427(deftest documentation.struct-class.t.1
428  (let* ((sym (gensym))
429         (class-form `(defstruct ,sym a b c)))
430    (eval class-form)
431    (let ((class (find-class sym))
432          (doc "FOO18"))
433      (multiple-value-prog1
434       (values
435        (documentation class t)
436        (setf (documentation class t) (copy-seq doc)))
437       (assert (or (null (documentation class t))
438                   (equal doc (documentation class t)))))))
439  nil "FOO18")
440
441;;; documentation (x structure-class) (doc-type (eql 'type))
442
443(deftest documentation.struct-class.type.1
444  (let* ((sym (gensym))
445         (class-form `(defstruct ,sym a b c)))
446    (eval class-form)
447    (let ((class (find-class sym))
448          (doc "FOO19"))
449      (multiple-value-prog1
450       (values
451        (documentation class 'type)
452        (setf (documentation class 'type) (copy-seq doc)))
453       (assert (or (null (documentation class 'type))
454                   (equal doc (documentation class 'type)))))))
455  nil "FOO19")
456
457;;; documentation (x symbol) (doc-type (eql 'type))
458
459(deftest documentation.symbol.type.1
460  (let* ((sym (gensym))
461         (class-form `(defclass ,sym () ()))
462         (doc "FOO20"))
463    (eval class-form)
464    (multiple-value-prog1
465     (values
466      (documentation sym 'type)
467      (setf (documentation sym 'type) (copy-seq doc)))
468     (assert (or (null (documentation sym 'type))
469                 (equal doc (documentation sym 'type))))))
470  nil "FOO20")
471
472(deftest documentation.symbol.type.2
473  (let* ((sym (gensym))
474         (class-form `(defstruct ,sym a b c))
475         (doc "FOO21"))
476    (eval class-form)
477    (multiple-value-prog1
478     (values
479      (documentation sym 'type)
480      (setf (documentation sym 'type) (copy-seq doc)))
481     (assert (or (null (documentation sym 'type))
482                 (equal doc (documentation sym 'type))))))
483  nil "FOO21")
484
485(deftest documentation.symbol.type.3
486  (let* ((sym (gensym))
487         (type-form `(deftype ,sym () t))
488         (doc "FOO21A"))
489    (eval type-form)
490    (multiple-value-prog1
491     (values
492      (documentation sym 'type)
493      (setf (documentation sym 'type) (copy-seq doc)))
494     (assert (or (null (documentation sym 'type))
495                 (equal doc (documentation sym 'type))))))
496  nil "FOO21A")
497
498(deftest documentation.symbol.type.4
499  (loop for s in *cl-all-type-symbols*
500        for doc = (documentation s 'type)
501        unless (or (null doc) (stringp doc))
502        collect (list doc))
503  nil)
504
505
506;;; documentation (x symbol) (doc-type (eql 'structure))
507
508(deftest documentation.symbol.structure.1
509  (let* ((sym (gensym))
510         (class-form `(defstruct ,sym a b c))
511         (doc "FOO22"))
512    (eval class-form)
513    (multiple-value-prog1
514     (values
515      (documentation sym 'structure)
516      (setf (documentation sym 'structure) (copy-seq doc)))
517     (assert (or (null (documentation sym 'structure))
518                 (equal doc (documentation sym 'structure))))))
519  nil "FOO22")
520
521(deftest documentation.symbol.structure.2
522  (let* ((sym (gensym))
523         (class-form `(defstruct (,sym (:type list)) a b c))
524         (doc "FOO23"))
525    (eval class-form)
526    (multiple-value-prog1
527     (values
528      (documentation sym 'structure)
529      (setf (documentation sym 'structure) (copy-seq doc)))
530     (assert (or (null (documentation sym 'structure))
531                 (equal doc (documentation sym 'structure))))))
532  nil "FOO23")
533
534(deftest documentation.symbol.structure.3
535  (let* ((sym (gensym))
536         (class-form `(defstruct (,sym (:type vector)) a b c))
537         (doc "FOO24"))
538    (eval class-form)
539    (multiple-value-prog1
540     (values
541      (documentation sym 'structure)
542      (setf (documentation sym 'structure) (copy-seq doc)))
543     (assert (or (null (documentation sym 'structure))
544                 (equal doc (documentation sym 'structure))))))
545  nil "FOO24")
546
547;;; documentation (x symbol) (doc-type (eql 'variable))
548
549(deftest documentation.symbol.variable.1
550  (let* ((sym (gensym))
551         (form `(defvar ,sym))
552         (doc "FOO25"))
553    (eval form)
554    (multiple-value-prog1
555     (values
556      (documentation sym 'variable)
557      (setf (documentation sym 'variable) (copy-seq doc)))
558     (assert (or (null (documentation sym 'variable))
559                 (equal doc (documentation sym 'variable))))))
560  nil "FOO25")
561
562(deftest documentation.symbol.variable.2
563  (let* ((sym (gensym))
564         (form `(defvar ,sym t))
565         (doc "FOO26"))
566    (eval form)
567    (multiple-value-prog1
568     (values
569      (documentation sym 'variable)
570      (setf (documentation sym 'variable) (copy-seq doc)))
571     (assert (or (null (documentation sym 'variable))
572                 (equal doc (documentation sym 'variable))))))
573  nil "FOO26")
574
575(deftest documentation.symbol.variable.3
576  (let* ((sym (gensym))
577         (form `(defparameter ,sym t))
578         (doc "FOO27"))
579    (eval form)
580    (multiple-value-prog1
581     (values
582      (documentation sym 'variable)
583      (setf (documentation sym 'variable) (copy-seq doc)))
584     (assert (or (null (documentation sym 'variable))
585                 (equal doc (documentation sym 'variable))))))
586  nil "FOO27")
587
588(deftest documentation.symbol.variable.4
589  (let* ((sym (gensym))
590         (form `(defconstant ,sym t))
591         (doc "FOO27"))
592    (eval form)
593    (multiple-value-prog1
594     (values
595      (documentation sym 'variable)
596      (setf (documentation sym 'variable) (copy-seq doc)))
597     (assert (or (null (documentation sym 'variable))
598                 (equal doc (documentation sym 'variable))))))
599  nil "FOO27")
600
601(deftest documentation.symbol.variable.5
602  (loop for s in *cl-variable-symbols*
603        for doc = (documentation s 'variable)
604        unless (or (null doc) (stringp doc))
605        collect (list s doc))
606  nil)
607
608(deftest documentation.symbol.variable.6
609  (loop for s in *cl-constant-symbols*
610        for doc = (documentation s 'variable)
611        unless (or (null doc) (stringp doc))
612        collect (list s doc))
613  nil)
614
615;;; Defining new methods for DOCUMENTATION
616
617(ignore-errors
618  (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
622                                                 :type (or null string)
623                                                 :initform nil)))
624 
625  (defmethod documentation-test-class-1-doc-accessor ((obj documentation-test-class-1) )
626    (slot-value obj 'my-doc))
627  (defmethod (setf documentation-test-class-1-doc-accessor) ((newdoc string) (obj documentation-test-class-1))
628    (setf (slot-value obj 'my-doc) newdoc))
629 
630  (defmethod documentation ((obj documentation-test-class-1) (doctype (eql t)))
631    (documentation-test-class-1-doc-accessor obj))
632
633  (defmethod (setf documentation) ((newdoc string) (obj documentation-test-class-1) (doctype (eql t)))
634    (setf (documentation-test-class-1-doc-accessor obj) newdoc)))
635
636(deftest documentation.new-method.1
637  (let ((obj (make-instance 'documentation-test-class-1)))
638    (values
639     (documentation obj t)
640     (setf (documentation obj t) "FOO28")
641     (documentation obj t)))
642  nil "FOO28" "FOO28")
643
Note: See TracBrowser for help on using the repository browser.