some RTTI fixes and enhancements

- especially for better collections support

Author: Arnaud Bouchez

src/core/mormot.core.data.pas

@@ -6441,7 +6441,7 @@ function TDynArray.InitSpecific(aTypeInfo: PRttiInfo; var aValue;
     if result = ptVariant then
       raise EDynArray.CreateUtf8('TDynArray.InitSpecific(%): missing mormot.core.json',
         [Info.Name, ToText(result)^])
-    else
+    else if aKind <> ptNone then
       raise EDynArray.CreateUtf8('TDynArray.InitSpecific(%) unsupported %',
         [Info.Name, ToText(result)^]);
 end;

src/core/mormot.core.json.pas

@@ -9488,6 +9488,7 @@ function TRttiJson.SetParserType(aParser: TRttiParserType;
   aParserComplex: TRttiParserComplexType): TRttiCustom;
 var
   C: TClass;
+  n: integer;
 begin
   // set Name and Flags from Props[]
   inherited SetParserType(aParser, aParserComplex);
@@ -9546,7 +9547,10 @@ function TRttiJson.SetParserType(aParser: TRttiParserType;
         fClassNewInstance := @_New_ObjectWithCustomCreate;
         // allow any kind of customization for TObjectWithCustomCreate children
         // - is used e.g. by TOrm or TObjectWithID
+        n := Props.Count;
         TCCHookClass(fValueClass).RttiCustomSetParser(self);
+        if n > Props.Count then
+          fFlags := fFlags + fProps.AdjustAfterAdded; // added a prop
       end
       else if C = TSynObjectList then
       begin

src/core/mormot.core.rtti.delphi.inc

@@ -498,6 +498,7 @@ begin
     {$endif HASDYNARRAYTYPE}
   end;
 end;
+
 function TRttiInfo.DynArrayItemType(out aDataSize: PtrInt): PRttiInfo;
 begin
   with GetTypeData(@self)^ do

src/core/mormot.core.rtti.pas

@@ -2275,8 +2275,9 @@   TRttiCustom = class
     // - if rcfObjArray is defined in Flags, will release all nested TObject
     procedure ValueFinalizeAndClear(Data: pointer);
       {$ifdef HASINLINE}inline;{$endif}
-    /// efficiently copy a stored value of this type
-    function ValueCopy(Dest, Source: pointer): PtrInt;
+    /// efficiently copy of a stored value of this type
+    // - same behavior as Dest := Source for all types
+    procedure ValueCopy(Dest, Source: pointer);
       {$ifdef HASINLINE}inline;{$endif}
     /// return TRUE if the Value is 0 / nil / '' / null
     function ValueIsVoid(Data: PAnsiChar): boolean;
@@ -5794,6 +5795,42 @@ function _VariantCopy(Dest, Source: PVarData; Info: PRttiInfo): PtrInt;
   result := SizeOf(Source^);
 end;
 
+function _Per1Copy(Dest, Source: PByte; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // called from TRttiCustom.ValueCopy which ignore this
+end;
+
+function _Per2Copy(Dest, Source: PWord; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // ignored
+end;
+
+function _Per4Copy(Dest, Source: PInteger; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // ignored
+end;
+
+function _Per8Copy(Dest, Source: PInt64; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // ignored
+end;
+
+function _Per16Copy(Dest, Source: PHash128; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // ignored
+end;
+
+function _Per32Copy(Dest, Source: PHash256; Info: PRttiInfo): PtrInt;
+begin
+  Dest^ := Source^;
+  result := 0; // ignored
+end;
+
 function _InterfaceCopy(Dest, Source: PInterface; Info: PRttiInfo): PtrInt;
 begin
   Dest^ := Source^;
@@ -7027,21 +7064,12 @@ procedure TRttiCustomProps.FinalizeAndClearPublishedProperties(Instance: TObject
 end;
 
 // TRttiCustom method defined here for proper inlining
-function TRttiCustom.ValueCopy(Dest, Source: pointer): PtrInt;
+procedure TRttiCustom.ValueCopy(Dest, Source: pointer);
 begin
-  if not Assigned(fCopy) then
-  begin
-    if rcfHasNestedProperties in fFlags then
-      if fCache.Kind = rkClass then
-        fProps.CopyProperties(Dest, Source)
-      else
-        fProps.CopyRecord(Dest, Source)
-    else
-      MoveFast(Source^, Dest^, fCache.Size);
-    result := fCache.Size;
-  end
+  if Assigned(fCopy) then
+    fCopy(Dest, Source, fCache.Info)
   else
-    result := fCopy(Dest, Source, fCache.Info);
+    MoveFast(Source^, Dest^, fCache.Size);
 end;
 
 procedure TRttiCustomProps.CopyRecord(Dest, Source: PAnsiChar);
@@ -7063,7 +7091,8 @@ procedure TRttiCustomProps.CopyRecord(Dest, Source: PAnsiChar);
         inc(Source, offset);
         inc(Dest, offset);
       end;
-      offset := pp^.Value.ValueCopy(Dest, Source); // copy managed field
+      pp^.Value.ValueCopy(Dest, Source); // copy managed field
+      offset := pp^.Value.Size;
       inc(Source, offset);
       inc(Dest, offset);
       inc(offset, pp^.OffsetGet);
@@ -7095,6 +7124,9 @@ procedure TRttiCustomProps.CopyProperties(Dest, Source: PAnsiChar);
           GetValue(Source, v);
           SetValue(Dest, v, {andclear=}true);
         end
+        else if Value.Kind = rkClass then
+          // explicit copy of nested instances properties
+          Value.Props.CopyProperties(Dest + OffsetSet, Source + OffsetGet)
         else
           // direct content copy from the fields memory buffers
           Value.ValueCopy(Dest + OffsetSet, Source + OffsetGet);
@@ -7220,6 +7252,21 @@ constructor TRttiCustom.Create(aInfo: PRttiInfo);
   // initialize processing callbacks
   fFinalize := RTTI_FINALIZE[fCache.Kind];
   fCopy := RTTI_MANAGEDCOPY[fCache.Kind];
+  if not Assigned(fCopy) then
+    case fCache.Size of // direct copy of most sizes, including class/pointer
+      1:
+        fCopy := @_Per1Copy;
+      2:
+        fCopy := @_Per2Copy;
+      4:
+        fCopy := @_Per4Copy;
+      8:
+        fCopy := @_Per8Copy;
+      16:
+        fCopy := @_Per16Copy;
+      32:
+        fCopy := @_Per32Copy;
+    end; // ItemCopy() will fallback to MoveFast() otherwise
   pt := TypeInfoToStandardParserType(aInfo, {byname=}true, @pct);
   SetParserType(pt, pct);
 end;

src/core/mormot.core.threads.pas

@@ -1402,8 +1402,8 @@ procedure TSynQueue.SaveToWriter(aWriter: TBufferWriter);
 constructor TPendingTaskList.Create;
 begin
   inherited Create;
-  fTasks.InitSpecific(TypeInfo(TPendingTaskListItemDynArray),
-    fTask, ptInt64, @fCount); // sorted by Timestamp
+  fTasks.InitSpecific(TypeInfo(TPendingTaskListItemDynArray), fTask, ptInt64,
+    @fCount); // sorted by Timestamp
 end;
 
 function TPendingTaskList.GetTimestamp: Int64;

test/test.core.collections.pas

@@ -163,6 +163,15 @@ procedure TTestCoreCollections.TestOne<T>;
   Check(li.Count = 0);
 end;
 
+type
+  TClassWithoutRtti = class
+  private
+    fSoup: RawUtf8;
+  public
+    property Soup: RawUtf8
+      read fSoup write fSoup;
+  end;
+
 procedure TTestCoreCollections._IList;
 const
   MAX = 1000; // not too big since here we validate also brute force searches
@@ -172,11 +181,15 @@ procedure TTestCoreCollections._IList;
   li: IList<integer>;
   o: TObjectWithID;
   lo: IList<TObjectWithID>;
+  s: TClassWithoutRtti;
+  ls: IList<TClassWithoutRtti>;
   u: RawUtf8;
   pu: PRawUtf8;
   lu: IList<RawUtf8>;
   lh: IList<THash128>;
   h: THash128;
+  r: TSynTestFailed;
+  lr: IList<TSynTestFailed>;
 begin
   // manual IList<integer> validation
   li := Collections.NewList<integer>;
@@ -242,6 +255,18 @@ procedure TTestCoreCollections._IList;
   i := lo.Add(TObjectWithID.CreateWithID(100));
   Check(i = 0);
   CheckEqual(lo[i].IDValue, 100);
+  // manual IList<TClassWithoutRtti> validation
+  ls := Collections.NewList<TClassWithoutRtti>;
+  ls.Capacity := MAX + 1;
+  for i := 0 to MAX do
+  begin
+    s := TClassWithoutRtti.Create;
+    s.Soup := UInt32ToUtf8(i);
+    Check(ls.Add(s) = i);
+    check(ls[i] <> nil);
+   end;
+   for i := 0 to ls.Count - 1 do
+     Check(Utf8ToInteger(ls[i].Soup) = i);
   // manual IList<RawUtf8> validation
   lu := Collections.NewList<RawUtf8>;
   for u in lu do
@@ -292,6 +317,20 @@ procedure TTestCoreCollections._IList;
   lh.Add(h);
   lh.Sort;
   lh := nil;
+  // manual IList<TSynTestFailed> validation
+  lr := Collections.NewPlainList<TSynTestFailed>;
+  lr.Capacity := MAX + 1;
+  r.TestName := 'n';
+  for i := 0 to MAX do
+  begin
+    r.Error := IntToStr(i);
+    Check(lr.Add(r) = i);
+    check(lr[i].Error = r.Error);
+   end;
+  for i := 0 to lr.Count - 1 do
+    Check(lr[i].TestName = 'n');
+   for i := 0 to lr.Count - 1 do
+     Check(StrToInt(lr[i].Error) = i);
   // validate and benchmark all main types using a generic sub method
   TestOne<byte>();
   TestOne<word>();