Revert "Fix bound-identifier=? to compare binding names, not just symbolic names."

[bpt/guile.git] / test-suite / tests / goops.test

diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 2bf7d69..1705ee8 100644 (file)
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,6 @@
 ;;;; goops.test --- test suite for GOOPS                      -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -147,7 +147,9 @@
   (pass-if "struct vtable"
     ;; Previously, `class-of' would fail for nameless structs, i.e., structs
     ;; for which `struct-vtable-name' is #f.
-    (is-a? (class-of (make-vtable-vtable "prprpr" 0)) <class>)))
+    (is-a? (class-of (make-vtable
+                      (string-append standard-vtable-fields "prprpr")))
+           <class>)))
 
 
 (with-test-prefix "defining classes"
@@ -206,8 +208,15 @@
                        (x #:accessor x #:init-value 123)
                        (z #:accessor z #:init-value 789))
                     (current-module))
-              (eval '(equal? (x (make <qux>)) 123) (current-module)))))
-     
+              (eval '(equal? (x (make <qux>)) 123) (current-module)))
+
+     (pass-if-exception "cannot redefine fields of <class>"
+       '(misc-error . "cannot be redefined")
+       (eval '(begin
+                (define-class <test-class> (<class>) 
+                  name) 
+                (make <test-class>))
+             (current-module)))))
 
 (with-test-prefix "defining generics"