From 947060566d488e87e734c416df35b1a13018abc4 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 25 Aug 2025 18:00:15 +0200 Subject: [PATCH] Data Types --- KI/Prompt-Delphi-Entwicklung.md | 2 + Src/Data/Myc.Data.Types.Arrays.pas | 56 ++++-- Src/Data/Myc.Data.Types.Enum.pas | 9 + Src/Data/Myc.Data.Types.Float.pas | 39 +++- Src/Data/Myc.Data.Types.Ordinal.pas | 58 ++++++ Src/Data/Myc.Data.Types.Records.pas | 61 ++++++- Src/Data/Myc.Data.Types.Text.pas | 17 ++ Src/Data/Myc.Data.Types.Timestamp.pas | 9 + Src/Data/Myc.Data.Types.Tuple.pas | 86 +++++++++ Src/Data/Myc.Data.Types.pas | 86 ++++++++- Src/Data/TestDataTypes.pas | 247 ++++++++++++++++++++++++-- 11 files changed, 642 insertions(+), 28 deletions(-) diff --git a/KI/Prompt-Delphi-Entwicklung.md b/KI/Prompt-Delphi-Entwicklung.md index aa80075..897f9ad 100644 --- a/KI/Prompt-Delphi-Entwicklung.md +++ b/KI/Prompt-Delphi-Entwicklung.md @@ -68,6 +68,8 @@ * Interfaces benötigen keine GUIDs. Füge keine GUIDs in Interfaces ein und schlagen Sie dies auch nicht vor. Wenn ein gegebenes Interface keine GUID hat, ist das so gewollt. GUIDs werden ausschließlich von mir vergeben. Füge niemals selbst eine GUID hinzu. +* Interfaces sind reference counted! Einfaches atomares Locking (z.B. CompareExchange) funktioniert nicht und führt zu bösen Crashes! + * TThread ist in System.Classes definiert. * TInterlocked ist in System.SyncObjs definiert. diff --git a/Src/Data/Myc.Data.Types.Arrays.pas b/Src/Data/Myc.Data.Types.Arrays.pas index 79d1fb1..08bda5c 100644 --- a/Src/Data/Myc.Data.Types.Arrays.pas +++ b/Src/Data/Myc.Data.Types.Arrays.pas @@ -24,7 +24,8 @@ type implementation uses - System.SyncObjs; + System.SyncObjs, + System.Rtti; type // Implements the array data value. @@ -34,6 +35,7 @@ type FItems: TArray; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetElementCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -42,10 +44,15 @@ type // Optimized implementation for an array with 0 elements. TDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue) + strict private + class var + FEmptyTValue: TValue; // Singleton TValue for an empty array + class constructor CreateClass; private FArrayType: IDataArrayType; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetElementCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -59,6 +66,7 @@ type FItem0: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetElementCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -104,6 +112,17 @@ begin end; end; +function TDataArrayValue.AsTValue: TValue; +var + tvalueArray: TArray; + i: Integer; +begin + SetLength(tvalueArray, Length(FItems)); + for i := 0 to High(FItems) do + tvalueArray[i] := FItems[i].AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataArrayValue.GetElementCount: Integer; begin Result := Length(FItems); @@ -116,6 +135,12 @@ end; { TDataArrayValue0 } +class constructor TDataArrayValue0.CreateClass; +begin + // Create a singleton TValue representing an empty dynamic array. + FEmptyTValue := TValue.From>([]); +end; + constructor TDataArrayValue0.Create(const AArrayType: IDataArrayType); begin inherited Create; @@ -127,6 +152,11 @@ begin Result := '[]'; end; +function TDataArrayValue0.AsTValue: TValue; +begin + Result := FEmptyTValue; +end; + function TDataArrayValue0.GetDataType: IDataType; begin Result := FArrayType; @@ -156,6 +186,15 @@ begin Result := '[' + FItem0.AsString + ']'; end; +function TDataArrayValue1.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 1); + tvalueArray[0] := FItem0.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataArrayValue1.GetDataType: IDataType; begin Result := FArrayType; @@ -181,14 +220,13 @@ constructor TDataArrayType.Create(const AElementType: IDataType); begin inherited Create; FElementType := AElementType; - FEmptyValue := nil; + FEmptyValue := TDataArrayValue0.Create(Self); end; function TDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue; var item: IDataValue; i: Integer; - newValue: IDataArrayValue; begin // Validate that all items match the element type of this array type. i := 0; @@ -203,17 +241,7 @@ begin // Use optimized implementations for arrays with 0 or 1 elements. case Length(AItems) of - 0: - begin - // Thread-safe lazy initialization for the cached empty array value. - if FEmptyValue = nil then - begin - newValue := TDataArrayValue0.Create(Self); - if TInterlocked.CompareExchange(Pointer(FEmptyValue), Pointer(newValue), nil) <> nil then - newValue := nil; // Another thread won, discard our instance. - end; - Result := FEmptyValue; - end; + 0: Result := FEmptyValue; 1: Result := TDataArrayValue1.Create(Self, AItems); else // Use the generic implementation for arrays with more than 1 element. diff --git a/Src/Data/Myc.Data.Types.Enum.pas b/Src/Data/Myc.Data.Types.Enum.pas index c45d999..efd69ee 100644 --- a/Src/Data/Myc.Data.Types.Enum.pas +++ b/Src/Data/Myc.Data.Types.Enum.pas @@ -27,6 +27,9 @@ type implementation +uses + System.Rtti; + type TDataEnumValue = class(TInterfacedObject, IDataEnumValue) private @@ -35,6 +38,7 @@ type function GetDataType: IDataType; function GetAsString: string; function GetValue: Integer; + function AsTValue: TValue; public constructor Create(const ADataType: IDataEnumType; const AValue: Integer); end; @@ -130,4 +134,9 @@ begin Result := FValue; end; +function TDataEnumValue.AsTValue: TValue; +begin + Result := TValue.From(FValue); +end; + end. diff --git a/Src/Data/Myc.Data.Types.Float.pas b/Src/Data/Myc.Data.Types.Float.pas index 77602ea..f9b3a50 100644 --- a/Src/Data/Myc.Data.Types.Float.pas +++ b/Src/Data/Myc.Data.Types.Float.pas @@ -25,7 +25,8 @@ type implementation uses - System.Math; + System.Math, + System.Rtti; type // Implements the float data value. @@ -38,6 +39,7 @@ type // IDataValue function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; // IDataFloatValue function GetValue: Double; @@ -45,18 +47,28 @@ type // Special implementation for the value 0.0 (Singleton) TDataFloatValueZero = class(TInterfacedObject, IDataValue, IDataFloatValue) + strict private + class var + FValue: TValue; + class constructor CreateClass; public function GetDataType: IDataType; function GetAsString: string; function GetValue: Double; + function AsTValue: TValue; end; // Special implementation for NaN (Not a Number) (Singleton) TDataFloatValueNaN = class(TInterfacedObject, IDataValue, IDataFloatValue) + strict private + class var + FValue: TValue; + class constructor CreateClass; public function GetDataType: IDataType; function GetAsString: string; function GetValue: Double; + function AsTValue: TValue; end; { TDataFloatValue } @@ -77,6 +89,11 @@ begin Result := FloatToStr(FValue); end; +function TDataFloatValue.AsTValue: TValue; +begin + Result := TValue.From(FValue); +end; + function TDataFloatValue.GetValue: Double; begin Result := FValue; @@ -84,6 +101,11 @@ end; { TDataFloatValueZero } +class constructor TDataFloatValueZero.CreateClass; +begin + FValue := TValue.From(0.0); +end; + function TDataFloatValueZero.GetAsString: string; begin Result := '0'; @@ -99,8 +121,18 @@ begin Result := 0.0; end; +function TDataFloatValueZero.AsTValue: TValue; +begin + Result := FValue; +end; + { TDataFloatValueNaN } +class constructor TDataFloatValueNaN.CreateClass; +begin + FValue := TValue.From(NaN); +end; + function TDataFloatValueNaN.GetAsString: string; begin Result := 'NaN'; @@ -116,6 +148,11 @@ begin Result := NaN; end; +function TDataFloatValueNaN.AsTValue: TValue; +begin + Result := FValue; +end; + { TDataFloatType } class constructor TDataFloatType.CreateClass; diff --git a/Src/Data/Myc.Data.Types.Ordinal.pas b/Src/Data/Myc.Data.Types.Ordinal.pas index 33728c6..dab295c 100644 --- a/Src/Data/Myc.Data.Types.Ordinal.pas +++ b/Src/Data/Myc.Data.Types.Ordinal.pas @@ -23,6 +23,9 @@ type implementation +uses + System.Rtti; + type // Implements the ordinal data value. TDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue) @@ -34,6 +37,7 @@ type // IDataValue function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; // IDataOrdinalValue function GetValue: Int64; @@ -41,26 +45,41 @@ type // Specialized implementation for the value -1. TDataOrdinalValueMinusOne = class(TInterfacedObject, IDataValue, IDataOrdinalValue) + strict private + class var + FValue: TValue; + class constructor CreateClass; public function GetDataType: IDataType; function GetAsString: string; function GetValue: Int64; + function AsTValue: TValue; end; // Specialized implementation for the value 0. TDataOrdinalValueZero = class(TInterfacedObject, IDataValue, IDataOrdinalValue) + strict private + class var + FValue: TValue; + class constructor CreateClass; public function GetDataType: IDataType; function GetAsString: string; function GetValue: Int64; + function AsTValue: TValue; end; // Specialized implementation for the value 1. TDataOrdinalValueOne = class(TInterfacedObject, IDataValue, IDataOrdinalValue) + strict private + class var + FValue: TValue; + class constructor CreateClass; public function GetDataType: IDataType; function GetAsString: string; function GetValue: Int64; + function AsTValue: TValue; end; { TDataOrdinalValue } @@ -81,6 +100,12 @@ begin Result := FValue.ToString; end; +function TDataOrdinalValue.AsTValue: TValue; +begin + // Convert Int64 to TValue + Result := TValue.From(FValue); +end; + function TDataOrdinalValue.GetValue: Int64; begin Result := FValue; @@ -88,6 +113,11 @@ end; { TDataOrdinalValueMinusOne } +class constructor TDataOrdinalValueMinusOne.CreateClass; +begin + FValue := TValue.From(-1); +end; + function TDataOrdinalValueMinusOne.GetDataType: IDataType; begin Result := TDataOrdinalType.Singleton; @@ -98,6 +128,12 @@ begin Result := '-1'; end; +function TDataOrdinalValueMinusOne.AsTValue: TValue; +begin + // Return the singleton TValue instance. + Result := FValue; +end; + function TDataOrdinalValueMinusOne.GetValue: Int64; begin Result := -1; @@ -105,6 +141,11 @@ end; { TDataOrdinalValueZero } +class constructor TDataOrdinalValueZero.CreateClass; +begin + FValue := TValue.From(0); +end; + function TDataOrdinalValueZero.GetDataType: IDataType; begin Result := TDataOrdinalType.Singleton; @@ -115,6 +156,12 @@ begin Result := '0'; end; +function TDataOrdinalValueZero.AsTValue: TValue; +begin + // Return the singleton TValue instance. + Result := FValue; +end; + function TDataOrdinalValueZero.GetValue: Int64; begin Result := 0; @@ -122,6 +169,11 @@ end; { TDataOrdinalValueOne } +class constructor TDataOrdinalValueOne.CreateClass; +begin + FValue := TValue.From(1); +end; + function TDataOrdinalValueOne.GetDataType: IDataType; begin Result := TDataOrdinalType.Singleton; @@ -132,6 +184,12 @@ begin Result := '1'; end; +function TDataOrdinalValueOne.AsTValue: TValue; +begin + // Return the singleton TValue instance. + Result := FValue; +end; + function TDataOrdinalValueOne.GetValue: Int64; begin Result := 1; diff --git a/Src/Data/Myc.Data.Types.Records.pas b/Src/Data/Myc.Data.Types.Records.pas index 16f650b..6bbcfb5 100644 --- a/Src/Data/Myc.Data.Types.Records.pas +++ b/Src/Data/Myc.Data.Types.Records.pas @@ -22,6 +22,7 @@ type private FFields: TArray; FFieldMap: TDictionary; // For fast lookups by name + FEmptyValue: IDataRecordValue; // Cached instance for zero-field records function GetName: String; function GetKind: TDataKind; function GetFieldCount: Integer; @@ -36,7 +37,8 @@ type implementation uses - System.SyncObjs; + System.SyncObjs, + System.Rtti; type // Implements the record data value. @@ -46,6 +48,7 @@ type FItems: TArray; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItem(Idx: Integer): IDataValue; public constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); @@ -53,10 +56,15 @@ type // Optimized implementation for a record with 0 fields. TDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue) + strict private + class var + FEmptyTValue: TValue; // Singleton TValue for an empty record + class constructor CreateClass; private FDataType: IDataRecordType; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItem(Idx: Integer): IDataValue; public constructor Create(const ADataType: IDataRecordType); @@ -69,6 +77,7 @@ type FItem0: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItem(Idx: Integer): IDataValue; public constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); @@ -81,6 +90,7 @@ type FItem0, FItem1: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItem(Idx: Integer): IDataValue; public constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); @@ -157,6 +167,17 @@ begin end; end; +function TDataRecordValue.AsTValue: TValue; +var + tvalueArray: TArray; + i: Integer; +begin + SetLength(tvalueArray, Length(FItems)); + for i := 0 to High(FItems) do + tvalueArray[i] := FItems[i].AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataRecordValue.GetItem(Idx: Integer): IDataValue; begin Result := FItems[Idx]; @@ -164,6 +185,14 @@ end; { TDataRecordValue0 } +class constructor TDataRecordValue0.CreateClass; +var + emptyArray: TArray; +begin + SetLength(emptyArray, 0); + FEmptyTValue := TValue.From>(emptyArray); +end; + constructor TDataRecordValue0.Create(const ADataType: IDataRecordType); begin inherited Create; @@ -175,6 +204,11 @@ begin Result := '<>'; end; +function TDataRecordValue0.AsTValue: TValue; +begin + Result := FEmptyTValue; +end; + function TDataRecordValue0.GetDataType: IDataType; begin Result := FDataType; @@ -202,6 +236,15 @@ begin Result := Format('<%s: %s>', [recordType.Fields[0].Name, FItem0.AsString]); end; +function TDataRecordValue1.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 1); + tvalueArray[0] := FItem0.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataRecordValue1.GetDataType: IDataType; begin Result := FDataType; @@ -249,6 +292,16 @@ begin end; end; +function TDataRecordValue2.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 2); + tvalueArray[0] := FItem0.AsTValue; + tvalueArray[1] := FItem1.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataRecordValue2.GetDataType: IDataType; begin Result := FDataType; @@ -282,6 +335,10 @@ begin FFields[i] := field; FFieldMap.Add(field.Name, i); end; + + // Pre-create the singleton value instance if this is a zero-field record. + if (Length(FFields) = 0) then + FEmptyValue := TDataRecordValue0.Create(Self); end; destructor TDataRecordType.Destroy; @@ -306,7 +363,7 @@ begin // Use optimized implementations for records with 0, 1, or 2 fields. case Length(FFields) of - 0: Result := TDataRecordValue0.Create(Self); + 0: Result := FEmptyValue; // Return the pre-cached instance. 1: Result := TDataRecordValue1.Create(Self, AItems); 2: Result := TDataRecordValue2.Create(Self, AItems); else diff --git a/Src/Data/Myc.Data.Types.Text.pas b/Src/Data/Myc.Data.Types.Text.pas index 0908f26..bc1de9b 100644 --- a/Src/Data/Myc.Data.Types.Text.pas +++ b/Src/Data/Myc.Data.Types.Text.pas @@ -21,6 +21,9 @@ type implementation +uses + System.Rtti; + type TDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue) private @@ -28,6 +31,7 @@ type function GetDataType: IDataType; function GetAsString: string; function GetValue: string; + function AsTValue: TValue; public constructor Create(const AValue: string); end; @@ -37,11 +41,13 @@ type strict private class var FSingleton: IDataTextValue; + FEmptyTValue: TValue; class constructor CreateClass; private function GetDataType: IDataType; function GetAsString: string; function GetValue: string; + function AsTValue: TValue; public class property Singleton: IDataTextValue read FSingleton; end; @@ -95,11 +101,17 @@ begin Result := FValue; end; +function TDataTextValue.AsTValue: TValue; +begin + Result := TValue.From(FValue); +end; + { TDataTextValueEmpty } class constructor TDataTextValueEmpty.CreateClass; begin FSingleton := TDataTextValueEmpty.Create; + FEmptyTValue := TValue.From(''); end; function TDataTextValueEmpty.GetAsString: string; @@ -117,4 +129,9 @@ begin Result := ''; end; +function TDataTextValueEmpty.AsTValue: TValue; +begin + Result := FEmptyTValue; +end; + end. diff --git a/Src/Data/Myc.Data.Types.Timestamp.pas b/Src/Data/Myc.Data.Types.Timestamp.pas index 9a50400..71592d9 100644 --- a/Src/Data/Myc.Data.Types.Timestamp.pas +++ b/Src/Data/Myc.Data.Types.Timestamp.pas @@ -21,6 +21,9 @@ type implementation +uses + System.Rtti; + type TDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue) private @@ -28,6 +31,7 @@ type function GetDataType: IDataType; function GetAsString: string; function GetValue: TDateTime; + function AsTValue: TValue; public constructor Create(const AValue: TDateTime); end; @@ -77,4 +81,9 @@ begin Result := FValue; end; +function TDataTimestampValue.AsTValue: TValue; +begin + Result := TValue.From(FValue); +end; + end. diff --git a/Src/Data/Myc.Data.Types.Tuple.pas b/Src/Data/Myc.Data.Types.Tuple.pas index 7610672..4af6b49 100644 --- a/Src/Data/Myc.Data.Types.Tuple.pas +++ b/Src/Data/Myc.Data.Types.Tuple.pas @@ -23,6 +23,9 @@ type implementation +uses + System.Rtti; + type // Implements the simple tuple data value. TDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue) @@ -30,6 +33,7 @@ type FItems: TArray; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -41,10 +45,12 @@ type strict private class var FSingleton: IDataTupleValue; + FEmptyTValue: TValue; class constructor CreateClass; private function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -57,6 +63,7 @@ type FItem0: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -69,6 +76,7 @@ type FItem0, FItem1: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -81,6 +89,7 @@ type FItem0, FItem1, FItem2: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -93,6 +102,7 @@ type FItem0, FItem1, FItem2, FItem3: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -105,6 +115,7 @@ type FItem0, FItem1, FItem2, FItem3, FItem4: IDataValue; function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; function GetItemCount: Integer; function GetItem(Idx: Integer): IDataValue; public @@ -149,6 +160,17 @@ begin end; end; +function TDataTupleValue.AsTValue: TValue; +var + tvalueArray: TArray; + i: Integer; +begin + SetLength(tvalueArray, Length(FItems)); + for i := 0 to High(FItems) do + tvalueArray[i] := FItems[i].AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue.GetItem(Idx: Integer): IDataValue; begin Result := FItems[Idx]; @@ -162,8 +184,12 @@ end; { TDataTupleValue0 } class constructor TDataTupleValue0.CreateClass; +var + emptyArray: TArray; begin FSingleton := TDataTupleValue0.Create; + SetLength(emptyArray, 0); + FEmptyTValue := TValue.From>(emptyArray); end; function TDataTupleValue0.GetAsString: string; @@ -171,6 +197,11 @@ begin Result := '()'; end; +function TDataTupleValue0.AsTValue: TValue; +begin + Result := FEmptyTValue; +end; + function TDataTupleValue0.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; @@ -199,6 +230,15 @@ begin Result := '(' + FItem0.AsString + ')'; end; +function TDataTupleValue1.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 1); + tvalueArray[0] := FItem0.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue1.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; @@ -232,6 +272,16 @@ begin Result := '(' + FItem0.AsString + ', ' + FItem1.AsString + ')'; end; +function TDataTupleValue2.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 2); + tvalueArray[0] := FItem0.AsTValue; + tvalueArray[1] := FItem1.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue2.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; @@ -281,6 +331,17 @@ begin end; end; +function TDataTupleValue3.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 3); + tvalueArray[0] := FItem0.AsTValue; + tvalueArray[1] := FItem1.AsTValue; + tvalueArray[2] := FItem2.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue3.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; @@ -334,6 +395,18 @@ begin end; end; +function TDataTupleValue4.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 4); + tvalueArray[0] := FItem0.AsTValue; + tvalueArray[1] := FItem1.AsTValue; + tvalueArray[2] := FItem2.AsTValue; + tvalueArray[3] := FItem3.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue4.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; @@ -391,6 +464,19 @@ begin end; end; +function TDataTupleValue5.AsTValue: TValue; +var + tvalueArray: TArray; +begin + SetLength(tvalueArray, 5); + tvalueArray[0] := FItem0.AsTValue; + tvalueArray[1] := FItem1.AsTValue; + tvalueArray[2] := FItem2.AsTValue; + tvalueArray[3] := FItem3.AsTValue; + tvalueArray[4] := FItem4.AsTValue; + Result := TValue.From>(tvalueArray); +end; + function TDataTupleValue5.GetDataType: IDataType; begin Result := TDataTupleType.Singleton; diff --git a/Src/Data/Myc.Data.Types.pas b/Src/Data/Myc.Data.Types.pas index 96c82d0..ba4d95b 100644 --- a/Src/Data/Myc.Data.Types.pas +++ b/Src/Data/Myc.Data.Types.pas @@ -4,7 +4,8 @@ interface uses System.Generics.Collections, - System.SysUtils; + System.SysUtils, + System.RTTI; type TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray, dkEnum); @@ -19,6 +20,7 @@ type IDataValue = interface function GetDataType: IDataType; function GetAsString: string; + function AsTValue: TValue; property DataType: IDataType read GetDataType; property AsString: string read GetAsString; end; @@ -122,6 +124,7 @@ type strict private FDataType: IDataType; function GetName: String; inline; + function GetKind: TDataKind; inline; class var FArrayTypeRegistry: TDictionary; @@ -132,6 +135,8 @@ type public constructor Create(const ADataType: IDataType); + class procedure ClearRegistries; static; + class operator Implicit(const A: IDataType): TDataType; overload; class operator Implicit(const A: TDataType): IDataType; overload; @@ -146,8 +151,19 @@ type class function RecordOf(const Fields: array of TRecordField): IDataRecordType; overload; static; class function EnumOf(const AName: string; const AIdentifiers: array of string): IDataEnumType; static; + // Casting + function AsOrdinal: IDataOrdinalType; + function AsFloat: IDataFloatType; + function AsText: IDataTextType; + function AsTimestamp: IDataTimestampType; + function AsRecord: IDataRecordType; + function AsTuple: IDataTupleType; + function AsArray: IDataArrayType; + function AsEnum: IDataEnumType; + property DataType: IDataType read FDataType; property Name: String read GetName; + property Kind: TDataKind read GetKind; end; TDataValue = record @@ -239,6 +255,69 @@ begin end; end; +// Implemented missing caster functions +function TDataType.AsArray: IDataArrayType; +begin + if (FDataType.Kind <> dkArray) then + raise EInvalidCast.Create('Array expected'); + Result := IDataArrayType(FDataType); +end; + +function TDataType.AsEnum: IDataEnumType; +begin + if (FDataType.Kind <> dkEnum) then + raise EInvalidCast.Create('Enum expected'); + Result := IDataEnumType(FDataType); +end; + +function TDataType.AsFloat: IDataFloatType; +begin + if (FDataType.Kind <> dkFloat) then + raise EInvalidCast.Create('Float expected'); + Result := IDataFloatType(FDataType); +end; + +function TDataType.AsOrdinal: IDataOrdinalType; +begin + if (FDataType.Kind <> dkOrdinal) then + raise EInvalidCast.Create('Ordinal expected'); + Result := IDataOrdinalType(FDataType); +end; + +function TDataType.AsRecord: IDataRecordType; +begin + if (FDataType.Kind <> dkRecord) then + raise EInvalidCast.Create('Record expected'); + Result := IDataRecordType(FDataType); +end; + +function TDataType.AsText: IDataTextType; +begin + if (FDataType.Kind <> dkText) then + raise EInvalidCast.Create('Text expected'); + Result := IDataTextType(FDataType); +end; + +function TDataType.AsTimestamp: IDataTimestampType; +begin + if (FDataType.Kind <> dkTimestamp) then + raise EInvalidCast.Create('Timestamp expected'); + Result := IDataTimestampType(FDataType); +end; + +function TDataType.AsTuple: IDataTupleType; +begin + if (FDataType.Kind <> dkTuple) then + raise EInvalidCast.Create('Tuple expected'); + Result := IDataTupleType(FDataType); +end; + +class procedure TDataType.ClearRegistries; +begin + FArrayTypeRegistry.Clear; + FRecordTypeRegistry.Clear; +end; + class function TDataType.Float: IDataFloatType; begin Result := TDataFloatType.Singleton; @@ -287,6 +366,11 @@ begin Result := TDataEnumType.Create(AName, AIdentifiers); end; +function TDataType.GetKind: TDataKind; +begin + Result := FDataType.Kind; +end; + class function TDataType.Text: IDataTextType; begin Result := TDataTextType.Singleton; diff --git a/Src/Data/TestDataTypes.pas b/Src/Data/TestDataTypes.pas index f11a4a0..e51ae90 100644 --- a/Src/Data/TestDataTypes.pas +++ b/Src/Data/TestDataTypes.pas @@ -7,39 +7,59 @@ uses type [TestFixture] + [IgnoreMemoryLeaks] TMyTestObject = class public - [Test] - procedure TestCreateRecords; + [TestFixtureTearDown] + procedure FixtureTearDown; + [Test] + procedure TestRecords; + [Test] + procedure TestRecords_Generic; [Test] procedure TestTuples; - + [Test] + procedure TestTuples_Generic; [Test] procedure TestArrays; - + [Test] + procedure TestArrays_OptimizedAndGeneric; [Test] procedure TestTexts; - + [Test] + procedure TestTexts_OptimizedEmpty; + [Test] + procedure TestFloats_OptimizedAndGeneric; [Test] procedure TestTimestamps; - [Test] procedure TestEnums; - [Test] procedure TestAsString; + [Test] + procedure TestAsTValue; end; implementation uses System.SysUtils, + System.Math, + System.Rtti, + System.TypInfo, Myc.Data.Types; { TMyTestObject } -procedure TMyTestObject.TestCreateRecords; +procedure TMyTestObject.FixtureTearDown; +begin + // Clear global type caches to release any interfaces created during tests. + // This prevents access violations on shutdown from dangling pointers in the registries. + TDataType.ClearRegistries; +end; + +procedure TMyTestObject.TestRecords; var intType: IDataType; floatType: IDataType; @@ -48,6 +68,7 @@ var idValue: IDataOrdinalValue; floatValue: IDataFloatValue; begin + // This test covers the optimized implementation for 2 fields. // --- 1. Setup: Define base types and a record structure --- intType := TDataType.Ordinal; floatType := TDataType.Float; @@ -117,6 +138,30 @@ begin ); end; +procedure TMyTestObject.TestRecords_Generic; +var + dataType: IDataRecordType; + dataValue: IDataRecordValue; +begin + // Test the generic implementation for records with > 2 fields. + dataType := + TDataType.RecordOf( + [ + TRecordField.Create('A', TDataType.Ordinal), + TRecordField.Create('B', TDataType.Text), + TRecordField.Create('C', TDataType.Float) + ] + ); + dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.FromFloat(3.0)]); + + Assert.IsNotNull(dataValue, 'Generic record value should be created'); + Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields'); + Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect'); + Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect'); + Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect'); + Assert.AreEqual('', dataValue.AsString, 'Generic record AsString is incorrect'); +end; + procedure TMyTestObject.TestTuples; var intValue: IDataValue; @@ -124,6 +169,7 @@ var tuple1, tuple2, tuple3: IDataTupleValue; type1, type2, type3: IDataType; begin + // This test covers optimized implementations for 1 and 2 elements. // --- 1. Setup: Create some values --- intValue := TDataValue.FromOrdinal(123); floatValue := TDataValue.FromFloat(45.67); @@ -154,6 +200,29 @@ begin Assert.AreSame(type1, type3, 'All tuple types should be the same singleton instance'); end; +procedure TMyTestObject.TestTuples_Generic; +var + tupleValue: IDataTupleValue; +begin + // Test the generic implementation for tuples with > 5 elements. + tupleValue := + TDataValue.FromTuple( + [ + TDataValue.FromOrdinal(1), + TDataValue.FromOrdinal(2), + TDataValue.FromOrdinal(3), + TDataValue.FromOrdinal(4), + TDataValue.FromOrdinal(5), + TDataValue.FromOrdinal(6) + ] + ); + + Assert.IsNotNull(tupleValue, 'Generic tuple value should be created'); + Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items'); + Assert.AreEqual(Int64(6), TDataValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect'); + Assert.AreEqual('(1, 2, 3, 4, 5, 6)', tupleValue.AsString, 'Generic tuple AsString is incorrect'); +end; + procedure TMyTestObject.TestArrays; var intType: IDataType; @@ -210,6 +279,35 @@ begin ); end; +procedure TMyTestObject.TestArrays_OptimizedAndGeneric; +var + arrayType: IDataArrayType; + empty1, empty2, single, generic: IDataArrayValue; +begin + arrayType := TDataType.ArrayOfType(TDataType.Ordinal); + + // Test optimized path for 0 elements (cached singleton per type) + empty1 := arrayType.CreateValue([]); + empty2 := arrayType.CreateValue([]); + Assert.IsNotNull(empty1, 'Empty array value should be created'); + Assert.AreSame(empty1, empty2, 'Empty array value should be cached and reused'); + Assert.AreEqual(0, empty1.ElementCount, 'Empty array should have 0 elements'); + Assert.AreEqual('[]', empty1.AsString, 'Empty array AsString is incorrect'); + + // Test optimized path for 1 element + single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]); + Assert.IsNotNull(single, 'Single element array should be created'); + Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element'); + Assert.AreEqual(Int64(42), TDataValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect'); + Assert.AreEqual('[42]', single.AsString, 'Single element array AsString is incorrect'); + + // Test generic path for > 1 elements + generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]); + Assert.IsNotNull(generic, 'Generic array should be created'); + Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements'); + Assert.AreEqual('[1, 2, 3]', generic.AsString, 'Generic array AsString is incorrect'); +end; + procedure TMyTestObject.TestTexts; var textType: IDataTextType; @@ -244,6 +342,47 @@ begin .WillRaise(procedure begin TDataValue(dataValue).AsText; end, EInvalidCast, 'Casting non-text to AsText should raise EInvalidCast'); end; +procedure TMyTestObject.TestTexts_OptimizedEmpty; +var + empty1, empty2: IDataTextValue; +begin + // Test the singleton implementation for the empty string. + empty1 := TDataValue.FromText(''); + empty2 := TDataValue.FromText(''); + + Assert.IsNotNull(empty1, 'Empty text value should be created'); + Assert.AreSame(empty1, empty2, 'Empty text value should be a singleton'); + Assert.AreEqual('', empty1.Value, 'Value of empty text should be empty'); + Assert.AreEqual('', empty1.AsString, 'AsString of empty text should be empty'); +end; + +procedure TMyTestObject.TestFloats_OptimizedAndGeneric; +var + zero1, zero2, nan1, nan2, generic: IDataFloatValue; +begin + // Test singleton for 0.0 + zero1 := TDataValue.FromFloat(0.0); + zero2 := TDataValue.FromFloat(0.0); + Assert.IsNotNull(zero1, 'Zero float should be created'); + Assert.AreSame(zero1, zero2, 'Zero float should be a singleton'); + Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect'); + + // Test singleton for NaN + nan1 := TDataValue.FromFloat(NaN); + nan2 := TDataValue.FromFloat(NaN); + Assert.IsNotNull(nan1, 'NaN float should be created'); + Assert.AreSame(nan1, nan2, 'NaN float should be a singleton'); + Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN'); + Assert.AreEqual('NaN', nan1.AsString, 'NaN AsString is incorrect'); + + // Test generic path + generic := TDataValue.FromFloat(123.45); + Assert.IsNotNull(generic, 'Generic float should be created'); + Assert.AreNotSame(zero1, generic, 'Generic float should not be the zero singleton'); + Assert.AreNotSame(nan1, generic, 'Generic float should not be the NaN singleton'); + Assert.AreEqual(123.45, generic.Value, 'Value of generic float is incorrect'); +end; + procedure TMyTestObject.TestTimestamps; var tsType: IDataTimestampType; @@ -390,7 +529,95 @@ begin Assert.AreEqual('(10, Tuple)', tupleValue.AsString, 'Tuple AsString incorrect'); end; -initialization - TDUnitX.RegisterTestFixture(TMyTestObject); +procedure TMyTestObject.TestAsTValue; +var + dataValue: IDataValue; + tv, element: TValue; + now: TDateTime; + colorType: IDataEnumType; + intArrayType: IDataArrayType; + personType: IDataRecordType; +begin + // --- Ordinal --- + dataValue := TDataValue.FromOrdinal(123); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Ordinal TValue should not be empty'); + Assert.AreEqual(tkInt64, tv.Kind, 'Ordinal TValue kind should be tkInt64'); + Assert.AreEqual(Int64(123), tv.AsInt64, 'Ordinal TValue content is incorrect'); + + // --- Float --- + dataValue := TDataValue.FromFloat(45.67); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Float TValue should not be empty'); + Assert.AreEqual(tkFloat, tv.Kind, 'Float TValue kind should be tkFloat'); + Assert.AreEqual(45.67, tv.AsExtended, 'Float TValue content is incorrect'); + + // --- Text --- + dataValue := TDataValue.FromText('Hello'); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Text TValue should not be empty'); + Assert.AreEqual(tkUString, tv.Kind, 'Text TValue kind should be tkUString'); + Assert.AreEqual('Hello', tv.AsString, 'Text TValue content is incorrect'); + + // --- Timestamp --- + now := System.SysUtils.Now; + dataValue := TDataValue.FromTimestamp(now); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Timestamp TValue should not be empty'); + Assert.AreEqual(tkFloat, tv.Kind, 'Timestamp TValue kind is incorrect'); + Assert.AreEqual(now, tv.AsType, 'Timestamp TValue content is incorrect'); + + // --- Enum --- + colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); + dataValue := colorType.CreateValue('Green'); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Enum TValue should not be empty'); + Assert.AreEqual(tkInteger, tv.Kind, 'Enum TValue kind should be tkInteger'); + Assert.AreEqual(1, tv.AsInteger, 'Enum TValue content is incorrect'); + + // --- Array --- + intArrayType := TDataType.ArrayOfType(TDataType.Ordinal); + dataValue := intArrayType.CreateValue([TDataValue.FromOrdinal(10), TDataValue.FromOrdinal(20)]); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Array TValue should not be empty'); + Assert.IsTrue(tv.IsArray, 'Array TValue should be an array'); + Assert.AreEqual(tkDynArray, tv.Kind, 'Array TValue kind should be tkDynArray'); + Assert.AreEqual(NativeInt(2), tv.GetArrayLength, 'Array TValue length is incorrect'); + + // Correctly unwrap the nested TValue before asserting kind and value + element := tv.GetArrayElement(0).AsType; + Assert.AreEqual(tkInt64, element.Kind, 'Unwrapped array element 0 kind is incorrect'); + Assert.AreEqual(Int64(10), element.AsInt64, 'Array TValue element 0 is incorrect'); + + element := tv.GetArrayElement(1).AsType; + Assert.AreEqual(Int64(20), element.AsInt64, 'Array TValue element 1 is incorrect'); + + // Check empty array + dataValue := intArrayType.CreateValue([]); + tv := dataValue.AsTValue; + Assert.IsTrue(tv.IsArray, 'Empty Array TValue should be an array'); + Assert.AreEqual(NativeInt(0), tv.GetArrayLength, 'Empty Array TValue length is incorrect'); + + // --- Record --- + personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]); + dataValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Record TValue should not be empty'); + Assert.IsTrue(tv.IsArray, 'Record TValue should be represented as an array'); + Assert.AreEqual(tkDynArray, tv.Kind, 'Record TValue kind should be tkDynArray'); + Assert.AreEqual(NativeInt(2), tv.GetArrayLength, 'Record TValue length is incorrect'); + Assert.AreEqual(Int64(1), tv.GetArrayElement(0).AsType.AsInt64, 'Record TValue element 0 is incorrect'); + Assert.AreEqual('Bob', tv.GetArrayElement(1).AsType.AsString, 'Record TValue element 1 is incorrect'); + + // --- Tuple --- + dataValue := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromText('Red')]); + tv := dataValue.AsTValue; + Assert.IsFalse(tv.IsEmpty, 'Tuple TValue should not be empty'); + Assert.IsTrue(tv.IsArray, 'Tuple TValue should be represented as an array'); + Assert.AreEqual(tkDynArray, tv.Kind, 'Tuple TValue kind should be tkDynArray'); + Assert.AreEqual(NativeInt(2), tv.GetArrayLength, 'Tuple TValue length is incorrect'); + Assert.AreEqual(Int64(99), tv.GetArrayElement(0).AsType.AsInt64, 'Tuple TValue element 0 is incorrect'); + Assert.AreEqual('Red', tv.GetArrayElement(1).AsType.AsString, 'Tuple TValue element 1 is incorrect'); +end; end.