* Test suite for management operators. We have management operators on trunk! Enjoy ^^

git-svn-id: trunk@35452 -

.gitattributes

@@ -12707,6 +12707,16 @@ tests/test/tmainnam.pp svneol=native#text/plain
 tests/test/tmath1.pp svneol=native#text/plain
 tests/test/tmcbool2.pp svneol=native#text/plain
 tests/test/tmmx1.pp svneol=native#text/plain
+tests/test/tmoperator1.pp svneol=native#text/pascal
+tests/test/tmoperator10.pp svneol=native#text/pascal
+tests/test/tmoperator2.pp svneol=native#text/pascal
+tests/test/tmoperator3.pp svneol=native#text/pascal
+tests/test/tmoperator4.pp svneol=native#text/pascal
+tests/test/tmoperator5.pp svneol=native#text/pascal
+tests/test/tmoperator6.pp svneol=native#text/pascal
+tests/test/tmoperator7.pp svneol=native#text/pascal
+tests/test/tmoperator8.pp svneol=native#text/pascal
+tests/test/tmoperator9.pp svneol=native#text/pascal
 tests/test/tmove.pp svneol=native#text/plain
 tests/test/tmsg1.pp svneol=native#text/plain
 tests/test/tmsg2.pp svneol=native#text/plain

tests/test/tmoperator1.pp

@@ -0,0 +1,29 @@
+{ %NORUN }
+
+program tmoperator1;
+
+{$MODE OBJFPC}
+{$modeswitch advancedrecords}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+end;
+
+begin
+end. 

tests/test/tmoperator10.pp

@@ -0,0 +1,24 @@
+program tmoperator10;
+
+{$MODE DELPHI}
+
+uses
+  TypInfo;
+
+type
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+  end;
+  TFooArray = array of TFoo;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+end;
+
+begin
+  if GetTypeData(TypeInfo(TFooArray))^.ElType = nil then
+    Halt(1);
+  if GetTypeData(TypeInfo(TFooArray))^.ElType2 = nil then
+    Halt(2);
+end. 

tests/test/tmoperator2.pp

@@ -0,0 +1,129 @@
+program tmoperator2;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+    S: string;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  if aFoo.S <> '' then
+    Halt(1);
+  aFoo.F := 1;
+  aFoo.S := 'A';
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  if aFoo.S <> 'B' then
+    Halt(3);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(4);
+  if F.S <> 'A' then
+    Halt(5);
+  F.F := 2;
+  F.S := 'B';
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(6);
+
+  if F.S <> 'A' then
+    Halt(7);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(8);
+  if B.F.S <> 'A' then
+    Halt(9);
+  B.F.F := 2;
+  B.F.S := 'B';
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF^.F <> 1 then
+    Halt(10);
+  if PF^.S <> 'A' then
+    Halt(11);
+  PF^.F := 2;
+  PF^.S := 'B';
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 1 then
+    Halt(12);
+  if PF^.S <> 'A' then
+    Halt(13);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(14);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF^.F <> 1 then
+    Halt(15);
+  if PF^.S <> 'A' then
+    Halt(16);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(17);
+  FreeMem(PF);
+    
+  WriteLn('=== Global variable [end] ===');
+  F.F := 2;
+  F.S := 'B';
+end. 

tests/test/tmoperator3.pp

@@ -0,0 +1,104 @@
+program tmoperator3;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  aFoo.F := 1;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(3);
+  F.F := 2;
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(4);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(5);
+  B.F.F := 2;
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF.F <> 1 then
+    Halt(6);
+  PF^.F := 2;
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF.F <> 1 then
+    Halt(7);
+  PF^.F := 2;  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(8);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF.F <> 1 then
+    Halt(9);
+  PF^.F := 2;  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(10);
+  FreeMem(PF);
+    
+  F.F := 2;
+  WriteLn('=== Global variable [end] ===');
+end. 

tests/test/tmoperator4.pp

@@ -0,0 +1,81 @@
+program tmoperator4;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = class
+  public 
+    F1: TR1;
+  end;
+
+  TB = class(TA)
+  public
+    F2: TR2;
+  end;
+
+var
+  O: TB;
+begin
+  O := TB.Create;
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+  
+  O.Free;
+  
+  WriteLn('end');
+end. 

tests/test/tmoperator5.pp

