* Patch from Евгений Савин to fix TValue.From<managedrecord>. Fixes issue #41013

packages/rtl-objpas/src/inc/rtti.pp

@@ -3517,10 +3517,10 @@ begin
     tkUString,
     tkAString  : result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
     tkDynArray : result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
-    tkArray    : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.ArrayData.Size, ATypeInfo, False);
+    tkArray    : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.ArrayData.Size, ATypeInfo, IsManaged(ATypeInfo));
     tkObject,
-    tkRecord   : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.RecSize, ATypeInfo, False);
-    tkVariant  : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, SizeOf(Variant), ATypeInfo, False);
+    tkRecord   : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.RecSize, ATypeInfo, IsManaged(ATypeInfo));
+    tkVariant  : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, SizeOf(Variant), ATypeInfo, True);
     tkInterface: result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
   else
     // Silence compiler warning

packages/rtl-objpas/tests/tests.rtti.value.pas

@@ -53,6 +53,9 @@ Type
 
     procedure TestFromOrdinal;
     Procedure TestTryCastUnicodeString;
+
+    procedure TestMakeManagedRecord;
+    procedure TestMakeStaticArrayOfManagedRecord;
   end;
 
   { TTestValueArray }
@@ -1545,6 +1548,57 @@ begin
   CheckTrue(V.TryCast(TypeInfo(UnicodeString), V2),'Cast OK');
 end;
 
+type
+  TMyManagedRecord = record
+    I: IntPtr;
+    Intf: IUnknown;
+  end;
+  TTestIntfObject = class(TInterfacedObject);
+
+procedure TTestValueSimple.TestMakeManagedRecord;
+  function GetValue: TValue;
+  var
+    R: TMyManagedRecord;
+  begin
+    R.Intf := TTestIntfObject.Create;
+    Result := TValue.{$ifdef fpc}specialize{$endif} From<TMyManagedRecord>(R);
+  end;
+var
+  P: Pointer;
+  R: TMyManagedRecord;
+  V: TValue;
+begin
+  V := GetValue();
+  P := AllocMem(64);
+  R := V.{$ifdef fpc}specialize{$endif} AsType<TMyManagedRecord>;
+  Check((R.Intf as TTestIntfObject).RefCount >= 2, 'RefCount should be >= 2. One ref in in V, and another one is in R');
+  FreeMem(P);
+end;
+
+procedure TTestValueSimple.TestMakeStaticArrayOfManagedRecord;
+type
+  TArrayOfRec = array[0..0] of TMyManagedRecord;
+
+  function GetValue: TValue;
+  var
+    Arr: TArrayOfRec;
+  begin
+    Arr[0].Intf := TTestIntfObject.Create;
+    Result := TValue.{$ifdef fpc}specialize{$endif} From<TArrayOfRec>(Arr);
+  end;
+
+var
+  P: Pointer;
+  Arr: TArrayOfRec;
+  V: TValue;
+begin
+  V := GetValue();
+  P := AllocMem(64);
+  Arr := V.{$ifdef fpc}specialize{$endif} AsType<TArrayOfRec>;
+  Check((Arr[0].Intf as TTestIntfObject).RefCount >= 2, 'RefCount should be >= 2. One ref in in V, and another one is in Arr');
+  FreeMem(P);
+end;
+
 { TTestValueArray }
 
 
@@ -1986,4 +2040,3 @@ initialization
   RegisterTest(TTestValueSimple);
   RegisterTest(TTestValueVariant);
 end.
-