RTL support for new management operators AddRef and Copy (NOTE: names can be changed). AddRef operator is used when record is passed as parameter to method/function by value (for records to large to copy (when only the address is pushed)). AddRef is used also for dynamic array operations (temporary for SetLength operation and for Copy operation for already copied data by move).

rtti.inc:
  * Rename TRTTIRecInitFiniOp to TRTTIRecVarOp (is used for Initialize, Finalize and AddRef operator)
  + New operator function type for Copy like operator: TRTTIRecCopyOp
  + New VMT slots for AddRef and Operators in TRTTIRecordOpVMT
  * Adjusted fpc_Addref function to support AddRef operator
  * Adjusted fpc_Copy function to support Copy operator

+ added test

git-svn-id: branches/maciej/smart_pointers@33478 -

.gitattributes

@@ -12678,6 +12678,7 @@ 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/toperator96.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

rtl/inc/rtti.inc

@@ -53,7 +53,8 @@ type
   end;
 
 {$if FPC_FULLVERSION>30100}
-  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
+  TRTTIRecVarOp=procedure(ARec: Pointer);
+  TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
 
   PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
   TRTTIRecordOpVMT=
@@ -61,8 +62,10 @@ type
   packed
 {$endif USE_PACKED}
   record
-    Initialize: TRTTIRecInitFiniOp;
-    Finalize: TRTTIRecInitFiniOp;
+    Initialize: TRTTIRecVarOp;
+    Finalize: TRTTIRecVarOp;
+    AddRef: TRTTIRecVarOp;
+    Copy: TRTTIRecCopyOp;
   end;
 
   PRecordInfoInit=^TRecordInfoInit;
@@ -283,7 +286,7 @@ begin
 end;
 
 
-Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
+Procedure fpc_Addref(Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
@@ -304,12 +307,16 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-      begin
 {$if FPC_FULLVERSION>30100}
-        { find init table }
-        RTTIRecordOp(typeinfo, typeinfo);
+      { find init table }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
 {$endif FPC_FULLVERSION>30100}
+      begin
         recordrtti(data,typeinfo,@int_addref);
+{$if FPC_FULLVERSION>30100}
+        if Assigned(recordop) and Assigned(recordop^.AddRef) then
+          recordop^.AddRef(Data);
+{$endif FPC_FULLVERSION>30100}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
@@ -381,16 +388,14 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
-      begin
 {$if FPC_FULLVERSION>30100}
-        { find init table }
-        RTTIRecordOp(typeinfo, typeinfo);
+      { find init table }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
 {$endif FPC_FULLVERSION>30100}
+      begin
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-
 {$if FPC_FULLVERSION>30100}
-        Result:=PRecordInfoInit(Temp)^.Size;
-        Count:=PRecordInfoInit(Temp)^.Count;
+        Result:=Size;
         Inc(PRecordInfoInit(Temp));
 {$else FPC_FULLVERSION>30100}
         Result:=PRecordInfoFull(Temp)^.Size;
@@ -399,7 +404,7 @@ begin
 {$endif FPC_FULLVERSION>30100}
         expectedoffset:=0;
         { Process elements with rtti }
-        for i:=1 to count Do
+        for i:=1 to Count Do
           begin
             Info:=PRecordElement(Temp)^.TypeInfo;
             Offset:=PRecordElement(Temp)^.Offset;
@@ -412,6 +417,10 @@ begin
         { elements remaining? }
         if result>expectedoffset then
           move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
+{$if FPC_FULLVERSION>30100}
+        if Assigned(recordop) and Assigned(recordop^.Copy) then
+          recordop^.Copy(Src,Dest);
+{$endif FPC_FULLVERSION>30100}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:

tests/test/toperator96.pp

@@ -0,0 +1,147 @@
+program toperator96;
+
+{$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.CopyState = ', Ord(AValue.CopyState));
+  if AValue.CopyState <> ACopyState then
+    Halt(3);
+  WriteLn('    AValue.Ref = ', AValue.Ref);
+  if AValue.Ref <> ARef then
+    Halt(4);
+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;
+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.