@@ -0,0 +1,138 @@
+program tmoperator5;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  aR1.I := 3;
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = object
+  public 
+    F1: TR1;
+  end;
+
+  TB = object(TA)
+  public
+    F2: TR2;
+  end;
+  
+procedure Foo();
+var
+  LO: TB;
+begin
+  if LO.F1.I <> 1 then
+    Halt(4);
+  if LO.F2.S <> 'A' then
+    Halt(5);
+  LO.F1.I := 2;
+  LO.F2.S := 'B';
+end;
+
+var
+  O: TB;
+  P: ^TB;
+begin
+  WriteLn('=== Global object variable [begin] ===');
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  WriteLn;
+  WriteLn('=== Local variable ===');
+  Foo();      
+    
+  WriteLn;
+  WriteLn('=== New and Dispose ===');
+  New(P);
+  if P^.F1.I <> 1 then
+    Halt(10);
+  if P^.F2.S <> 'A' then
+    Halt(11);
+  P^.F1.I := 2;
+  P^.F2.S := 'B';
+  Dispose(P); 
+  
+  WriteLn;
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(P, SizeOf(TB));
+  InitializeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 1 then
+    Halt(12);
+  if P^.F2.S <> 'A' then
+    Halt(13);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  FinalizeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 3 then
+    Halt(14);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(P, SizeOf(TB));
+  Initialize(P^);
+  if P^.F1.I <> 1 then
+    Halt(15);
+  if P^.F2.S <> 'A' then
+    Halt(16);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  Finalize(P^);
+  if P^.F1.I <> 3 then
+    Halt(17);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Global variable [end] ===');
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+end. 

tests/test/tmoperator6.pp

@@ -0,0 +1,28 @@
+{ %FAIL }
+
+program tmoperator6;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo): Boolean;
+    class operator Finalize(var aFoo: Pointer);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo): Boolean;
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: Pointer);
+begin
+end;
+
+begin
+end. 

tests/test/tmoperator7.pp

@@ -0,0 +1,105 @@
+program tmoperator7;
+
+{$MODE DELPHI}
+
+type
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    I: Integer;
+  public class var
+    InitializeCount: Integer;
+    FinalizeCount: Integer;
+  end;
+
+  TFooObj = object
+  public
+    F: TFoo;
+  end;  
+
+  TFooArray = array of TFoo; 
+  TFooObjArray = array of TFooObj; 
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  Inc(InitializeCount);
+  if aFoo.I <> 0 then // for dyn array and old obj
+    Halt(1);
+    
+  WriteLn('TFoo.Initialize');
+  aFoo.I := 1;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  Inc(FinalizeCount);
+  if aFoo.I <> 2 then
+    Halt(2);
+  WriteLn('TFoo.Finalize');
+end;
+
+procedure CheckFooInit(var AValue: Integer; const AExpectedInitializeCount: Integer);
+begin
+  if AValue <> 1 then
+    Halt(3);
+  AValue := 2;
+  
+  if TFoo.InitializeCount <> AExpectedInitializeCount then
+    Halt(4); 
+end;
+
+procedure CheckFooFini(const AExpectedFinalizeCount: Integer);
+begin
+  if TFoo.FinalizeCount <> AExpectedFinalizeCount then
+    Halt(5);   
+end;
+
+procedure FooTest;
+var
+  Foos: TFooArray;
+  FoosObj: TFooObjArray;
+begin
+  WriteLn('=== DynArray of Records ===');
+  
+  SetLength(Foos, 1);
+  CheckFooInit(Foos[0].I, 1);
+
+  SetLength(Foos, 2);
+  CheckFooInit(Foos[1].I, 2);
+    
+  SetLength(Foos, 1);
+  CheckFooFini(1);
+
+  SetLength(Foos, 2);
+  CheckFooInit(Foos[1].I, 3);
+
+  Foos := nil;
+  CheckFooFini(3);
+    
+  WriteLn('=== DynArray of Objects ===');
+  TFoo.InitializeCount := 0;
+  TFoo.FinalizeCount := 0;
+  
+  SetLength(FoosObj, 1);
+  CheckFooInit(FoosObj[0].F.I, 1);
+
+  SetLength(FoosObj, 2);
+  CheckFooInit(FoosObj[1].F.I, 2);
+    
+  SetLength(FoosObj, 1);
+  CheckFooFini(1);
+
+  SetLength(FoosObj, 2);
+  CheckFooInit(FoosObj[1].F.I, 3);
+
+  FoosObj := nil;
+  CheckFooFini(3);
+end;
+
+begin
+  FooTest;
+end. 

tests/test/tmoperator8.pp

