mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 08:10:31 +02:00
Code Activity

* Added some simple goops test for a beginning.

Browse source
This commit is contained in:
Dirk Herrmann 2001-06-30 20:03:14 +00:00
parent 0e3817d7d8
commit bdd2c6f4f4
2 changed files with 76 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

4
test-suite/ChangeLog
View file

@ -1,3 +1,7 @@
2001-06-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
* tests/goops.test: Started with some real tests.
2001-06-30 Dirk Herrmann <D.Herrmann@tu-bs.de> 2001-06-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
* guile-test: Use module (ice-9 rdelim). * guile-test: Use module (ice-9 rdelim).

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

@ -1,6 +1,6 @@
;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; goops.test --- test suite for GOOPS -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2001 Free Software Foundation, Inc. ;;;; Copyright (C) 2001 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by ;;;; it under the terms of the GNU General Public License as published by
@ -27,3 +27,74 @@
(use-modules (oop goops)) (use-modules (oop goops))
;;; more tests here... ;;; more tests here...
(with-test-prefix "basic classes"
(with-test-prefix "<top>"
(pass-if "instance?"
(instance? <top>))
(pass-if "class-of"
(eq? (class-of <top>) <class>))
(pass-if "is a class?"
(is-a? <top> <class>))
(pass-if "class-name"
(eq? (class-name <top>) '<top>))
(pass-if "direct superclasses"
(equal? (class-direct-supers <top>) '()))
(pass-if "superclasses"
(equal? (class-precedence-list <top>) (list <top>)))
(pass-if "direct slots"
(equal? (class-direct-slots <top>) '()))
(pass-if "slots"
(equal? (class-slots <top>) '())))
(with-test-prefix "<object>"
(pass-if "instance?"
(instance? <object>))
(pass-if "class-of"
(eq? (class-of <object>) <class>))
(pass-if "is a class?"
(is-a? <object> <class>))
(pass-if "class-name"
(eq? (class-name <object>) '<object>))
(pass-if "direct superclasses"
(equal? (class-direct-supers <object>) (list <top>)))
(pass-if "superclasses"
(equal? (class-precedence-list <object>) (list <object> <top>)))
(pass-if "direct slots"
(equal? (class-direct-slots <object>) '()))
(pass-if "slots"
(equal? (class-slots <object>) '())))
(with-test-prefix "<class>"
(pass-if "instance?"
(instance? <class>))
(pass-if "class-of"
(eq? (class-of <class>) <class>))
(pass-if "is a class?"
(is-a? <class> <class>))
(pass-if "class-name"
(eq? (class-name <class>) '<class>))
(pass-if "direct superclass"
(equal? (class-direct-supers <class>) (list <object>)))))