diff --git a/AuraTrader/MainForm.fmx b/AuraTrader/MainForm.fmx index 2e0137d..20bd505 100644 --- a/AuraTrader/MainForm.fmx +++ b/AuraTrader/MainForm.fmx @@ -205,7 +205,6 @@ object Form1: TForm1 TabOrder = 0 Text = 'Button1' TextSettings.Trimming = None - OnClick = Button1Click end end end diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas index a2ee86e..c5cb176 100644 --- a/AuraTrader/MainForm.pas +++ b/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; procedure AlignControl(Control: TControl); function CreateStrategy2(Timeframe: TTimeframe): IMycProcessor>; + 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>; type TSignal = record diff --git a/Src/Myc.DataRecord.Impl.pas b/Src/Myc.DataRecord.Impl.pas index 6602eac..25bc6de 100644 --- a/Src/Myc.DataRecord.Impl.pas +++ b/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>; public diff --git a/Src/Myc.DataRecord.pas b/Src/Myc.DataRecord.pas index ff22441..5b88950 100644 --- a/Src/Myc.DataRecord.pas +++ b/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; out Buffer: TBytes); - end; - // The interface helper record that provides the generic AddField method. TBuilder = record + type + IBuilder = interface + procedure AddField(const Name: String; const Value: TValue); overload; + procedure SetupRecord(out Layout: TArray; 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(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(const Name: String); overload; inline; + procedure AddField(const Name: String; const Value: T); overload; inline; + + function CreateRec: TDataRecord; inline; end; private FLayout: TArray; 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(const Rec: T): TDataRecord; static; + procedure AssignTo(var Rec: T); + function FitsRecord: Boolean; + function IndexOf(const Name: String): Integer; function GetField(const Name: String): IField; overload; function GetField(const Name: String): IField; overload; + property Layout: TArray read FLayout; end; @@ -90,6 +95,11 @@ begin FBuilder.AddField(Name, TValue.From(Value)); end; +procedure TDataRecord.TBuilder.AddField(const Name: String); +begin + AddField(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(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(var Rec: T); +var + ctx: TRttiContext; + rttiType: TRttiType; + fieldValue: TValue; + fieldIndex: Integer; + layout: TFieldLayout; +begin + Assert(FitsRecord); + + // 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: 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]; - var Q: PByte := @Src.FBuffer[layout.Offset]; + Assert(Dest.FLayout[i].Name = Src.Layout[i].Name); + 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]; diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 81ac9d0..d8677e5 100644 --- a/Test/MycTests.dpr +++ b/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} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index a956259..a85868c 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -131,6 +131,7 @@ $(PreBuildEvent)]]> + Base diff --git a/Test/TestDataRecord.RawAccess.pas b/Test/TestDataRecord.RawAccess.pas new file mode 100644 index 0000000..63c12c7 --- /dev/null +++ b/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('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('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('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('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('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('StrField'); + Assert.AreEqual('World', typedField.Value, 'SetRaw should update the string value correctly'); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestDataRecordRawAccess); + +end. diff --git a/Test/TestDataRecord.pas b/Test/TestDataRecord.pas index 0996a47..7139c57 100644 --- a/Test/TestDataRecord.pas +++ b/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; - P: Pointer; - s: string; + rec1, rec2: TDataRecord; + field1, field2: TDataRecord.IField; begin - // 1. Create a managed string and place it in a raw buffer - s := 'This is a test string that should be finalized.'; - SetLength(Buffer, SizeOf(string)); - P := @Buffer[0]; - PString(P)^ := s; - s := ''; // Clear the original variable, the buffer is now the owner + // Create original record + rec1 := CreateRecord('Value', 'Original'); - // 2. Try to finalize the string in the buffer using TValue - var Val: TValue; - TValue.MakeWithoutCopy(P, TypeInfo(string), Val, true); + // Assign to a new record, invoking operator Assign. This covers 'CreateFromRec'. + rec2 := rec1; - // If 'true' works as expected (takes ownership and finalizes), this test will pass without leaks. - Assert.IsTrue(true); + // Verify the copy + 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('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('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; - P: Pointer; - s: string; + rec1, rec2: TDataRecord; + field: TDataRecord.IField; begin - // 1. Create a managed string and place it in a raw buffer - s := 'This string will be leaked.'; - SetLength(Buffer, SizeOf(string)); - P := @Buffer[0]; - PString(P)^ := s; - s := ''; // Clear the original variable, the buffer is now the owner + // Create two independent records with managed string fields. + // DUnitX will report a leak if the memory for rec1 is not freed upon reassignment. + rec1 := CreateRecord('OldValue', 'This should be released'); + rec2 := CreateRecord('NewValue', 'This should remain'); - // 2. Try to "finalize" the string using 'false' - var Val: TValue; - TValue.MakeWithoutCopy(P, TypeInfo(string), Val, false); + // Re-assign rec1. This should Finalize the old rec1 and Assign the new data. + rec1 := rec2; - // If 'false' does NOT take ownership, this test will report a memory leak. - // Log.Info('This test is expected to report a memory leak.'); - Assert.IsTrue(true); + // Verify the state of the reassigned rec1 + Assert.AreEqual(-1, rec1.IndexOf('OldValue'), 'Old field should not exist anymore'); + Assert.AreNotEqual(-1, rec1.IndexOf('NewValue'), 'New field should exist'); + + field := rec1.GetField('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('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; + fieldS: TDataRecord.IField; +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(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('I'); + Assert.IsNotNull(fieldI, 'Integer field should exist'); + Assert.AreEqual(srcRec.I, fieldI.Value, 'Integer value should match'); + + fieldS := dataRec.GetField('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(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; +begin + // Setup a record and create a TDataRecord from it + srcRec.I := 456; + srcRec.S := 'Original RTTI value'; + rec1 := TDataRecord.CreateFrom(srcRec); + + // Assign the TDataRecord to another, invoking operator Assign + rec2 := rec1; + + // Modify the string field in the copy + field2 := rec2.GetField('S'); + Assert.IsNotNull(field2, 'Field must exist in copy'); + field2.Value := 'Modified in copy'; + + // Verify that the original TDataRecord is unchanged + field1 := rec1.GetField('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 }