Browse Source

Allow Initialize management operator for SetLength for dynamic arrays (fix for bug reported by Anthony Walter).

rtl/inc/aliases.inc:
  + new internal alias int_InitializeArray for FPC_INITIALIZE_ARRAY
rtl/inc/dynarr.inc:
  * use int_InitializeArray in fpc_dynarray_setlength for new elements for array of records and objects
rtl/inc/rtti.inc:
  * missing semicolon

+ added test

git-svn-id: branches/maciej/smart_pointers@33384 -
maciej-izak 9 years ago
parent
commit
6fb1fce44c
5 changed files with 119 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 1 0
      rtl/inc/aliases.inc
  3. 11 0
      rtl/inc/dynarr.inc
  4. 1 1
      rtl/inc/rtti.inc
  5. 105 0
      tests/test/toperator95.pp

+ 1 - 0
.gitattributes

@@ -12636,6 +12636,7 @@ tests/test/toperator91.pp svneol=native#text/pascal
 tests/test/toperator92.pp svneol=native#text/pascal
 tests/test/toperator93.pp svneol=native#text/pascal
 tests/test/toperator94.pp svneol=native#text/pascal
+tests/test/toperator95.pp svneol=native#text/pascal
 tests/test/toperatorerror.pp svneol=native#text/plain
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain

+ 1 - 0
rtl/inc/aliases.inc

@@ -27,6 +27,7 @@
 Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
 Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
 Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
+procedure int_InitializeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_INITIALIZE_ARRAY'];
 procedure int_FinalizeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_FINALIZE_ARRAY'];
 
 {$if defined(FPC_HAS_FEATURE_RTTI) and not defined(cpujvm)}

+ 11 - 0
rtl/inc/dynarr.inc

@@ -153,6 +153,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
             exit;
           getmem(newp,size);
           fillchar(newp^,size,0);
+{$if FPC_FULLVERSION>30100}
+          { call int_InitializeArray for management operators }
+          if PByte(eletype)^ in [tkRecord, tkObject] then
+            int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
+{$endif FPC_FULLVERSION>30100}
           updatep := true;
        end
      else
@@ -223,6 +228,12 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                          reallocmem(realp,size);
                          fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
                            (dims[0]-realp^.high-1)*elesize,0);
+{$if FPC_FULLVERSION>30100}
+                         { call int_InitializeArray for management operators }
+                         if PByte(eletype)^ in [tkRecord, tkObject] then
+                           int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
+                             eletype, dims[0]-realp^.high-1);
+{$endif FPC_FULLVERSION>30100}
                       end;
                     newp := realp;
                     updatep := true;

+ 1 - 1
rtl/inc/rtti.inc

@@ -439,7 +439,7 @@ begin
 end;
 
 
-procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY'] compilerproc;
+procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
   var
      i, size : SizeInt;
   begin

+ 105 - 0
tests/test/toperator95.pp

@@ -0,0 +1,105 @@
+program toperator95;
+
+{$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.