@@ -0,0 +1,148 @@
+program tmoperator8;
+
+{$MODE DELPHI}
+
+type
+  TCopyState = (csNone, csSource, csDest);
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+    class operator AddRef(var aFoo: TFoo);
+    class operator Copy(constref aSrc: TFoo; var aDst: TFoo);
+  public
+    CopyState: TCopyState;
+    Ref: Boolean;
+    F, Test: Integer;
+  end;
+
+  TFooArray = array of TFoo;
+
+procedure TestFoo(const AValue: TFoo; AF, ATest: Integer; ARef: Boolean; ACopyState: TCopyState);
+begin
+  WriteLn('    AValue.F = ', AValue.F);
+  if AValue.F <> AF then
+    Halt(1);
+  WriteLn('    AValue.Test = ', AValue.Test);
+  if AValue.Test <> ATest then
+    Halt(2);
+  WriteLn('    AValue.Ref = ', AValue.Ref);
+  if AValue.Ref <> ARef then
+    Halt(4);
+  WriteLn('    AValue.CopyState = ', Ord(AValue.CopyState));
+  if AValue.CopyState <> ACopyState then
+    Halt(3);
+end;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.Initialize');
+  aFoo.F := 1;
+  aFoo.Ref := False;
+  aFoo.Test := 0;
+  aFoo.CopyState := csNone;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.Finalize');
+  if (aFoo.F <> 2) and not ((aFoo.F = 3) and aFoo.Ref) then
+    Halt(5);
+  aFoo.F := 4;
+end;
+
+class operator TFoo.AddRef(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.AddRef');
+  aFoo.F := 3;
+  aFoo.Test := aFoo.Test + 1;
+  aFoo.Ref := True;
+end;
+
+class operator TFoo.Copy(constref aSrc: TFoo; var aDst: TFoo);
+var
+  LSrc: PFoo;
+begin
+  WriteLn('TFoo.Copy');
+  LSrc := @aSrc;
+  LSrc.CopyState := csSource;
+  aDst.CopyState := csDest;
+  aDst.Test := aSrc.Test + 1;
+  aDst.F := aSrc.F;
+end;
+
+procedure TestValue(Value: TFoo);
+begin
+  writeln('  *Test without modifier:');
+  TestFoo(Value, 3, 1, True, csNone);
+end;
+
+procedure TestOut(out Value: TFoo);
+begin
+  WriteLn('  *Test out modifier:');
+  TestFoo(Value, 1, 0, False, csNone);
+  Value.F := 2;
+end;
+
+procedure TestVar(var Value: TFoo);
+begin
+  writeln('  *Test var modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure TestConst(const Value: TFoo);
+begin
+  writeln('  *Test const modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure TestConstref(constref Value: TFoo);
+begin
+  WriteLn('  *Test constref modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure Test;
+var
+  Foos: TFooArray;
+  Foos2: TFooArray;
+  A, B, C: TFoo;
+  i: Integer;
+begin
+  WriteLn('*** Test for variable copy');
+  TestFoo(B, 1, 0, False, csNone);
+  B.F := 2;
+  A := B;
+  TestFoo(B, 2, 0, False, csSource);
+  TestFoo(A, 2, 1, False, csDest);
+
+  WriteLn('*** Test for Copy(dyn array)');
+  SetLength(Foos, 5);
+  for i := 0 to 4 do
+  begin
+    Foos[i].F := 2;
+    Foos[i].Test := i;
+  end;
+
+  Foos2 := Copy(Foos);
+
+  for i := 0 to 4 do
+  begin
+    TestFoo(Foos[i], 2, i, False, csNone);
+    TestFoo(Foos2[i], 3, i + 1, True, csNone);
+  end;
+
+  WriteLn('*** Test for parameters modifiers');
+  TestValue(C);
+  C.F := 2; // reset F to pass finalize before out parameter
+  TestOut(C);
+  TestVar(C);
+  TestConst(C);
+  TestConstref(C);
+end;
+
+begin
+  Test;
+  WriteLn('end');
+end.

tests/test/tmoperator9.pp

@@ -0,0 +1,55 @@
+program tmoperator9;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  end;
+
+{ TFoo }
+
+var
+  ok_initialize: boolean = false;
+  ok_finalize: boolean = false;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  ok_initialize := true;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  ok_finalize := true;
+end;
+
+var
+  PF: PFoo;
+begin
+  { init rtti test }
+  New(PF);
+  if not ok_initialize then
+    Halt(1);
+  Dispose(PF);
+  if not ok_finalize then
+    Halt(2);
+
+  ok_initialize := false;
+  ok_finalize := false;
+
+  { regular rtti test }
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if not ok_initialize then
+    Halt(3);
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if not ok_finalize then
+    Halt(4);
+  FreeMem(PF);
+end.