/[gcl]/gcl/ansi-tests/documentation.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/documentation.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Sat May 14 15:22:03 2005 UTC revision 1.3 by pfdietz, Sun May 15 12:19:04 2005 UTC
# Line 41  Line 41 
41                     (equal doc (documentation fn t)))))))                     (equal doc (documentation fn t)))))))
42    "FOO2")    "FOO2")
43    
 (deftest documentation.function.t.5  
   (let* ((sym (gensym))  
          (fn (eval `#'(lambda () ',sym))))  
     (documentation fn t))  
   nil)  
   
44  (deftest documentation.function.t.6  (deftest documentation.function.t.6
45    (let* ((sym (gensym))    (let* ((sym (gensym))
46           (fn (eval `#'(lambda () ',sym)))           (fn (eval `#'(lambda () ',sym)))
# Line 57  Line 51 
51                     (equal doc (documentation fn t))))))                     (equal doc (documentation fn t))))))
52    "FOO3")    "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  (deftest documentation.function.t.7
79    (let* ((sym (gensym))    (let* ((sym (gensym))
80           (fn (eval `(defgeneric ,sym (x)))))           (fn (eval `(defgeneric ,sym (x)))))
# Line 141  Line 159 
159            (doc "FOO7"))            (doc "FOO7"))
160        (multiple-value-prog1        (multiple-value-prog1
161         (setf (documentation fn 'function) (copy-seq doc))         (setf (documentation fn 'function) (copy-seq doc))
162         (assert (or (null (documentation fn 'functiom))         (assert (or (null (documentation fn 'function))
163                     (equal doc (documentation fn 'function)))))))                     (equal doc (documentation fn 'function)))))))
164    "FOO7")    "FOO7")
165    
# Line 160  Line 178 
178            (doc "FOO8"))            (doc "FOO8"))
179        (multiple-value-prog1        (multiple-value-prog1
180         (setf (documentation fn 'compiler-macro) (copy-seq doc))         (setf (documentation fn 'compiler-macro) (copy-seq doc))
181         (assert (or (null (documentation fn 'functiom))         (assert (or (null (documentation fn 'function))
182                     (equal doc (documentation fn 'compiler-macro)))))))                     (equal doc (documentation fn 'compiler-macro)))))))
183    "FOO8")    "FOO8")
184    
# Line 214  Line 232 
232                     (equal doc (documentation sym 'function)))))))                     (equal doc (documentation sym 'function)))))))
233    "FOO9B")    "FOO9B")
234    
   
   
235  ;;; documentation (x symbol) (doc-type (eql 'compiler-macro))  ;;; documentation (x symbol) (doc-type (eql 'compiler-macro))
236    
237  (deftest documentation.symbol.compiler-macro.1  (deftest documentation.symbol.compiler-macro.1
# Line 316  Line 332 
332               (values               (values
333                (documentation pkg t)                (documentation pkg t)
334                (setf (documentation pkg t) (copy-seq doc)))                (setf (documentation pkg t) (copy-seq doc)))
335               (assert (or (null (documentation pkg 't))               (assert (or (null (documentation pkg t))
336                           (equal doc (documentation pkg 't)))))))                           (equal doc (documentation pkg t)))))))
337        (delete-package package-name)))        (delete-package package-name)))
338    nil "FOO15")    nil "FOO15")
339    
340    ;;; documentation (x standard-class) (doc-type (eql 't))
341    
342    (deftest documentation.standard-class.t.1
343      (let* ((sym (gensym))
344             (class-form `(defclass ,sym () ())))
345        (eval class-form)
346        (let ((class (find-class sym))
347              (doc "FOO16"))
348          (multiple-value-prog1
349           (values
350            (documentation class t)
351            (setf (documentation class t) (copy-seq doc)))
352           (assert (or (null (documentation class t))
353                       (equal doc (documentation class t)))))))
354      nil "FOO16")
355    
356    ;;; documentation (x standard-class) (doc-type (eql 'type))
357    
358    (deftest documentation.standard-class.type.1
359      (let* ((sym (gensym))
360             (class-form `(defclass ,sym () ())))
361        (eval class-form)
362        (let ((class (find-class sym))
363              (doc "FOO17"))
364          (multiple-value-prog1
365           (values
366            (documentation class 'type)
367            (setf (documentation class 'type) (copy-seq doc)))
368           (assert (or (null (documentation class 'type))
369                       (equal doc (documentation class 'type)))))))
370      nil "FOO17")
371    
372    ;;; documentation (x structure-class) (doc-type (eql 't))
373            
374    (deftest documentation.struct-class.t.1
375      (let* ((sym (gensym))
376             (class-form `(defstruct ,sym a b c)))
377        (eval class-form)
378        (let ((class (find-class sym))
379              (doc "FOO18"))
380          (multiple-value-prog1
381           (values
382            (documentation class t)
383            (setf (documentation class t) (copy-seq doc)))
384           (assert (or (null (documentation class t))
385                       (equal doc (documentation class t)))))))
386      nil "FOO18")
387    
388    ;;; documentation (x structure-class) (doc-type (eql 'type))
389    
390    (deftest documentation.struct-class.type.1
391      (let* ((sym (gensym))
392             (class-form `(defstruct ,sym a b c)))
393        (eval class-form)
394        (let ((class (find-class sym))
395              (doc "FOO19"))
396          (multiple-value-prog1
397           (values
398            (documentation class 'type)
399            (setf (documentation class 'type) (copy-seq doc)))
400           (assert (or (null (documentation class 'type))
401                       (equal doc (documentation class 'type)))))))
402      nil "FOO19")
403    
404    ;;; documentation (x symbol) (doc-type (eql 'type))
405    
406    (deftest documentation.symbol.type.1
407      (let* ((sym (gensym))
408             (class-form `(defclass ,sym () ()))
409             (doc "FOO20"))
410        (eval class-form)
411        (multiple-value-prog1
412         (values
413          (documentation sym 'type)
414          (setf (documentation sym 'type) (copy-seq doc)))
415         (assert (or (null (documentation sym 'type))
416                     (equal doc (documentation sym 'type))))))
417      nil "FOO20")
418    
419    (deftest documentation.symbol.type.2
420      (let* ((sym (gensym))
421             (class-form `(defstruct ,sym a b c))
422             (doc "FOO21"))
423        (eval class-form)
424        (multiple-value-prog1
425         (values
426          (documentation sym 'type)
427          (setf (documentation sym 'type) (copy-seq doc)))
428         (assert (or (null (documentation sym 'type))
429                     (equal doc (documentation sym 'type))))))
430      nil "FOO21")
431    
432    (deftest documentation.symbol.type.3
433      (let* ((sym (gensym))
434             (type-form `(deftype ,sym () t))
435             (doc "FOO21A"))
436        (eval type-form)
437        (multiple-value-prog1
438         (values
439          (documentation sym 'type)
440          (setf (documentation sym 'type) (copy-seq doc)))
441         (assert (or (null (documentation sym 'type))
442                     (equal doc (documentation sym 'type))))))
443      nil "FOO21A")
444    
445    ;;; documentation (x symbol) (doc-type (eql 'structure))
446    
447    (deftest documentation.symbol.structure.1
448      (let* ((sym (gensym))
449             (class-form `(defstruct ,sym a b c))
450             (doc "FOO22"))
451        (eval class-form)
452        (multiple-value-prog1
453         (values
454          (documentation sym 'structure)
455          (setf (documentation sym 'structure) (copy-seq doc)))
456         (assert (or (null (documentation sym 'structure))
457                     (equal doc (documentation sym 'structure))))))
458      nil "FOO22")
459    
460    (deftest documentation.symbol.structure.2
461      (let* ((sym (gensym))
462             (class-form `(defstruct (,sym (:type list)) a b c))
463             (doc "FOO23"))
464        (eval class-form)
465        (multiple-value-prog1
466         (values
467          (documentation sym 'structure)
468          (setf (documentation sym 'structure) (copy-seq doc)))
469         (assert (or (null (documentation sym 'structure))
470                     (equal doc (documentation sym 'structure))))))
471      nil "FOO23")
472    
473    (deftest documentation.symbol.structure.3
474      (let* ((sym (gensym))
475             (class-form `(defstruct (,sym (:type vector)) a b c))
476             (doc "FOO24"))
477        (eval class-form)
478        (multiple-value-prog1
479         (values
480          (documentation sym 'structure)
481          (setf (documentation sym 'structure) (copy-seq doc)))
482         (assert (or (null (documentation sym 'structure))
483                     (equal doc (documentation sym 'structure))))))
484      nil "FOO24")
485    
486    ;;; documentation (x symbol) (doc-type (eql 'variable))
487    
488    (deftest documentation.symbol.variable.1
489      (let* ((sym (gensym))
490             (form `(defvar ,sym))
491             (doc "FOO25"))
492        (eval form)
493        (multiple-value-prog1
494         (values
495          (documentation sym 'variable)
496          (setf (documentation sym 'variable) (copy-seq doc)))
497         (assert (or (null (documentation sym 'variable))
498                     (equal doc (documentation sym 'variable))))))
499      nil "FOO25")
500    
501    (deftest documentation.symbol.variable.2
502      (let* ((sym (gensym))
503             (form `(defvar ,sym t))
504             (doc "FOO26"))
505        (eval form)
506        (multiple-value-prog1
507         (values
508          (documentation sym 'variable)
509          (setf (documentation sym 'variable) (copy-seq doc)))
510         (assert (or (null (documentation sym 'variable))
511                     (equal doc (documentation sym 'variable))))))
512      nil "FOO26")
513    
514    (deftest documentation.symbol.variable.3
515      (let* ((sym (gensym))
516             (form `(defparameter ,sym t))
517             (doc "FOO27"))
518        (eval form)
519        (multiple-value-prog1
520         (values
521          (documentation sym 'variable)
522          (setf (documentation sym 'variable) (copy-seq doc)))
523         (assert (or (null (documentation sym 'variable))
524                     (equal doc (documentation sym 'variable))))))
525      nil "FOO27")
526    
527    (deftest documentation.symbol.variable.4
528      (let* ((sym (gensym))
529             (form `(defconstant ,sym t))
530             (doc "FOO27"))
531        (eval form)
532        (multiple-value-prog1
533         (values
534          (documentation sym 'variable)
535          (setf (documentation sym 'variable) (copy-seq doc)))
536         (assert (or (null (documentation sym 'variable))
537                     (equal doc (documentation sym 'variable))))))
538      nil "FOO27")
539    
540    
541    ;;; Defining new methods for DOCUMENTATION
542    
543    (defgeneric documentation-test-class-1-doc-accessor (obj))
544    (defgeneric (setf documentation-test-class-1-doc-accessor) (newdoc obj))
545    
546    (defclass documentation-test-class-1 () ((my-doc :accessor documentation-test-class-1-doc-accessor
547                                                     :type (or null string)
548                                                     :initform nil)))
549      
550    (defmethod documentation-test-class-1-doc-accessor ((obj documentation-test-class-1) )
551      (slot-value obj 'my-doc))
552    (defmethod (setf documentation-test-class-1-doc-accessor) ((newdoc string) (obj documentation-test-class-1))
553      (setf (slot-value obj 'my-doc) newdoc))
554    
555    (defmethod documentation ((obj documentation-test-class-1) (doctype (eql t)))
556      (documentation-test-class-1-doc-accessor obj))
557    
558    (defmethod (setf documentation) ((newdoc string) (obj documentation-test-class-1) (doctype (eql t)))
559      (setf (documentation-test-class-1-doc-accessor obj) newdoc))
560    
561    (deftest documentation.new-method.1
562      (let ((obj (make-instance 'documentation-test-class-1)))
563        (values
564         (documentation obj t)
565         (setf (documentation obj t) "FOO28")
566         (documentation obj t)))
567      nil "FOO28" "FOO28")
568    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26