Reworking DataRecords and DataFlow
This commit is contained in:
Michael Schimmel
+42
-11
@@ -12,7 +12,7 @@ type
|
||||
TDataRecord = record
|
||||
public
|
||||
type
|
||||
TFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
|
||||
TFieldType = (dfFloat, dfInteger, dfString, dfTimestamp, dfRecord);
|
||||
|
||||
TField = record
|
||||
private
|
||||
@@ -66,9 +66,6 @@ type
|
||||
FLayout: TLayout;
|
||||
FBuffer: TBytes;
|
||||
|
||||
const
|
||||
DataSize: array[TFieldType] of Integer = (sizeof(Double), sizeof(Int64), sizeof(String), sizeof(TDateTime));
|
||||
|
||||
public
|
||||
constructor Create(const ALayout: TLayout; const ABuffer: TBytes = nil);
|
||||
class operator Finalize(var Dest: TDataRecord);
|
||||
@@ -87,6 +84,10 @@ type
|
||||
property Layout: TLayout read FLayout;
|
||||
end;
|
||||
|
||||
const
|
||||
DataSize: array[TDataRecord.TFieldType] of Integer =
|
||||
(sizeof(Double), sizeof(Int64), sizeof(String), sizeof(TDateTime), sizeof(TDataRecord));
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@@ -152,6 +153,7 @@ begin
|
||||
dfInteger: Int64(Value) := PInt64(Value)^;
|
||||
dfString: String(Value) := PString(Value)^;
|
||||
dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
|
||||
dfRecord: TDataRecord(Value) := TDataRecord(Value);
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -165,6 +167,7 @@ begin
|
||||
dfInteger: PInt64(P)^ := Int64(Value);
|
||||
dfString: PString(P)^ := String(Value);
|
||||
dfTimestamp: PDateTime(P)^ := TDateTime(Value);
|
||||
dfRecord: TDataRecord(P^) := TDataRecord(Value);
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -199,7 +202,7 @@ end;
|
||||
|
||||
procedure TDataRecord.TField.Finalize(const [ref] Buffer: TBytes);
|
||||
begin
|
||||
if not (FFieldType in [dfString]) then
|
||||
if not (FFieldType in [dfString, dfRecord]) then
|
||||
exit;
|
||||
|
||||
Assert(FOffset + Size <= Length(Buffer));
|
||||
@@ -207,6 +210,7 @@ begin
|
||||
var P := @Buffer[FOffset];
|
||||
case FFieldType of
|
||||
dfString: PString(P)^ := '';
|
||||
dfRecord: TDataRecord(P^) := Default(TDataRecord);
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -245,8 +249,15 @@ begin
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(SrcType.Kind = tkFloat);
|
||||
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDateTime)).Name);
|
||||
PDateTime(Dst)^ := PDateTime(@Src)^;
|
||||
end;
|
||||
dfRecord:
|
||||
begin
|
||||
Assert(SrcType = TypeInfo(TDataRecord));
|
||||
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDataRecord)).Name);
|
||||
TDataRecord(Dst^) := TDataRecord(Src);
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -293,8 +304,14 @@ begin
|
||||
dfTimestamp:
|
||||
begin
|
||||
Assert(DstType.Kind = tkFloat);
|
||||
Assert(DstType.Name = PTypeInfo(TypeInfo(TDateTime)).Name);
|
||||
PDateTime(@Dst)^ := PDateTime(Src)^;
|
||||
end;
|
||||
dfRecord:
|
||||
begin
|
||||
Assert(DstType = TypeInfo(TDataRecord));
|
||||
TDataRecord(Dst) := TDataRecord(Src^);
|
||||
end;
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -312,6 +329,7 @@ begin
|
||||
dfInteger: PInt64(Dst)^ := PInt64(@Src)^;
|
||||
dfString: PString(Dst)^ := PString(@Src)^;
|
||||
dfTimestamp: PDateTime(Dst)^ := PDateTime(@Src)^;
|
||||
dfRecord: TDataRecord(Dst^) := TDataRecord(Src);
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
@@ -350,19 +368,32 @@ begin
|
||||
for var i := 0 to High(rttiFields) do
|
||||
begin
|
||||
var rf := rttiFields[i];
|
||||
var ft: TFieldType := Default(TFieldType);
|
||||
var supported := true;
|
||||
|
||||
case rf.FieldType.TypeKind of
|
||||
tkInteger, tkInt64: fields[i] := TField.Create(rf.Name, dfInteger, ofs);
|
||||
tkInteger, tkInt64: ft := dfInteger;
|
||||
tkFloat:
|
||||
if SameText(rf.FieldType.Name, 'TDateTime') then
|
||||
fields[i] := TField.Create(rf.Name, dfTimestamp, ofs)
|
||||
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then
|
||||
ft := dfTimestamp
|
||||
else
|
||||
fields[i] := TField.Create(rf.Name, dfFloat, ofs);
|
||||
tkString, tkWString, tkLString, tkUString: fields[i] := TField.Create(rf.Name, dfString, ofs);
|
||||
ft := dfFloat;
|
||||
tkString, tkWString, tkLString, tkUString: ft := dfString;
|
||||
tkMRecord:
|
||||
begin
|
||||
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDataRecord))) then
|
||||
ft := dfRecord
|
||||
else
|
||||
supported := false;
|
||||
end;
|
||||
else
|
||||
raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');
|
||||
supported := false;
|
||||
end;
|
||||
|
||||
if not supported then
|
||||
raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');
|
||||
|
||||
fields[i] := TField.Create(rf.Name, ft, ofs);
|
||||
inc(ofs, fields[i].AlignedSize);
|
||||
end;
|
||||
|
||||
|
||||
@@ -242,6 +242,7 @@ uses
|
||||
System.RTTI,
|
||||
System.DateUtils,
|
||||
System.Math,
|
||||
Winapi.Windows,
|
||||
Myc.TaskManager;
|
||||
|
||||
{ TMycProcessor<T> }
|
||||
|
||||
+7
-1
@@ -90,6 +90,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||
<DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>
|
||||
<DCC_RangeChecking>true</DCC_RangeChecking>
|
||||
<DCC_Inlining>off</DCC_Inlining>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||
@@ -151,7 +152,12 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<Source>
|
||||
<Source Name="MainSource">MycTests.dpr</Source>
|
||||
</Source>
|
||||
<Excluded_Packages/>
|
||||
<Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
</Delphi.Personality>
|
||||
<Deployment Version="5">
|
||||
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
|
||||
|
||||
+92
-4
@@ -18,13 +18,23 @@ type
|
||||
MyDouble: Double;
|
||||
MyString: string;
|
||||
MyTimestamp: TDateTime;
|
||||
MyRecord: TDataRecord;
|
||||
end;
|
||||
|
||||
// A simple record to be nested inside another
|
||||
TNestedTestRecord = record
|
||||
NestedValue: Integer;
|
||||
NestedString: string;
|
||||
end;
|
||||
|
||||
// A record that contains another record field of type TDataRecord
|
||||
TOuterTestRecord = record
|
||||
OuterValue: Integer;
|
||||
MyNestedRecord: TDataRecord;
|
||||
end;
|
||||
|
||||
[TestFixture]
|
||||
TTestDataRecord = class(TObject)
|
||||
private
|
||||
FCtx: TRttiContext;
|
||||
|
||||
public
|
||||
[Test]
|
||||
[IgnoreMemoryLeaks]
|
||||
@@ -37,6 +47,14 @@ type
|
||||
[Test]
|
||||
[IgnoreMemoryLeaks]
|
||||
procedure TestSetValueAndGetValue;
|
||||
|
||||
[Test]
|
||||
// [IgnoreMemoryLeaks]
|
||||
procedure TestNestedDataRecord;
|
||||
|
||||
[Test]
|
||||
// [IgnoreMemoryLeaks]
|
||||
procedure TestNestedSetValueAndGetValue;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -52,7 +70,7 @@ begin
|
||||
layout := TDataRecord.TLayout.FromRecord<TMyTestRecord>;
|
||||
|
||||
// Assert: Check field count
|
||||
Assert.IsTrue(Length(layout.Fields) = 6, 'Layout should have 6 fields');
|
||||
Assert.IsTrue(Length(layout.Fields) = 7, 'Layout should have 7 fields');
|
||||
|
||||
// Assert: Check specific fields for correct type mapping
|
||||
idx := layout.IndexOf('MyTimestamp');
|
||||
@@ -70,6 +88,10 @@ begin
|
||||
idx := layout.IndexOf('MySingle');
|
||||
Assert.IsTrue(idx > -1, 'Field MySingle not found');
|
||||
Assert.AreEqual(TDataRecord.TFieldType.dfFloat, layout.Fields[idx].FieldType, 'MySingle should be mapped to dfFloat');
|
||||
|
||||
idx := layout.IndexOf('MyRecord');
|
||||
Assert.IsTrue(idx > -1, 'Field MyRecord not found');
|
||||
Assert.AreEqual(TDataRecord.TFieldType.dfRecord, layout.Fields[idx].FieldType, 'MyRecord should be mapped to dfRecord');
|
||||
end;
|
||||
|
||||
procedure TTestDataRecord.TestCreateFromInstanceAndGetValue;
|
||||
@@ -84,6 +106,7 @@ begin
|
||||
srcRecord.MyDouble := 789.012345;
|
||||
srcRecord.MyString := 'Hello Delphi!';
|
||||
srcRecord.MyTimestamp := EncodeDateTime(2024, 7, 19, 10, 30, 0, 0);
|
||||
srcRecord.MyRecord := default(TDataRecord); // Not testing nested here
|
||||
|
||||
// Test: Create a TDataRecord from the source record instance
|
||||
dataRecord := TDataRecord.FromRecord<TMyTestRecord>(srcRecord);
|
||||
@@ -141,6 +164,71 @@ begin
|
||||
Assert.AreEqual(testDouble, dataRecord.GetValue<Double>('MyDouble'), 1e-9, 'SetValue failed for Double');
|
||||
end;
|
||||
|
||||
procedure TTestDataRecord.TestNestedDataRecord;
|
||||
var
|
||||
nestedSrc: TNestedTestRecord;
|
||||
nestedDataRecord: TDataRecord;
|
||||
outerSrc: TOuterTestRecord;
|
||||
mainDataRecord: TDataRecord;
|
||||
retrievedNestedRecord: TDataRecord;
|
||||
begin
|
||||
// Setup: Create the nested record and convert it to a TDataRecord
|
||||
nestedSrc.NestedValue := 999;
|
||||
nestedSrc.NestedString := 'Nested Record Test';
|
||||
nestedDataRecord := TDataRecord.FromRecord<TNestedTestRecord>(nestedSrc);
|
||||
|
||||
// Setup: Create the outer record containing the nested TDataRecord
|
||||
outerSrc.OuterValue := 111;
|
||||
outerSrc.MyNestedRecord := nestedDataRecord;
|
||||
|
||||
// Test: Create the main TDataRecord from the outer record instance
|
||||
mainDataRecord := TDataRecord.FromRecord<TOuterTestRecord>(outerSrc);
|
||||
|
||||
// Assert: Retrieve the nested record and check its contents
|
||||
retrievedNestedRecord := mainDataRecord.GetValue<TDataRecord>('MyNestedRecord');
|
||||
|
||||
Assert.IsNotNull(retrievedNestedRecord.Layout.Fields, 'Nested record layout should not be nil');
|
||||
Assert.IsTrue(Length(retrievedNestedRecord.Layout.Fields) = 2, 'Nested record should have 2 fields');
|
||||
|
||||
// Assert values within the nested record
|
||||
Assert.AreEqual(999, retrievedNestedRecord.GetValue<Integer>('NestedValue'), 'Nested integer value mismatch');
|
||||
Assert.AreEqual('Nested Record Test', retrievedNestedRecord.GetValue<string>('NestedString'), 'Nested string value mismatch');
|
||||
|
||||
// Assert value in the outer record
|
||||
Assert.AreEqual(111, mainDataRecord.GetValue<Integer>('OuterValue'), 'Outer integer value mismatch');
|
||||
end;
|
||||
|
||||
procedure TTestDataRecord.TestNestedSetValueAndGetValue;
|
||||
var
|
||||
outerRecord: TDataRecord;
|
||||
nestedRecord: TDataRecord;
|
||||
retrievedNestedRecord: TDataRecord;
|
||||
begin
|
||||
// Setup: Create an empty TDataRecord for the outer structure
|
||||
outerRecord := TDataRecord.FromRecord<TOuterTestRecord>;
|
||||
|
||||
// Setup: Create a TDataRecord for the nested structure and populate it
|
||||
nestedRecord := TDataRecord.FromRecord<TNestedTestRecord>;
|
||||
nestedRecord.SetValue<Integer>('NestedValue', 888);
|
||||
nestedRecord.SetValue<string>('NestedString', 'Manual Nested Set');
|
||||
|
||||
// Test: Set the nested record and another value in the outer record
|
||||
outerRecord.SetValue<Integer>('OuterValue', 222);
|
||||
outerRecord.SetValue<TDataRecord>('MyNestedRecord', nestedRecord);
|
||||
|
||||
// Assert: Retrieve the nested record and check its contents
|
||||
retrievedNestedRecord := outerRecord.GetValue<TDataRecord>('MyNestedRecord');
|
||||
Assert.IsNotNull(retrievedNestedRecord.Layout.Fields, 'Retrieved nested record layout should not be nil');
|
||||
Assert.IsTrue(Length(retrievedNestedRecord.Layout.Fields) = 2, 'Retrieved nested record should have 2 fields');
|
||||
|
||||
Assert.AreEqual(888, retrievedNestedRecord.GetValue<Integer>('NestedValue'), 'Nested integer check failed after SetValue');
|
||||
Assert
|
||||
.AreEqual('Manual Nested Set', retrievedNestedRecord.GetValue<string>('NestedString'), 'Nested string check failed after SetValue');
|
||||
|
||||
// Assert: Check the outer value as well
|
||||
Assert.AreEqual(222, outerRecord.GetValue<Integer>('OuterValue'), 'Outer value check failed after SetValue');
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TTestDataRecord);
|
||||
|
||||
|
||||
Reference in New Issue
Block a user