Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Testing data processing

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-27 08:39:16 +02:00
parent aa53a88953
commit 468adcf203
8 changed files with 261 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Data.Records.pas
+82 -50
View File
@@ -15,11 +15,12 @@ type
TField = record
private
FFieldType: TFieldType;
FTypeInfo: PtypeInfo;
FName: string;
FOffset: Integer;
procedure FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src);
procedure ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst);
procedure FromType(const [ref] Buffer: TBytes; const Src);
procedure ToType(const [ref] Buffer: TBytes; var Dst);
procedure InitField(const [ref] Buffer: TBytes);
procedure AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
@@ -29,7 +30,7 @@ type
property Offset: Integer read FOffset;
constructor Create(const AName: string; AFieldType: TFieldType; AOffset: Integer);
constructor Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
function GetSize: Integer; inline;
function GetAlignedSize: Integer; inline;
@@ -39,6 +40,7 @@ type
property Name: string read FName;
property Size: Integer read GetSize;
property AlignedSize: Integer read GetAlignedSize;
property TypeInfo: PTypeInfo read FTypeInfo;
end;
TFieldDef = record
@@ -67,6 +69,7 @@ type
private
FLayout: TLayout;
FBuffer: TBytes;
function GetRawData: Pointer; inline;
public
constructor Create(const ALayout: TLayout);
@@ -77,14 +80,18 @@ type
class function FromRecord<T>: TDataRecord; overload; static;
class function FromRecord<T>(const Src: T): TDataRecord; overload; static;
procedure CopyFrom<T>(const Src: T);
procedure SetValue<T>(const Name: String; const Value: T); overload;
procedure SetValue(Idx: Integer; const Value); overload;
function GetValue<T>(const Name: String): T; overload;
procedure GetValue(Idx: Integer; out Value); overload;
function GetValueRef(Idx: Integer): Pointer; overload;
procedure CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
property RawData: Pointer read GetRawData;
property Layout: TLayout read FLayout;
end;
@@ -113,6 +120,19 @@ begin
FLayout.Fields[i].InitField(FBuffer);
end;
procedure TDataRecord.CopyFrom<T>(const Src: T);
begin
var ctx := TRttiContext.Create;
var rttiType := ctx.GetType(TypeInfo(T));
for var i := 0 to High(FLayout.FFields) do
begin
var P: PByte := @Src;
inc(P, FLayout.Fields[i].Offset);
FLayout.Fields[i].FromType(FBuffer, Src);
end;
end;
procedure TDataRecord.CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
begin
Assert(SrcRec.Layout.Fields[SrcIdx].FieldType = FLayout.Fields[SrcIdx].FieldType);
@@ -131,24 +151,12 @@ end;
class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord;
begin
Result.Create(TLayout.FromRecord<T>);
Result.CopyFrom<T>(Src);
end;
var ctx := TRttiContext.Create;
var rttiType := ctx.GetType(TypeInfo(T));
var rttiFields := rttiType.GetFields;
var fields: TArray<TField>;
for var i := 0 to High(rttiFields) do
begin
var rf := rttiFields[i];
var idx := Result.Layout.IndexOf(rf.Name);
if (idx >= 0) then
begin
var S: PByte := @Src;
inc(S, rf.Offset);
Result.Layout.Fields[idx].FromType(Result.FBuffer, rf.FieldType.Handle, S^);
end;
end;
function TDataRecord.GetRawData: Pointer;
begin
Result := @FBuffer[0];
end;
procedure TDataRecord.GetValue(Idx: Integer; out Value);
@@ -183,14 +191,25 @@ function TDataRecord.GetValue<T>(const Name: String): T;
begin
var idx := FLayout.IndexOf(Name);
if (idx >= 0) then
FLayout.Fields[idx].ToType(FBuffer, TypeInfo(T), Result);
begin
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
FLayout.Fields[idx].ToType(FBuffer, Result);
end;
end;
function TDataRecord.GetValueRef(Idx: Integer): Pointer;
begin
Result := @FBuffer[FLayout.Fields[Idx].Offset];
end;
procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
begin
var idx := FLayout.IndexOf(Name);
if (idx >= 0) then
FLayout.Fields[idx].FromType(FBuffer, TypeInfo(T), Value);
begin
Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
FLayout.Fields[idx].FromType(FBuffer, Value);
end;
end;
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
@@ -211,11 +230,12 @@ begin
Dest.Layout.Fields[i].FinalizeField(Dest.FBuffer);
end;
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; AOffset: Integer);
constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
begin
FName := AName;
FFieldType := AFieldType;
FOffset := AOffset;
FTypeInfo := ATypeInfo;
end;
procedure TDataRecord.TField.InitField(const [ref] Buffer: TBytes);
@@ -246,7 +266,7 @@ begin
end;
end;
procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; SrcType: PTypeInfo; const Src);
procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; const Src);
begin
Assert(FOffset + Size <= Length(Buffer));
@@ -254,9 +274,9 @@ begin
case FFieldType of
dfFloat:
begin
Assert(SrcType.Kind = tkFloat);
case GetTypeData(SrcType).FloatType of
ftSingle: PDouble(Dst)^ := PSingle(@Src)^;
Assert(FTypeInfo.Kind = tkFloat);
case GetTypeData(FTypeInfo).FloatType of
ftSingle: PSingle(Dst)^ := PSingle(@Src)^;
ftDouble: PDouble(Dst)^ := PDouble(@Src)^;
else
Assert(false);
@@ -264,8 +284,8 @@ begin
end;
dfInteger:
begin
case SrcType.Kind of
tkInteger: PInt64(Dst)^ := PInteger(@Src)^;
case FTypeInfo.Kind of
tkInteger: PInteger(Dst)^ := PInteger(@Src)^;
tkInt64: PInt64(Dst)^ := PInt64(@Src)^;
else
Assert(false);
@@ -273,19 +293,19 @@ begin
end;
dfString:
begin
Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]);
Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
PString(Dst)^ := PString(@Src)^;
end;
dfTimestamp:
begin
Assert(SrcType.Kind = tkFloat);
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDateTime)).Name);
Assert(FTypeInfo.Kind = tkFloat);
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
PDateTime(Dst)^ := PDateTime(@Src)^;
end;
dfRecord:
begin
Assert(SrcType = TypeInfo(TDataRecord));
Assert(SrcType.Name = PTypeInfo(TypeInfo(TDataRecord)).Name);
Assert(FTypeInfo = System.TypeInfo(TDataRecord));
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
TDataRecord(Dst^) := TDataRecord(Src);
end;
else
@@ -303,15 +323,15 @@ begin
Result := (GetSize + (Align - 1)) and not (Align - 1);
end;
procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; DstType: PTypeInfo; var Dst);
procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; var Dst);
begin
var Src := @Buffer[FOffset];
case FFieldType of
dfFloat:
begin
Assert(DstType.Kind = tkFloat);
case GetTypeData(DstType).FloatType of
ftSingle: PSingle(@Dst)^ := PDouble(Src)^;
Assert(FTypeInfo.Kind = tkFloat);
case GetTypeData(FTypeInfo).FloatType of
ftSingle: PSingle(@Dst)^ := PSingle(Src)^;
ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
else
Assert(false);
@@ -319,8 +339,8 @@ begin
end;
dfInteger:
begin
case DstType.Kind of
tkInteger: PInteger(@Dst)^ := PInt64(Src)^;
case FTypeInfo.Kind of
tkInteger: PInteger(@Dst)^ := PInteger(Src)^;
tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
else
Assert(false);
@@ -328,18 +348,18 @@ begin
end;
dfString:
begin
Assert(DstType.Kind in [tkString, tkLString, tkUString, tkWString]);
Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
PString(@Dst)^ := PString(Src)^;
end;
dfTimestamp:
begin
Assert(DstType.Kind = tkFloat);
Assert(DstType.Name = PTypeInfo(TypeInfo(TDateTime)).Name);
Assert(FTypeInfo.Kind = tkFloat);
Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
PDateTime(@Dst)^ := PDateTime(Src)^;
end;
dfRecord:
begin
Assert(DstType = TypeInfo(TDataRecord));
Assert(FTypeInfo = System.TypeInfo(TDataRecord));
TDataRecord(Dst) := TDataRecord(Src^);
end;
else
@@ -383,9 +403,20 @@ begin
var ofs := 0;
for var i := 0 to High(Fields) do
begin
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ofs);
var ti: PTypeInfo;
case Def[i].FieldType of
dfFloat: ti := TypeInfo(Double);
dfInteger: ti := TypeInfo(Int64);
dfString: ti := TypeInfo(String);
dfTimestamp: ti := TypeInfo(TDateTime);
dfRecord: ti := TypeInfo(TDataRecord);
end;
Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ti, ofs);
inc(ofs, Fields[i].AlignedSize);
end;
Result.Create(Fields);
end;
{ TLayout }
@@ -398,7 +429,7 @@ begin
var fields: TArray<TField>;
// Add each field and its value to the builder
var ofs := 0;
// The internal layout has to be the same as the original record
SetLength(fields, Length(rttiFields));
for var i := 0 to High(rttiFields) do
begin
@@ -407,12 +438,14 @@ begin
var supported := true;
case rf.FieldType.TypeKind of
tkInteger, tkInt64: ft := dfInteger;
tkInt64: ft := dfInteger;
tkFloat:
if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then
ft := dfTimestamp
else if GetTypeData(rf.FieldType.Handle).FloatType = ftDouble then
ft := dfFloat
else
ft := dfFloat;
supported := false;
tkString, tkWString, tkLString, tkUString: ft := dfString;
tkMRecord:
begin
@@ -428,8 +461,7 @@ begin
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);
fields[i] := TField.Create(rf.Name, ft, rf.FieldType.Handle, rf.Offset);
end;
Result.Create(fields);