summaryrefslogtreecommitdiff
path: root/test-suite/tests/goops.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/goops.test')
-rw-r--r--test-suite/tests/goops.test169
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)))))