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
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.