DataRecord

AuraTrader/MainForm.fmx

@@ -205,7 +205,6 @@ object Form1: TForm1
               TabOrder = 0
               Text = 'Button1'
               TextSettings.Trimming = None
-              OnClick = Button1Click
             end
           end
         end

AuraTrader/MainForm.pas

@@ -85,7 +85,6 @@ type
         procedure StopButtonClick(Sender: TObject);
         procedure TreeViewDblClick(Sender: TObject);
         procedure AddWorkspaceActionExecute(Sender: TObject);
-        procedure Button1Click(Sender: TObject);
         procedure Strat2ButtonClick(Sender: TObject);
         procedure TestActionExecute(Sender: TObject);
         procedure StrategyButtonClick(Sender: TObject);
@@ -110,6 +109,7 @@ type
         function CurrLayout<T: TControl>: T;
         procedure AlignControl(Control: TControl);
         function CreateStrategy2(Timeframe: TTimeframe): IMycProcessor<TDataPoint<TOhlcItem>>;
+
     published
         property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
     end;
@@ -124,6 +124,11 @@ type
         constructor Create(AEquity: Double);
     end;
 
+type
+    TStaget1Result = record
+    ATR, Hull, SMA, O, H, L, C: Double
+    end;
+
 var
     Form1: TForm1;
 
@@ -292,11 +297,6 @@ begin
     Control.Align := TAlignLayout.Top;
 end;
 
-procedure TForm1.Button1Click(Sender: TObject);
-begin
-    Myc.DataRecord.Testfunc;
-end;
-
 function TForm1.CreateStrategy2(Timeframe: TTimeframe): IMycProcessor<TDataPoint<TOhlcItem>>;
 type
     TSignal = record

Src/Myc.DataRecord.Impl.pas

@@ -12,7 +12,7 @@ uses
 
 type
     // The builder implementation class, now in the global scope.
-    TDataRecordBuilder = class(TInterfacedObject, TDataRecord.IBuilder)
+    TDataRecordBuilder = class(TInterfacedObject, TDataRecord.TBuilder.IBuilder)
     private
         FStagedValues: TList<TPair<string, TValue>>;
     public

Src/Myc.DataRecord.pas

@@ -8,7 +8,7 @@ uses
     System.TypInfo;
 
 type
-    // A record that provides field-level access to data, stored in a packed byte buffer.
+    // A record that provides field-level access to managed data, stored in a byte buffer.
     TDataRecord = record
     public
         type
@@ -32,42 +32,47 @@ type
                 TypeInfo: PTypeInfo;
             end;
 
-            IBuilder = interface
-                procedure AddField(const Name: String; const Value: TValue); overload;
-                procedure SetupRecord(out Layout: TArray<TFieldLayout>; out Buffer: TBytes);
-            end;
-
             // The interface helper record that provides the generic AddField<T> method.
             TBuilder = record
+                type
+                    IBuilder = interface
+                        procedure AddField(const Name: String; const Value: TValue); overload;
+                        procedure SetupRecord(out Layout: TArray<TFieldLayout>; out Buffer: TBytes);
+                    end;
+
             private
                 FBuilder: IBuilder;
             public
                 constructor Create(const ABuilder: IBuilder);
 
-                // This generic method is the reason for the helper's existence.
-                procedure AddField<T>(const Name: String; const Value: T); inline;
-
-                // Wrapper for methods on the underlying interface.
-                function CreateRec: TDataRecord; inline;
-
-                // Implicit operators for seamless casting between the helper and the interface.
                 class operator Implicit(const AValue: IBuilder): TBuilder; overload;
                 class operator Implicit(const AValue: TBuilder): IBuilder; overload;
+
+                procedure AddField<T>(const Name: String); overload; inline;
+                procedure AddField<T>(const Name: String; const Value: T); overload; inline;
+
+                function CreateRec: TDataRecord; inline;
             end;
 
     private
         FLayout: TArray<TFieldLayout>;
         FBuffer: TBytes;
+
     public
         class operator Initialize(out Dest: TDataRecord);
         class operator Finalize(var Dest: TDataRecord);
         class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
 
-        // Factory method now returns the helper record instance.
         class function CreateBuilder: TBuilder; static;
+
+        class function CreateFrom<T>(const Rec: T): TDataRecord; static;
+        procedure AssignTo<T>(var Rec: T);
+        function FitsRecord<T>: Boolean;
+
         function IndexOf(const Name: String): Integer;
         function GetField(const Name: String): IField; overload;
         function GetField<T>(const Name: String): IField<T>; overload;
