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

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

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 (gemsym)))
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 (gemsym)))
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.