[Gd-chatter] r10938 - trunk/fundev/sources/dylan

[andreas at gwydiondylan.org]

Author: andreas
Date: Thu Nov  2 00:15:11 2006
New Revision: 10938

Modified:
   trunk/fundev/sources/dylan/class-dynamic.dylan
   trunk/fundev/sources/dylan/slot-descriptor-dynamic.dylan
Log:
bug: 7192

We know what we're doing with calling add-method on a sealed function here. This fixes that annoying bug.



Modified: trunk/fundev/sources/dylan/class-dynamic.dylan
==============================================================================
--- trunk/fundev/sources/dylan/class-dynamic.dylan	(original)
+++ trunk/fundev/sources/dylan/class-dynamic.dylan	Thu Nov  2 00:15:11 2006
@@ -84,7 +84,6 @@
   class-library(iclass-class(x))
 end method;
 
-
 define method initialize 
     (class :: <class>, #rest initargs,
      #key superclasses, slots :: <sequence> = #[], 
@@ -105,7 +104,8 @@
 	    library: home-library(module),
 	    initargs);
   install-implementation-class(iclass, $empty-subjunctive-class-universe);
-  add-slot-methods(iclass, $empty-subjunctive-class-universe);
+  add-slot-methods(iclass, $empty-subjunctive-class-universe,
+                   override-sealing?: module ~= $runtime-module);
   complete-dependent-generic-functions(iclass, $empty-subjunctive-class-universe);
 end method initialize;
 
@@ -763,14 +763,15 @@
 
 
 define function add-slot-methods (iclass :: <implementation-class>,
-				  u :: <subjunctive-class-universe>)
+				  u :: <subjunctive-class-universe>,
+                                  #key override-sealing?)
  => ()
   let slotvec :: <simple-object-vector> = direct-slot-descriptors(iclass);
   for (sd :: <slot-descriptor> in slotvec)
     let g = slot-getter(sd);
-    if (g) add-getter-method(slot-owner(sd), g, sd) end;
+    if (g) add-getter-method(slot-owner(sd), g, sd, override-sealing?) end;
     let s = slot-setter(sd);
-    if (s) add-setter-method(slot-owner(sd), s, sd) end;
+    if (s) add-setter-method(slot-owner(sd), s, sd, override-sealing?) end;
   end for;
 end function;
 

Modified: trunk/fundev/sources/dylan/slot-descriptor-dynamic.dylan
==============================================================================
--- trunk/fundev/sources/dylan/slot-descriptor-dynamic.dylan	(original)
+++ trunk/fundev/sources/dylan/slot-descriptor-dynamic.dylan	Thu Nov  2 00:15:11 2006
@@ -18,7 +18,8 @@
 define method add-setter-method
     (class :: <class>,
      slot-setter :: <generic-function>,
-     descriptor :: <constant-slot-descriptor>)
+     descriptor :: <constant-slot-descriptor>,
+     override-sealing? :: <boolean>)
   values(#f, #f)
 end method add-setter-method;
 
@@ -263,20 +264,22 @@
 define method add-getter-method
     (class-NOT :: <class>,
      slot-getter :: <generic-function>,
-     descriptor :: <slot-descriptor>)
+     descriptor :: <slot-descriptor>,
+     override-sealing? :: <boolean>)
   let new-method = make-a-slot-method(descriptor, #f);
   %add-a-method(slot-getter, new-method, home-library(class-module(class-NOT)),
-		#t, #t, slot-method-sealed?(descriptor))
+		#t, ~ override-sealing?, slot-method-sealed?(descriptor))
 end method add-getter-method;
 
 
 define method add-setter-method
     (class-NOT :: <class>,
      slot-setter :: <generic-function>,
-     descriptor :: <slot-descriptor>)
+     descriptor :: <slot-descriptor>,
+     override-sealing? :: <boolean>)
   let new-method = make-a-slot-method(descriptor, #t);
   %add-a-method(slot-setter, new-method, home-library(class-module(class-NOT)),
-		#t, #t, slot-method-sealed?(descriptor))
+		#t, ~ override-sealing?, slot-method-sealed?(descriptor))
 end method add-setter-method;
 
 
@@ -306,14 +309,16 @@
 define method add-getter-method
     (class :: <class>,
      slot-getter :: <generic-function>,
-     descriptor :: <virtual-slot-descriptor>)
+     descriptor :: <virtual-slot-descriptor>,
+     override-sealing? :: <boolean>)
   values(#f, #f)
 end method add-getter-method;
 
 define method add-setter-method
     (class :: <class>,
      slot-setter :: <generic-function>,
-     descriptor :: <virtual-slot-descriptor>)
+     descriptor :: <virtual-slot-descriptor>,
+     override-sealing? :: <boolean>)
   values(#f, #f)
 end method add-setter-method;