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

Data Types

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-25 18:00:15 +02:00
parent 42110e8471
commit 947060566d
11 changed files with 642 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
KI/Prompt-Delphi-Entwicklung.md
+2
View File
@@ -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.
Src/Data/Myc.Data.Types.Arrays.pas
+42 -14
View File
@@ -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<IDataValue>;
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<TValue>;
i: Integer;
begin
SetLength(tvalueArray, Length(FItems));
for i := 0 to High(FItems) do
tvalueArray[i] := FItems[i].AsTValue;
Result := TValue.From<TArray<TValue>>(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<TArray<TValue>>([]);
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<TValue>;
begin
SetLength(tvalueArray, 1);
tvalueArray[0] := FItem0.AsTValue;
Result := TValue.From<TArray<TValue>>(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.
Src/Data/Myc.Data.Types.Enum.pas
+9
View File
@@ -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<Integer>(FValue);
end;
end.
Src/Data/Myc.Data.Types.Float.pas
+38 -1
View File
@@ -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<Double>(FValue);
end;
function TDataFloatValue.GetValue: Double;
begin
Result := FValue;
@@ -84,6 +101,11 @@ end;
{ TDataFloatValueZero }
class constructor TDataFloatValueZero.CreateClass;
begin
FValue := TValue.From<Double>(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<Double>(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;
Src/Data/Myc.Data.Types.Ordinal.pas
+58
View File
@@ -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<Int64>(FValue);
end;
function TDataOrdinalValue.GetValue: Int64;
begin
Result := FValue;
@@ -88,6 +113,11 @@ end;
{ TDataOrdinalValueMinusOne }
class constructor TDataOrdinalValueMinusOne.CreateClass;
begin
FValue := TValue.From<Int64>(-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<Int64>(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<Int64>(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;
Src/Data/Myc.Data.Types.Records.pas
+59 -2
View File
@@ -22,6 +22,7 @@ type
private
FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // 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<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);
@@ -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<TValue>;
i: Integer;
begin
SetLength(tvalueArray, Length(FItems));
for i := 0 to High(FItems) do
tvalueArray[i] := FItems[i].AsTValue;
Result := TValue.From<TArray<TValue>>(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<TValue>;
begin
SetLength(emptyArray, 0);
FEmptyTValue := TValue.From<TArray<TValue>>(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<TValue>;
begin
SetLength(tvalueArray, 1);
tvalueArray[0] := FItem0.AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataRecordValue1.GetDataType: IDataType;
begin
Result := FDataType;
@@ -249,6 +292,16 @@ begin
end;
end;
function TDataRecordValue2.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
SetLength(tvalueArray, 2);
tvalueArray[0] := FItem0.AsTValue;
tvalueArray[1] := FItem1.AsTValue;
Result := TValue.From<TArray<TValue>>(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
Src/Data/Myc.Data.Types.Text.pas
+17
View File
@@ -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<string>(FValue);
end;
{ TDataTextValueEmpty }
class constructor TDataTextValueEmpty.CreateClass;
begin
FSingleton := TDataTextValueEmpty.Create;
FEmptyTValue := TValue.From<string>('');
end;
function TDataTextValueEmpty.GetAsString: string;
@@ -117,4 +129,9 @@ begin
Result := '';
end;
function TDataTextValueEmpty.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
end.
Src/Data/Myc.Data.Types.Timestamp.pas
+9
View File
@@ -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<TDateTime>(FValue);
end;
end.
Src/Data/Myc.Data.Types.Tuple.pas
+86
View File
@@ -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<IDataValue>;
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<TValue>;
i: Integer;
begin
SetLength(tvalueArray, Length(FItems));
for i := 0 to High(FItems) do
tvalueArray[i] := FItems[i].AsTValue;
Result := TValue.From<TArray<TValue>>(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<TValue>;
begin
FSingleton := TDataTupleValue0.Create;
SetLength(emptyArray, 0);
FEmptyTValue := TValue.From<TArray<TValue>>(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<TValue>;
begin
SetLength(tvalueArray, 1);
tvalueArray[0] := FItem0.AsTValue;
Result := TValue.From<TArray<TValue>>(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<TValue>;
begin
SetLength(tvalueArray, 2);
tvalueArray[0] := FItem0.AsTValue;
tvalueArray[1] := FItem1.AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue2.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
@@ -281,6 +331,17 @@ begin
end;
end;
function TDataTupleValue3.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
SetLength(tvalueArray, 3);
tvalueArray[0] := FItem0.AsTValue;
tvalueArray[1] := FItem1.AsTValue;
tvalueArray[2] := FItem2.AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue3.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
@@ -334,6 +395,18 @@ begin
end;
end;
function TDataTupleValue4.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
SetLength(tvalueArray, 4);
tvalueArray[0] := FItem0.AsTValue;
tvalueArray[1] := FItem1.AsTValue;
tvalueArray[2] := FItem2.AsTValue;
tvalueArray[3] := FItem3.AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue4.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
@@ -391,6 +464,19 @@ begin
end;
end;
function TDataTupleValue5.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
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<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue5.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Src/Data/Myc.Data.Types.pas
+85 -1
View File
@@ -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<IDataType, IDataArrayType>;
@@ -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;
Src/Data/TestDataTypes.pas
+237 -10
View File
@@ -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('<A: 1, B: two, C: 3>', 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<TDateTime>, '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<TValue>;
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<TValue>;
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<TValue>.AsInt64, 'Record TValue element 0 is incorrect');
Assert.AreEqual('Bob', tv.GetArrayElement(1).AsType<TValue>.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<TValue>.AsInt64, 'Tuple TValue element 0 is incorrect');
Assert.AreEqual('Red', tv.GetArrayElement(1).AsType<TValue>.AsString, 'Tuple TValue element 1 is incorrect');
end;
end.