+
         property Layout: TArray<TFieldLayout> read FLayout;
     end;
 
@@ -90,6 +95,11 @@ begin
     FBuilder.AddField(Name, TValue.From<T>(Value));
 end;
 
+procedure TDataRecord.TBuilder.AddField<T>(const Name: String);
+begin
+    AddField<T>(Name, Default(T));
+end;
+
 function TDataRecord.TBuilder.CreateRec: TDataRecord;
 begin
     FBuilder.SetupRecord(Result.FLayout, Result.FBuffer);
@@ -125,6 +135,76 @@ begin
     Result := TDataRecord.TBuilder.Create(TDataRecordBuilder.Create);
 end;
 
+class function TDataRecord.CreateFrom<T>(const Rec: T): TDataRecord;
+var
+    ctx: TRttiContext;
+    rttiType: TRttiType;
+    builder: TBuilder.IBuilder;
+begin
+    // Create a builder to construct the TDataRecord
+    builder := CreateBuilder;
+
+    // Use RTTI to iterate over the fields of the source record/object
+    ctx := TRttiContext.Create;
+    rttiType := ctx.GetType(TypeInfo(T));
+
+    // Add each field and its value to the builder
+    for var field in rttiType.GetFields do
+    begin
+        builder.AddField(field.Name, field.GetValue(Pointer(@Rec)));
+    end;
+
+    // Create the final TDataRecord from the builder
+    builder.SetupRecord(Result.FLayout, Result.FBuffer);
+end;
+
+procedure TDataRecord.AssignTo<T>(var Rec: T);
+var
+    ctx: TRttiContext;
+    rttiType: TRttiType;
+    fieldValue: TValue;
+    fieldIndex: Integer;
+    layout: TFieldLayout;
+begin
+    Assert(FitsRecord<T>);
+
+    // Use RTTI to iterate over the fields of the destination record/object
+    ctx := TRttiContext.Create;
+    rttiType := ctx.GetType(TypeInfo(T));
+
+    for var rttiField in rttiType.GetFields do
+    begin
+        // Find the corresponding field in the TDataRecord by name
+        fieldIndex := IndexOf(rttiField.Name);
+        if fieldIndex >= 0 then
+        begin
+            layout := FLayout[fieldIndex];
+            // Create a TValue from the data in our buffer
+            TValue.Make(@FBuffer[layout.Offset], layout.TypeInfo, fieldValue);
+            // Assign the value to the destination record's field
+            rttiField.SetValue(Pointer(@Rec), fieldValue);
+        end;
+    end;
+end;
+
+function TDataRecord.FitsRecord<T>: Boolean;
+begin
+    var ctx := TRttiContext.Create;
+    var rttiType := ctx.GetType(TypeInfo(T));
+
+    for var rttiField in rttiType.GetFields do
+    begin
+        // Find the corresponding field in the TDataRecord by name
+        var fieldIndex := IndexOf(rttiField.Name);
+        if fieldIndex < 0 then
+            exit(false);
+
+        if rttiField.DataType.Handle <> FLayout[fieldIndex].TypeInfo then
+            exit(false);
+    end;
+    exit(true);
+end;
+
 function TDataRecord.GetField(const Name: String): IField;
 var
     idx: Integer;
@@ -162,12 +242,18 @@ begin
 
     Dest.FLayout := Src.FLayout;
     SetLength(Dest.FBuffer, Length(Src.FBuffer));
-    for var layout in Dest.FLayout do
+    for var i := 0 to High(Dest.FLayout) do
     begin
-        var P: PByte := @Dest.FBuffer[layout.Offset];
+        Assert(Dest.FLayout[i].Name = Src.Layout[i].Name);
-        var Q: PByte := @Src.FBuffer[layout.Offset];
+        Assert(Dest.FLayout[i].Offset = Src.Layout[i].Offset);
+        Assert(Dest.FLayout[i].Size = Src.Layout[i].Size);
+        Assert(Dest.FLayout[i].TypeInfo = Src.Layout[i].TypeInfo);
+
+        var ofs := Dest.FLayout[i].Offset;
+        var P: PByte := @Dest.FBuffer[ofs];
+        var Q: PByte := @Src.FBuffer[ofs];
         var Val: TValue;
-        TValue.Make(Q, layout.TypeInfo, val);
+        TValue.Make(Q, Dest.FLayout[i].TypeInfo, val);
         val.ExtractRawData(P);
     end;
 end;
@@ -182,6 +268,7 @@ class operator TDataRecord.Finalize(var Dest: TDataRecord);
 begin
     if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
         Exit;
