diff options
Diffstat (limited to 'test-suite/tests/goops.test')
-rw-r--r-- | test-suite/tests/goops.test | 169 |
1 files changed, 0 insertions, 169 deletions
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test deleted file mode 100644 index 08f1f58ac..000000000 --- a/test-suite/tests/goops.test +++ /dev/null @@ -1,169 +0,0 @@ -;;;; goops.test --- test suite for GOOPS -*- scheme -*- -;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. -;;;; -;;;; 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 -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA - -(use-modules (test-suite lib)) - -(pass-if "GOOPS loads" - (false-if-exception - (begin (resolve-module '(oop goops)) - #t))) - -(use-modules (oop goops)) - -;;; 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>))))) - -(with-test-prefix "defining classes" - - (with-test-prefix "define-class" - - (pass-if "creating a new binding" - (eval '(define <foo> #f) (current-module)) - (eval '(undefine <foo>) (current-module)) - (eval '(define-class <foo> ()) (current-module)) - (eval '(is-a? <foo> <class>) (current-module))) - - (pass-if "overwriting a binding to a non-class" - (eval '(define <foo> #f) (current-module)) - (eval '(define-class <foo> ()) (current-module)) - (eval '(is-a? <foo> <class>) (current-module))))) - -(with-test-prefix "defining generics" - - (with-test-prefix "define-generic" - - (pass-if "creating a new top-level binding" - (eval '(define foo #f) (current-module)) - (eval '(undefine foo) (current-module)) - (eval '(define-generic foo) (current-module)) - (eval '(and (is-a? foo <generic>) - (null? (generic-function-methods foo))) - (current-module))) - - (pass-if "overwriting a top-level binding to a non-generic" - (eval '(define (foo) #f) (current-module)) - (eval '(define-generic foo) (current-module)) - (eval '(and (is-a? foo <generic>) - (= 1 (length (generic-function-methods foo)))) - (current-module))) - - (pass-if "overwriting a top-level binding to a generic" - (eval '(define (foo) #f) (current-module)) - (eval '(define-generic foo) (current-module)) - (eval '(define-generic foo) (current-module)) - (eval '(and (is-a? foo <generic>) - (null? (generic-function-methods foo))) - (current-module))))) - -(with-test-prefix "defining accessors" - - (with-test-prefix "define-accessor" - - (pass-if "creating a new top-level binding" - (eval '(define foo #f) (current-module)) - (eval '(undefine foo) (current-module)) - (eval '(define-accessor foo) (current-module)) - (eval '(and (is-a? foo <generic-with-setter>) - (null? (generic-function-methods foo))) - (current-module))) - - (pass-if "overwriting a top-level binding to a non-accessor" - (eval '(define (foo) #f) (current-module)) - (eval '(define-accessor foo) (current-module)) - (eval '(and (is-a? foo <generic-with-setter>) - (= 1 (length (generic-function-methods foo)))) - (current-module))) - - (pass-if "overwriting a top-level binding to an accessor" - (eval '(define (foo) #f) (current-module)) - (eval '(define-accessor foo) (current-module)) - (eval '(define-accessor foo) (current-module)) - (eval '(and (is-a? foo <generic-with-setter>) - (null? (generic-function-methods foo))) - (current-module))))) |