/[guile]/guile/guile-core/test-suite/tests/goops.test
ViewVC logotype

Diff of /guile/guile-core/test-suite/tests/goops.test

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

revision 1.5 by mdj, Tue Apr 15 01:17:36 2003 UTC revision 1.6 by mdj, Thu Apr 17 15:25:15 2003 UTC
# Line 97  Line 97 
97        (eq? (class-name <class>) '<class>))        (eq? (class-name <class>) '<class>))
98    
99      (pass-if "direct superclass"      (pass-if "direct superclass"
100        (equal? (class-direct-supers <class>) (list <object>)))))        (equal? (class-direct-supers <class>) (list <object>))))
101    
102      (with-test-prefix "class-precedence-list"
103        (for-each (lambda (class)
104                    (run-test (if (slot-bound? class 'name)
105                                  (class-name class)
106                                  (with-output-to-string
107                                    (lambda ()
108                                      (display class))))
109                              #t
110                              (lambda ()
111                                (catch #t
112                                       (lambda ()
113                                         (equal? (class-precedence-list class)
114                                                 (compute-cpl class)))
115                                       (lambda args #t)))))
116                  (let ((table (make-hash-table)))
117                    (let rec ((class <top>))
118                      (hash-create-handle! table class #f)
119                      (for-each rec (class-direct-subclasses class)))
120                    (hash-fold (lambda (class ignore classes)
121                                 (cons class classes))
122                               '()
123                               table))))
124      )
125    
126  (with-test-prefix "defining classes"  (with-test-prefix "defining classes"
127    
# Line 186  Line 210 
210            (current-module))            (current-module))
211      (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))))      (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))))
212    
213    (with-test-prefix "equal?"
214      (pass-if "equal"
215               (eval '(begin
216                        (define-class <c> ()
217                          (x #:accessor x #:init-keyword #:x)
218                          (y #:accessor y #:init-keyword #:y))
219                        (define-method (equal? (a <c>) (b <c>))
220                          (equal? (y a) (y b)))
221                        (define o1 (make <c> #:x '(1) #:y '(3)))
222                        (define o2 (make <c> #:x '(2) #:y '(3)))
223                        (define o3 (make <c> #:x '(2) #:y '(4)))
224                        (equal? o1 o2))
225                     (current-module)))
226      (pass-if "not equal"
227               (eval '(not (equal? o2 o3))
228                     (current-module))))
229    
230  (use-modules (oop goops active-slot))  (use-modules (oop goops active-slot))
231    
232  (with-test-prefix "active-slot"  (with-test-prefix "active-slot"

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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