+
     for var layout in Dest.FLayout do
     begin
         var P: PByte := @Dest.FBuffer[layout.Offset];

Test/MycTests.dpr

@@ -30,7 +30,8 @@ uses
     Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas',
     Myc.Mutable in '..\Src\Myc.Mutable.pas',
     Test.Core.Mutable in 'Test.Core.Mutable.pas',
-    TestDataRecord in 'TestDataRecord.pas';
+    TestDataRecord in 'TestDataRecord.pas',
+    TestDataRecord.RawAccess in 'TestDataRecord.RawAccess.pas';
 
 { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
 {$IFNDEF TESTINSIGHT}

Test/MycTests.dproj

@@ -131,6 +131,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
         <DCCReference Include="..\Src\Myc.Mutable.pas"/>
         <DCCReference Include="Test.Core.Mutable.pas"/>
         <DCCReference Include="TestDataRecord.pas"/>
+        <DCCReference Include="TestDataRecord.RawAccess.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

Test/TestDataRecord.RawAccess.pas

@@ -0,0 +1,140 @@
+unit TestDataRecord.RawAccess;
+
+interface
+
+uses
+    DUnitX.TestFramework,
+    Myc.DataRecord;
+
+type
+    [TestFixture]
+    TTestDataRecordRawAccess = class
+    public
+        [Test]
+        procedure TestRawAccess_Integer;
+        [Test]
+        procedure TestRawAccess_String;
+        [Test]
+        procedure TestRawAccess_Interface;
+    end;
+
+implementation
+
+uses
+    System.Classes;
+
+type
+    // A simple interface for testing managed type behavior.
+    IMyTestInterface = interface
+        function GetValue: integer;
+    end;
+
+    // Implementation of the test interface.
+    TMyTestInterfaceImpl = class(TInterfacedObject, IMyTestInterface)
+    private
+        FValue: Integer;
+    public
+        constructor Create(const AValue: Integer);
+        function GetValue: integer;
+    end;
+
+constructor TMyTestInterfaceImpl.Create(const AValue: Integer);
+begin
+    inherited Create;
+    FValue := AValue;
+end;
+
+function TMyTestInterfaceImpl.GetValue: integer;
+begin
+    Result := FValue;
+end;
+
+procedure TTestDataRecordRawAccess.TestRawAccess_Integer;
+var
+    rec: TDataRecord;
+    field: TDataRecord.IField;
+    readValue, newValue: Integer;
+begin
+    // Arrange: Create a record with an integer field.
+    var builder := TDataRecord.CreateBuilder;
+    builder.AddField<Integer>('IntField', 123);
+    rec := builder.CreateRec;
+    field := rec.GetField('IntField');
+    Assert.IsNotNull(field, 'Field should exist');
+
+    // Act & Assert (GetRaw): Read the initial value via raw pointer.
+    readValue := 0;
+    field.GetRaw(@readValue);
+    Assert.AreEqual(123, readValue, 'GetRaw should retrieve the correct integer value');
+
+    // Act (SetRaw): Set a new value via raw pointer.
+    newValue := 456;
+    field.SetRaw(@newValue);
+
+    // Assert: Verify the new value using the typed accessor.
+    var typedField := rec.GetField<Integer>('IntField');
+    Assert.AreEqual(456, typedField.Value, 'SetRaw should update the integer value correctly');
+end;
+
+procedure TTestDataRecordRawAccess.TestRawAccess_Interface;
+var
+    rec: TDataRecord;
+    field: TDataRecord.IField;
+    initialObj, readObj, newObj: IMyTestInterface;
+begin
+    // Arrange: Create a record with an interface field.
+    initialObj := TMyTestInterfaceImpl.Create(10);
+    var builder := TDataRecord.CreateBuilder;
+    builder.AddField<IMyTestInterface>('IField', initialObj);
+    rec := builder.CreateRec;
+    field := rec.GetField('IField');
+    Assert.IsNotNull(field, 'Field should exist');
+
+    // Act & Assert (GetRaw): Read the initial interface via raw pointer.
+    readObj := nil;
+    field.GetRaw(@readObj);
+    Assert.IsNotNull(readObj, 'GetRaw should retrieve a non-nil interface');
+    Assert.AreSame(initialObj, readObj, 'GetRaw should retrieve the same interface instance');
+    Assert.AreEqual(10, readObj.GetValue, 'Value of retrieved interface should be correct');
+
+    // Act (SetRaw): Set a new interface via raw pointer.
+    newObj := TMyTestInterfaceImpl.Create(20);
+    field.SetRaw(@newObj);
+
+    // Assert: Verify the new interface is set correctly.
+    var typedField := rec.GetField<IMyTestInterface>('IField');
+    Assert.AreSame(newObj, typedField.Value, 'SetRaw should update to the new interface instance');
+    Assert.AreEqual(20, typedField.Value.GetValue, 'Value of new interface should be correct');
+end;
+
+procedure TTestDataRecordRawAccess.TestRawAccess_String;
+var
+    rec: TDataRecord;
+    field: TDataRecord.IField;
+    readString, newString: string;
+begin
+    // Arrange: Create a record with a string field.
+    var builder := TDataRecord.CreateBuilder;
+    builder.AddField<string>('StrField', 'Hello');
+    rec := builder.CreateRec;
+    field := rec.GetField('StrField');
+    Assert.IsNotNull(field, 'Field should exist');
+
+    // Act & Assert (GetRaw): Read the initial string via raw pointer.
+    readString := '';
+    field.GetRaw(@readString);
+    Assert.AreEqual('Hello', readString, 'GetRaw should retrieve the correct string value');
+
+    // Act (SetRaw): Set a new string via raw pointer.
+    newString := 'World';
+    field.SetRaw(@newString);
+
+    // Assert: Verify the new string using the typed accessor.
+    var typedField := rec.GetField<string>('StrField');
+    Assert.AreEqual('World', typedField.Value, 'SetRaw should update the string value correctly');
+end;
+
+initialization
+    TDUnitX.RegisterTestFixture(TTestDataRecordRawAccess);
+
+end.

Test/TestDataRecord.pas

@@ -101,10 +101,19 @@ type
         procedure Test_tkVariant_Succeeds;
 
         [Test]
-        procedure TestFinalizeWithValue_True_Succeeds;
+        procedure Test_Assign_CreatesIndependentCopy;
 
         [Test]
-        procedure TestFinalizeWithValue_False_Leaks;
+        procedure Test_Reassign_ReleasesOldData;
+
+        // New tests for RTTI-based creation and assignment
+        [Test]
+        [IgnoreMemoryLeaks]
+        procedure Test_CreateFrom_AssignTo_Succeeds;
+
+        [Test]
+        [IgnoreMemoryLeaks]
+        procedure Test_Assign_FromCreateFrom_IsIndependentCopy;
     end;
 
 implementation
@@ -329,47 +338,113 @@ begin
     Assert.AreEqual(testVar, field.Value, 'Variant value should match');
 end;
 
-procedure TDataRecordTests.TestFinalizeWithValue_True_Succeeds;
+procedure TDataRecordTests.Test_Assign_CreatesIndependentCopy;
 var
-    Buffer: TBytes;
+    rec1, rec2: TDataRecord;
-    P: Pointer;
+    field1, field2: TDataRecord.IField<string>;
-    s: string;
 begin
-    // 1. Create a managed string and place it in a raw buffer
+    // Create original record
-    s := 'This is a test string that should be finalized.';
+    rec1 := CreateRecord<string>('Value', 'Original');
-    SetLength(Buffer, SizeOf(string));
-    P := @Buffer[0];
-    PString(P)^ := s;
-    s := ''; // Clear the original variable, the buffer is now the owner
 
-    // 2. Try to finalize the string in the buffer using TValue
+    // Assign to a new record, invoking operator Assign. This covers 'CreateFromRec'.
-    var Val: TValue;
+    rec2 := rec1;
-    TValue.MakeWithoutCopy(P, TypeInfo(string), Val, true);
 
-    // If 'true' works as expected (takes ownership and finalizes), this test will pass without leaks.
+    // Verify the copy
-    Assert.IsTrue(true);
+    Assert.IsTrue(Length(rec2.Layout) = 1, 'Copied record should have one field');
+    Assert.AreEqual('Value', rec2.Layout[0].Name, 'Field name should be copied');
+    field2 := rec2.GetField<string>('Value');
+    Assert.IsNotNull(field2, 'Field should exist in copied record');
+    Assert.AreEqual('Original', field2.Value, 'Field value should be copied');
+
+    // Modify the copy and check for independence (deep copy)
+    field2.Value := 'Modified';
+
+    field1 := rec1.GetField<string>('Value');
+    Assert.AreEqual('Original', field1.Value, 'Original record should not be modified');
+    Assert.AreEqual('Modified', field2.Value, 'Copied record should reflect modification');
 end;
 
-procedure TDataRecordTests.TestFinalizeWithValue_False_Leaks;
+procedure TDataRecordTests.Test_Reassign_ReleasesOldData;
 var
-    Buffer: TBytes;
+    rec1, rec2: TDataRecord;
-    P: Pointer;
+    field: TDataRecord.IField<string>;
-    s: string;
 begin
-    // 1. Create a managed string and place it in a raw buffer
+    // Create two independent records with managed string fields.
-    s := 'This string will be leaked.';
+    // DUnitX will report a leak if the memory for rec1 is not freed upon reassignment.
-    SetLength(Buffer, SizeOf(string));
+    rec1 := CreateRecord<string>('OldValue', 'This should be released');
-    P := @Buffer[0];
+    rec2 := CreateRecord<string>('NewValue', 'This should remain');
-    PString(P)^ := s;
-    s := ''; // Clear the original variable, the buffer is now the owner
 
-    // 2. Try to "finalize" the string using 'false'
+    // Re-assign rec1. This should Finalize the old rec1 and Assign the new data.
-    var Val: TValue;
+    rec1 := rec2;
-    TValue.MakeWithoutCopy(P, TypeInfo(string), Val, false);
 
-    // If 'false' does NOT take ownership, this test will report a memory leak.
+    // Verify the state of the reassigned rec1
-    //    Log.Info('This test is expected to report a memory leak.');
+    Assert.AreEqual(-1, rec1.IndexOf('OldValue'), 'Old field should not exist anymore');
-    Assert.IsTrue(true);
+    Assert.AreNotEqual(-1, rec1.IndexOf('NewValue'), 'New field should exist');
+
+    field := rec1.GetField<string>('NewValue');
+    Assert.AreEqual('This should remain', field.Value, 'Value should be from the new record');
+
+    // Also check that rec2 is unaffected by the assignment
+    field := rec2.GetField<string>('NewValue');
+    Assert.AreEqual('This should remain', field.Value, 'Source record for assignment should be unchanged');
+end;
+
+procedure TDataRecordTests.Test_CreateFrom_AssignTo_Succeeds;
+var
+    srcRec, dstRec: TTestRecord;
+    dataRec: TDataRecord;
+    fieldI: TDataRecord.IField<Integer>;
+    fieldS: TDataRecord.IField<string>;
+begin
+    // Setup a standard record with data
+    srcRec.I := 123;
+    srcRec.S := 'Hello from RTTI';
+
+    // Create a TDataRecord from the standard record via RTTI
+    dataRec := TDataRecord.CreateFrom<TTestRecord>(srcRec);
+
+    // Verify that the data was correctly transferred into the TDataRecord
+    Assert.IsTrue(Length(dataRec.Layout) = 2, 'Layout should have 2 fields');
+    fieldI := dataRec.GetField<Integer>('I');
+    Assert.IsNotNull(fieldI, 'Integer field should exist');
+    Assert.AreEqual(srcRec.I, fieldI.Value, 'Integer value should match');
+
+    fieldS := dataRec.GetField<string>('S');
+    Assert.IsNotNull(fieldS, 'String field should exist');
+    Assert.AreEqual(srcRec.S, fieldS.Value, 'String value should match');
+
+    // Assign the data back from the TDataRecord to another standard record
+    dataRec.AssignTo<TTestRecord>(dstRec);
+
+    // Verify that the data was correctly restored
+    Assert.AreEqual(srcRec.I, dstRec.I, 'Assigned back record integer should match');
+    Assert.AreEqual(srcRec.S, dstRec.S, 'Assigned back record string should match');
+end;
+
+procedure TDataRecordTests.Test_Assign_FromCreateFrom_IsIndependentCopy;
+var
+    srcRec: TTestRecord;
+    rec1, rec2: TDataRecord;
+    field1, field2: TDataRecord.IField<string>;
+begin
+    // Setup a record and create a TDataRecord from it
+    srcRec.I := 456;
+    srcRec.S := 'Original RTTI value';
+    rec1 := TDataRecord.CreateFrom<TTestRecord>(srcRec);
+
+    // Assign the TDataRecord to another, invoking operator Assign
+    rec2 := rec1;
+
+    // Modify the string field in the copy
+    field2 := rec2.GetField<string>('S');
+    Assert.IsNotNull(field2, 'Field must exist in copy');
+    field2.Value := 'Modified in copy';
+
+    // Verify that the original TDataRecord is unchanged
+    field1 := rec1.GetField<string>('S');
+    Assert.IsNotNull(field1, 'Field must exist in original');
+    Assert.AreEqual('Original RTTI value', field1.Value, 'Original record should not be modified');
+    Assert.AreEqual('Modified in copy', field2.Value, 'Copied record should reflect modification');
 end;
 
 { TTestClass }