[svn] r5843: nemerle/trunk/ncc: hierarchy/TypeBuilder.n testsuite/positive/constant-object.n

[malekith]

Log:
Fix adding constant object in case constructor is not pure. Add testcase.

Author: malekith
Date: Mon Oct 24 16:40:29 2005
New Revision: 5843

Added:
   nemerle/trunk/ncc/testsuite/positive/constant-object.n
Modified:
   nemerle/trunk/ncc/hierarchy/TypeBuilder.n

Modified: nemerle/trunk/ncc/hierarchy/TypeBuilder.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/TypeBuilder.n	(original)
+++ nemerle/trunk/ncc/hierarchy/TypeBuilder.n	Mon Oct 24 16:40:29 2005
@@ -1794,14 +1794,33 @@
   // replaced by one constant object stored in special static field of this opption's class
   internal add_constant_object_ctor () : void
   {
-    match (member_map.Get (".ctor")) {
-      // FIXME: probably we should also check if parent variant is pure, that is, if creating
-      //        constant variant do not have side effects
-      | Some ([ctor is MethodBuilder]) when ctor.GetParameters ().IsEmpty &&
-                                           GetFields (BindingFlags.Instance %|
+    def is_pure (tc : TypeInfo) {
+      tc.Equals (InternalType.Object_tc) ||
+      (tc is TypeBuilder &&
+       match (tc.LookupMember (".ctor")) {
+         | [ctor is MethodBuilder] when 
+                 ctor.GetParameters ().IsEmpty &&
+                 tc.GetFields (BindingFlags.Instance %|
                                                       BindingFlags.Public %| 
                                                       BindingFlags.NonPublic).IsEmpty =>
+           //Message.Debug ($ "$tc: ctor.body = $(ctor.Body.GetType()) $(ctor.Body)");
+           (ctor.Body is <[ { base () } ]> ||
+            ctor.Body is <[ {} ]>) &&
+             match (tc.SuperClass ()) {
+               | Some (tc) => is_pure (tc)
+               | None => true
+             }
+         | _ => false
+       })
+    }
+    
+    when (is_pure (this)) {
         def ttf = GetMemType ();
+      def ctor =
+        match (LookupMember (".ctor")) {
+          | [ctor is MethodBuilder] => ctor
+          | _ => Util.ice ();
+        }
         ctor.Attributes = NemerleAttributes.Private;
 
         Util.locate (loc, {        
@@ -1856,8 +1875,6 @@
           decl.Attributes |= NemerleAttributes.SpecialName;
           Define (decl);
         });
-        
-      | _ => ()
     }
   }
 

Added: nemerle/trunk/ncc/testsuite/positive/constant-object.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/constant-object.n	Mon Oct 24 16:40:29 2005
@@ -0,0 +1,40 @@
+variant A {
+  | X
+  | Y { x : int; }
+}
+
+class C { }
+variant B : C {
+  | X
+  | Y { x : int; }
+}
+
+variant D {
+  | X
+  | Y { x : int; }
+
+  y : int;
+}
+
+variant E {
+  | X
+  | Y { x : int; }
+
+  static mutable count : int;
+
+  public this ()
+  {
+    count++;
+  }
+}
+
+assert (A.X () : object == A.X () : object);
+assert (A.Y (0) : object != A.Y (0) : object);
+assert (B.X () : object == B.X () : object);
+assert (B.Y (0) : object != B.Y (0) : object);
+
+assert (D.X () : object != D.X () : object);
+assert (D.Y (0) : object != D.Y (0) : object);
+assert (E.X () : object != E.X () : object);
+assert (E.Y (0) : object != E.Y (0) : object);
+