mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

Changes from arch/CVS synchronization

Browse source
This commit is contained in:
Ludovic Courtès 2007-07-10 22:39:36 +00:00
parent 91bb190dd7
commit 48e2c94ba2
9 changed files with 98 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

33
test-suite/tests/goops.test
View file

@ -177,6 +177,39 @@
(null? (generic-function-methods foo)))
(current-module)))))
(with-test-prefix "defining methods"
(pass-if "define-method"
(let ((m (current-module)))
(eval '(define-method (my-plus (s1 <string>) (s2 <string>))
(string-append s1 s2))
m)
(eval '(define-method (my-plus (i1 <integer>) (i2 <integer>))
(+ i1 i2))
m)
(eval '(and (is-a? my-plus <generic>)
(= (length (generic-function-methods my-plus))
2))
m)))
(pass-if "method-more-specific?"
(eval '(let* ((m+ (generic-function-methods my-plus))
(m1 (car m+))
(m2 (cadr m+))
(arg-types (list <string> <string>)))
(if (memq <string> (method-specializers m1))
(method-more-specific? m1 m2 arg-types)
(method-more-specific? m2 m1 arg-types)))
(current-module)))
(pass-if-exception "method-more-specific? (failure)"
exception:wrong-type-arg
(eval '(let* ((m+ (generic-function-methods my-plus))
(m1 (car m+))
(m2 (cadr m+)))
(method-more-specific? m1 m2 '()))
(current-module))))
(with-test-prefix "defining accessors"
(with-test-prefix "define-accessor"