* oop/goops.scm (define-class): Make sure that define-class will

continue to work when mmacros are expanded before execution.

* test-suite/tests/goops.test: Added tests for define-class.

2 files changed, 16 insertions, 17 deletions

diff --git a/oop/ChangeLog b/oop/ChangeLog
index 0bde849e4..23cf19f75 100644
--- a/oop/ChangeLog
+++ b/oop/ChangeLog
@@ -1,3 +1,8 @@
+2002-07-13  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* goops.scm (define-class):  Make sure that define-class will
+	continue to work when mmacros are expanded before execution.
+
 2002-07-08  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* goops.scm (define-generic, define-accessor):  Make sure that
diff --git a/oop/goops.scm b/oop/goops.scm
index 6f7721d80..47c6b9464 100644
--- a/oop/goops.scm
+++ b/oop/goops.scm
@@ -235,23 +235,17 @@
 		 `(begin
 		    ;; define accessors
 		    ,@(pre-definitions (slots exp) env)
-		 
-		    ,(if (defined? name env)
-		      
-			 ;; redefine an old class
-			 `(define ,name
-			    (let ((old ,name)
-				  (new (class ,@(cddr exp) #:name ',name)))
-			      (if (and (is-a? old <class>)
-				       ;; Prevent redefinition of non-objects
-				       (memq <object>
-					     (class-precedence-list old)))
-				  (class-redefinition old new)
-				  new)))
-		      
-			 ;; define a new class
-			 `(define ,name
-			    (class ,@(cddr exp) #:name ',name)))))))))))
+		    ;; update the current-module
+		    (let* ((class (class ,@(cddr exp) #:name ',name))
+			   (var (module-ensure-local-variable!
+				 (current-module) ',name))
+			   (old (and (variable-bound? var)
+				     (variable-ref var))))
+		      (if (and old
+			       (is-a? old <class>)
+			       (memq <object> (class-precedence-list old)))
+			  (variable-set! var (class-redefinition old class))
+			  (variable-set! var class)))))))))))
 
 (define standard-define-class define-class)