+ Range check error testing for non-init classes and objects

tests/test/tclass4.pp

@@ -0,0 +1,46 @@
+{%RESULT=220 }
+{%OPT=-CR}
+{$mode objfpc}
+program test_class;
+
+
+type
+  tobj1 = class
+    constructor create;
+    procedure mymethod; virtual;
+  end;
+  
+  
+  tobj2 = class
+    constructor create;
+    procedure mymethod; virtual;
+  end;
+  
+  
+  constructor tobj2.create;
+   begin
+   end;
+   
+  procedure tobj2.mymethod;
+   begin
+   end;
+   
+   
+  constructor tobj1.create;
+   begin
+   end;
+   
+  procedure tobj1.mymethod;
+   begin
+   end;
+  
+  
+var
+ _cla1 : tobj1;
+ _cla2 : tobj2;
+Begin
+  _cla1:=tobj1.create;
+  _cla2:=tobj2.create;
+  tobj1(_cla2).mymethod;
+end.
+    

tests/test/tclass5.pp

@@ -0,0 +1,74 @@
+{ %RESULT=210 }
+{$R+}
+
+{$mode objfpc}
+
+program test_fail;
+
+  type
+     parrayobj = ^tarraycla;
+     tarraycla = class
+       ar : array [1..4] of real;
+       constructor create(do_fail : boolean);
+       procedure test;virtual;
+       destructor done;virtual;
+       end;
+     pbigarrayobj = ^tbigarraycla;
+     tbigarraycla = class(tarraycla)
+       ar2 : array [1..10000] of real;
+       constructor good_init;
+       constructor wrong_init;
+       procedure test;virtual;
+       end;
+  var
+    ta1, ta2 : tarraycla;
+    availmem : longint;
+
+  constructor tarraycla.create(do_fail : boolean);
+    begin
+       ar[1]:=1;
+       if do_fail then
+         fail;
+       ar[2]:=2;
+    end;
+
+  destructor tarraycla.done;
+    begin
+    end;
+
+  procedure  tarraycla.test;
+    begin
+      if ar[1]=1 then
+        Writeln('Init called');
+      if ar[2]=2 then
+        Writeln('Init successful');
+    end;
+
+  constructor tbigarraycla.good_init;
+    begin
+      inherited create(false);
+      Writeln('End of tbigarraycla.good_init');
+    end;
+
+  constructor tbigarraycla.wrong_init;
+    begin
+      inherited create(true);
+      Writeln('End of tbigarraycla.wrong_init');
+    end;
+
+  procedure tbigarraycla.test;
+    begin
+      Writeln('tbigarraycla.test called');
+      Inherited test;
+    end;
+
+  begin
+     availmem:=memavail;
+     ta1:=tarraycla.create(false);
+     writeln('Call to ta1.test after successful init');
+     ta1.test;
+     ta2:=tarraycla.create(true);
+     writeln('typeof(ta2) = ',longint(typeof(ta2)),' after unsuccessful init');
+     Writeln('Trying to call ta2.test (should generate a Run Time Error)');
+     ta2.test;
+  end.

tests/test/tobject3.pp

@@ -0,0 +1,48 @@
+{%RESULT=220 }
+{ %OPT= -CR }
+program test_object;
+
+
+type
+  pobj1 = ^tobj1;
+  tobj1 = object
+    constructor init;
+    procedure mymethod; virtual;
+  end;
+  
+  
+  
+  pobj2 = ^tobj2;
+  tobj2 = object
+    constructor init;
+    procedure mymethod; virtual;
+  end;
+  
+  
+  constructor tobj2.init;
+   begin
+   end;
+   
+  procedure tobj2.mymethod;
+   begin
+   end;
+   
+   
+  constructor tobj1.init;
+   begin
+   end;
+   
+  procedure tobj1.mymethod;
+   begin
+   end;
+  
+  
+var
+ _obj1 : pobj1;
+ _obj2 : pobj2;
+Begin
+  _obj1:=new(pobj1,init);
+  _obj2:=new(pobj2,init);
+  pobj1(_obj2)^.mymethod;
+end.
+