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

Data Types next

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-25 14:01:22 +02:00
parent 27f1cc5486
commit ce653c83b1
12 changed files with 728 additions and 878 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Types.Arrays.pas
+15 -189
View File
@@ -8,70 +8,20 @@ uses
Myc.Data.Types;
type
// An interface helper for IDataArrayValue.
TArrayValue = record
TImplDataArrayValue = class; // fwd
// Implements the array data type.
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private
FArrayValue: IDataArrayValue;
function GetElementCount: Integer; inline;
function GetItem(Idx: Integer): TDataValue; inline;
FElementType: IDataType;
function GetElementType: IDataType;
function GetName: String;
function GetKind: TDataKind;
public
constructor Create(const AArrayValue: IDataArrayValue);
class operator Implicit(const A: IDataArrayValue): TArrayValue; overload;
class operator Implicit(const A: TArrayValue): IDataArrayValue; overload;
property ElementCount: Integer read GetElementCount;
property Items[Idx: Integer]: TDataValue read GetItem; default;
constructor Create(const AElementType: IDataType);
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
end;
// An interface helper for IDataArrayType.
TArrayType = record
private
FArrayType: IDataArrayType;
function GetElementType: TDataType; inline;
function GetName: String; inline;
public
constructor Create(const AArrayType: IDataArrayType);
class operator Implicit(const A: IDataArrayType): TArrayType; overload;
class operator Implicit(const A: TArrayType): IDataArrayType; overload;
function CreateValue(const AItems: array of IDataValue): TArrayValue;
property Name: String read GetName;
property ElementType: TDataType read GetElementType;
end;
TDataValueHelper = record helper for TDataValue
public
function AsArray: TArrayValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsArray: TArrayType;
end;
// Public factory for creating and caching array types.
TArrayTypes = record
strict private
class var
FRegistry: TDictionary<IDataType, IDataArrayType>;
class constructor CreateClass;
class destructor DestroyClass;
public
class function GetType(const AElementType: TDataType): TArrayType; static;
end;
implementation
uses
System.SyncObjs;
type
{fwd}
TImplDataArrayType = class;
// Implements the array data value.
TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
@@ -84,90 +34,10 @@ type
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end;
// Implements the array data type.
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private
FElementType: IDataType;
function GetElementType: IDataType;
function GetName: String;
public
constructor Create(const AElementType: IDataType);
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
end;
implementation
{ TArrayValue }
constructor TArrayValue.Create(const AArrayValue: IDataArrayValue);
begin
FArrayValue := AArrayValue;
end;
function TArrayValue.GetElementCount: Integer;
begin
if Assigned(FArrayValue) then
Result := FArrayValue.ElementCount
else
Result := 0;
end;
function TArrayValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FArrayValue) then
Result := FArrayValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
class operator TArrayValue.Implicit(const A: TArrayValue): IDataArrayValue;
begin
Result := A.FArrayValue;
end;
class operator TArrayValue.Implicit(const A: IDataArrayValue): TArrayValue;
begin
Result.FArrayValue := A;
end;
{ TArrayType }
constructor TArrayType.Create(const AArrayType: IDataArrayType);
begin
FArrayType := AArrayType;
end;
function TArrayType.CreateValue(const AItems: array of IDataValue): TArrayValue;
begin
if Assigned(FArrayType) then
Result := FArrayType.CreateValue(AItems)
else
raise EAccessViolation.Create('Cannot create value from a nil array type.');
end;
function TArrayType.GetElementType: TDataType;
begin
if Assigned(FArrayType) then
Result := FArrayType.ElementType
else
Result := TDataType.Create(nil);
end;
function TArrayType.GetName: String;
begin
if Assigned(FArrayType) then
Result := FArrayType.Name
else
Result := '';
end;
class operator TArrayType.Implicit(const A: TArrayType): IDataArrayType;
begin
Result := A.FArrayType;
end;
class operator TArrayType.Implicit(const A: IDataArrayType): TArrayType;
begin
Result.FArrayType := A;
end;
uses
System.SyncObjs;
{ TImplDataArrayValue }
@@ -233,53 +103,9 @@ begin
Result := Format('Array<%s>', [FElementType.Name]);
end;
{ TDataValueHelper }
function TDataValueHelper.AsArray: TArrayValue;
function TImplDataArrayType.GetKind: TDataKind;
begin
Result := Self.DataValue as IDataArrayValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsArray: TArrayType;
begin
Result := Self.DataType as IDataArrayType;
end;
{ TArrayTypes }
class constructor TArrayTypes.CreateClass;
begin
// IDataType interface keys work out-of-the-box with the default comparer.
FRegistry := TDictionary<IDataType, IDataArrayType>.Create;
end;
class destructor TArrayTypes.DestroyClass;
begin
FRegistry.Free;
end;
class function TArrayTypes.GetType(const AElementType: TDataType): TArrayType;
var
arrayTypeItf: IDataArrayType;
elementTypeItf: IDataType;
begin
elementTypeItf := AElementType.DataType; // Get underlying interface from helper
if not Assigned(elementTypeItf) then
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
TMonitor.Enter(FRegistry);
try
if not FRegistry.TryGetValue(elementTypeItf, arrayTypeItf) then
begin
arrayTypeItf := TImplDataArrayType.Create(elementTypeItf);
FRegistry.Add(elementTypeItf, arrayTypeItf);
end;
finally
TMonitor.Exit(FRegistry);
end;
Result := arrayTypeItf;
Result := dkArray;
end;
end.
Src/Data/Myc.Data.Types.Float.pas
+9 -43
View File
@@ -3,30 +3,9 @@ unit Myc.Data.Types.Float;
interface
uses
System.SysUtils,
Myc.Data.Types;
type
TDataValueHelper = record helper for TDataValue
public
function AsFloat: IDataFloatValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsFloat: IDataFloatType;
end;
// Public factory for creating float values.
TFloatType = record
public
class function CreateValue(Init: Double): IDataFloatValue; static;
end;
implementation
uses
System.SysUtils;
type
// Implements the float data value.
TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
@@ -50,10 +29,13 @@ type
class constructor CreateClass;
public
function GetName: String;
function GetKind: TDataKind;
function CreateValue(Init: Double): IDataFloatValue;
class property Singleton: IDataFloatType read FSingleton;
end;
implementation
{ TImplDataFloatValue }
constructor TImplDataFloatValue.Create(const AValue: Double);
@@ -84,30 +66,14 @@ begin
Result := 'Float';
end;
function TImplDataFloatType.GetKind: TDataKind;
begin
Result := dkFloat;
end;
function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
begin
Result := TImplDataFloatValue.Create(Init);
end;
{ TFloatType }
class function TFloatType.CreateValue(Init: Double): IDataFloatValue;
begin
Result := TImplDataFloatType.Singleton.CreateValue(Init);
end;
{ TDataValueHelper }
function TDataValueHelper.AsFloat: IDataFloatValue;
begin
Result := Self.DataValue as IDataFloatValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsFloat: IDataFloatType;
begin
Result := Self.DataType as IDataFloatType;
end;
end.
Src/Data/Myc.Data.Types.Ordinal.pas
+9 -41
View File
@@ -3,26 +3,7 @@ unit Myc.Data.Types.Ordinal;
interface
uses
Myc.Data.Types;
type
TDataValueOrdinalHelper = record helper for TDataValue
public
function AsOrdinal: IDataOrdinalValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsOrdinal: IDataOrdinalType;
end;
TOrdinalType = record
class function CreateValue(Init: Int64): IDataOrdinalValue; static;
end;
implementation
uses
Myc.Data.Types,
System.SysUtils;
type
@@ -48,10 +29,13 @@ type
class constructor CreateClass;
public
function GetName: String;
function GetKind: TDataKind;
function CreateValue(Init: Int64): IDataOrdinalValue;
class property Singleton: IDataOrdinalType read FSingleton;
end;
implementation
{ TImplDataOrdinalValue }
constructor TImplDataOrdinalValue.Create(const AValue: Int64);
@@ -82,30 +66,14 @@ begin
Result := 'Integer';
end;
function TImplDataOrdinalType.GetKind: TDataKind;
begin
Result := dkOrdinal;
end;
function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin
Result := TImplDataOrdinalValue.Create(Init);
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsOrdinal: IDataOrdinalType;
begin
Result := DataType as IDataOrdinalType;
end;
{ TDataValueOrdinalHelper }
function TDataValueOrdinalHelper.AsOrdinal: IDataOrdinalValue;
begin
Result := DataValue as IDataOrdinalValue;
end;
{ TOrdinalType }
class function TOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin
Result := TImplDataOrdinalType.Singleton.CreateValue(Init);
end;
end.
Src/Data/Myc.Data.Types.Records.pas
+28 -235
View File
@@ -5,83 +5,11 @@ interface
uses
System.Generics.Collections,
System.SysUtils,
System.Generics.Defaults,
System.Hash,
Myc.Data.Types;
type
// An interface helper for IDataRecordType.
TRecordType = record
private
FRecordType: IDataRecordType;
function GetFieldCount: Integer; inline;
function GetField(Idx: Integer): TRecordField; inline;
function GetName: String; inline;
public
constructor Create(const ARecordType: IDataRecordType);
class operator Implicit(const A: IDataRecordType): TRecordType; overload;
class operator Implicit(const A: TRecordType): IDataRecordType; overload;
function CreateValue(const AItems: array of IDataValue): TDataValue;
function IndexOf(const AName: string): Integer; inline;
class operator Equal(const A, B: TRecordType): Boolean;
property Name: String read GetName;
property FieldCount: Integer read GetFieldCount;
property Fields[Idx: Integer]: TRecordField read GetField; default;
end;
// An interface helper for IDataRecordValue.
TRecordValue = record
private
FRecordValue: IDataRecordValue;
function GetDataType: TRecordType; inline;
function GetItem(Idx: Integer): TDataValue; inline;
public
constructor Create(const ARecordValue: IDataRecordValue);
function CreateValue(const AItems: array of IDataValue): TDataValue;
class operator Implicit(const A: IDataRecordValue): TRecordValue; overload;
class operator Implicit(const A: TRecordValue): IDataRecordValue; overload;
property DataType: TRecordType read GetDataType;
property Items[Idx: Integer]: TDataValue read GetItem; default;
end;
TDataValueRecordHelper = record helper for TDataValue
public
function AsRecord: TRecordValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsRecord: TRecordType;
end;
// Public factory for creating record types.
TRecordTypes = record
strict private
class var
FRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
class constructor CreateClass;
class destructor DestroyClass;
public
class function GetType(const AFields: TArray<TRecordField>): TRecordType; static;
end;
implementation
uses
System.Generics.Defaults,
System.Hash,
System.SyncObjs;
type
{fwd}
TImplDataRecordType = class;
// Custom comparer for TArray<TRecordField> to be used as a dictionary key.
TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>)
public
@@ -89,6 +17,24 @@ type
function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce;
end;
TImplDataRecordValue = class; // fwd
// Implements the record data type.
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
private
FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
function GetName: String;
function GetKind: TDataKind;
function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer;
public
constructor Create(const AFields: array of TRecordField);
destructor Destroy; override;
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
end;
// Implements the record data value.
TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
private
@@ -100,125 +46,10 @@ type
constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
end;
// Implements the record data type.
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
private
FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
function GetName: String;
function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer;
public
constructor Create(const AFields: array of TRecordField);
destructor Destroy; override;
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
end;
implementation
{ TRecordValue }
constructor TRecordValue.Create(const ARecordValue: IDataRecordValue);
begin
FRecordValue := ARecordValue;
end;
function TRecordValue.CreateValue(const AItems: array of IDataValue): TDataValue;
var
recordTypeItf: IDataRecordType;
begin
recordTypeItf := Self.DataType;
if not Assigned(recordTypeItf) then
raise EAccessViolation.Create('Cannot create value from a nil record type.');
Result := recordTypeItf.CreateValue(AItems);
end;
function TRecordValue.GetDataType: TRecordType;
begin
if Assigned(FRecordValue) then
Result := FRecordValue.DataType as IDataRecordType
else
Result := TRecordType.Create(nil);
end;
function TRecordValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FRecordValue) then
Result := FRecordValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
class operator TRecordValue.Implicit(const A: TRecordValue): IDataRecordValue;
begin
Result := A.FRecordValue;
end;
class operator TRecordValue.Implicit(const A: IDataRecordValue): TRecordValue;
begin
Result.FRecordValue := A;
end;
{ TRecordType }
constructor TRecordType.Create(const ARecordType: IDataRecordType);
begin
FRecordType := ARecordType;
end;
function TRecordType.CreateValue(const AItems: array of IDataValue): TDataValue;
begin
if Assigned(FRecordType) then
Result := FRecordType.CreateValue(AItems)
else
raise EAccessViolation.Create('Cannot create value from a nil record type.');
end;
function TRecordType.GetField(Idx: Integer): TRecordField;
begin
if Assigned(FRecordType) then
Result := FRecordType.Fields[Idx]
else
Result := Default(TRecordField);
end;
function TRecordType.GetFieldCount: Integer;
begin
if Assigned(FRecordType) then
Result := FRecordType.FieldCount
else
Result := 0;
end;
function TRecordType.GetName: String;
begin
if Assigned(FRecordType) then
Result := FRecordType.Name
else
Result := '';
end;
function TRecordType.IndexOf(const AName: string): Integer;
begin
if Assigned(FRecordType) then
Result := FRecordType.IndexOf(AName)
else
Result := -1;
end;
class operator TRecordType.Equal(const A, B: TRecordType): Boolean;
begin
Result := A.FRecordType = B.FRecordType;
end;
class operator TRecordType.Implicit(const A: TRecordType): IDataRecordType;
begin
Result := A.FRecordType;
end;
class operator TRecordType.Implicit(const A: IDataRecordType): TRecordType;
begin
Result.FRecordType := A;
end;
uses
System.SyncObjs;
{ TRecordFieldComparer }
@@ -347,53 +178,15 @@ begin
end;
end;
function TImplDataRecordType.GetKind: TDataKind;
begin
Result := dkRecord;
end;
function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin
if not FFieldMap.TryGetValue(AName, Result) then
Result := -1;
end;
{ TDataValueRecordHelper }
function TDataValueRecordHelper.AsRecord: TRecordValue;
begin
Result := Self.DataValue as IDataRecordValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsRecord: TRecordType;
begin
Result := Self.DataType as IDataRecordType;
end;
{ TRecordTypes }
class constructor TRecordTypes.CreateClass;
begin
FRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
end;
class destructor TRecordTypes.DestroyClass;
begin
FRegistry.Free;
end;
class function TRecordTypes.GetType(const AFields: TArray<TRecordField>): TRecordType;
var
recordTypeItf: IDataRecordType;
begin
TMonitor.Enter(FRegistry);
try
if not FRegistry.TryGetValue(AFields, recordTypeItf) then
begin
recordTypeItf := TImplDataRecordType.Create(AFields);
FRegistry.Add(AFields, recordTypeItf);
end;
finally
TMonitor.Exit(FRegistry);
end;
Result := recordTypeItf;
end;
end.
Src/Data/Myc.Data.Types.Text.pas
+73
View File
@@ -0,0 +1,73 @@
unit Myc.Data.Types.Text;
interface
uses
System.SysUtils,
Myc.Data.Types;
type
TImplDataTextType = class(TInterfacedObject, IDataType, IDataTextType)
strict private
class var
FSingleton: IDataTextType;
class constructor CreateClass;
public
function GetName: String;
function GetKind: TDataKind;
function CreateValue(const AValue: string): IDataTextValue;
class property Singleton: IDataTextType read FSingleton;
end;
TImplDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue)
private
FValue: string;
function GetDataType: IDataType;
function GetValue: string;
public
constructor Create(const AValue: string);
end;
implementation
{ TImplDataTextType }
class constructor TImplDataTextType.CreateClass;
begin
FSingleton := TImplDataTextType.Create;
end;
function TImplDataTextType.CreateValue(const AValue: string): IDataTextValue;
begin
Result := TImplDataTextValue.Create(AValue);
end;
function TImplDataTextType.GetName: String;
begin
Result := 'Text';
end;
function TImplDataTextType.GetKind: TDataKind;
begin
Result := dkText;
end;
{ TImplDataTextValue }
constructor TImplDataTextValue.Create(const AValue: string);
begin
inherited Create;
FValue := AValue;
end;
function TImplDataTextValue.GetDataType: IDataType;
begin
Result := TImplDataTextType.Singleton;
end;
function TImplDataTextValue.GetValue: string;
begin
Result := FValue;
end;
end.
Src/Data/Myc.Data.Types.Timestamp.pas
+73
View File
@@ -0,0 +1,73 @@
unit Myc.Data.Types.Timestamp;
interface
uses
System.SysUtils,
Myc.Data.Types;
type
TImplDataTimestampType = class(TInterfacedObject, IDataType, IDataTimestampType)
strict private
class var
FSingleton: IDataTimestampType;
class constructor CreateClass;
public
function GetName: String;
function GetKind: TDataKind;
function CreateValue(const AValue: TDateTime): IDataTimestampValue;
class property Singleton: IDataTimestampType read FSingleton;
end;
TImplDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue)
private
FValue: TDateTime;
function GetDataType: IDataType;
function GetValue: TDateTime;
public
constructor Create(const AValue: TDateTime);
end;
implementation
{ TImplDataTimestampType }
class constructor TImplDataTimestampType.CreateClass;
begin
FSingleton := TImplDataTimestampType.Create;
end;
function TImplDataTimestampType.CreateValue(const AValue: TDateTime): IDataTimestampValue;
begin
Result := TImplDataTimestampValue.Create(AValue);
end;
function TImplDataTimestampType.GetName: String;
begin
Result := 'Timestamp';
end;
function TImplDataTimestampType.GetKind: TDataKind;
begin
Result := dkTimestamp;
end;
{ TImplDataTimestampValue }
constructor TImplDataTimestampValue.Create(const AValue: TDateTime);
begin
inherited Create;
FValue := AValue;
end;
function TImplDataTimestampValue.GetDataType: IDataType;
begin
Result := TImplDataTimestampType.Singleton;
end;
function TImplDataTimestampValue.GetValue: TDateTime;
begin
Result := FValue;
end;
end.
Src/Data/Myc.Data.Types.Tuple.pas
+10 -124
View File
@@ -6,53 +6,6 @@ uses
System.SysUtils,
Myc.Data.Types;
type
// An interface helper for the singleton IDataTupleType.
TTupleType = record
private
FTupleType: IDataTupleType;
function GetName: String; inline;
public
constructor Create(const ATupleType: IDataTupleType);
class operator Implicit(const A: IDataTupleType): TTupleType; overload;
class operator Implicit(const A: TTupleType): IDataTupleType; overload;
property Name: String read GetName;
end;
// An interface helper for IDataTupleValue.
TTupleValue = record
private
FTupleValue: IDataTupleValue;
function GetItem(Idx: Integer): TDataValue; inline;
function GetItemCount: Integer; inline;
public
constructor Create(const ATupleValue: IDataTupleValue);
class operator Implicit(const A: IDataTupleValue): TTupleValue; overload;
class operator Implicit(const A: TTupleValue): IDataTupleValue; overload;
property ItemCount: Integer read GetItemCount;
property Items[Idx: Integer]: TDataValue read GetItem; default;
end;
TDataValueHelper = record helper for TDataValue
public
function AsTuple: TTupleValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsTuple: TTupleType;
end;
// Public factory for creating simple, non-cached tuple values.
TTuple = record
public
class function Create(const AItems: array of IDataValue): IDataTupleValue; static;
end;
implementation
type
// Implements the simple tuple data value.
TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
@@ -73,67 +26,13 @@ type
class constructor CreateClass;
private
function GetName: String;
function GetKind: TDataKind;
public
function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
class property Singleton: IDataTupleType read FSingleton;
end;
{ TTupleValue }
constructor TTupleValue.Create(const ATupleValue: IDataTupleValue);
begin
FTupleValue := ATupleValue;
end;
function TTupleValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FTupleValue) then
Result := FTupleValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
function TTupleValue.GetItemCount: Integer;
begin
if Assigned(FTupleValue) then
Result := FTupleValue.ItemCount
else
Result := 0;
end;
class operator TTupleValue.Implicit(const A: TTupleValue): IDataTupleValue;
begin
Result := A.FTupleValue;
end;
class operator TTupleValue.Implicit(const A: IDataTupleValue): TTupleValue;
begin
Result.FTupleValue := A;
end;
{ TTupleType }
constructor TTupleType.Create(const ATupleType: IDataTupleType);
begin
FTupleType := ATupleType;
end;
function TTupleType.GetName: String;
begin
if Assigned(FTupleType) then
Result := FTupleType.Name
else
Result := '';
end;
class operator TTupleType.Implicit(const A: TTupleType): IDataTupleType;
begin
Result := A.FTupleType;
end;
class operator TTupleType.Implicit(const A: IDataTupleType): TTupleType;
begin
Result.FTupleType := A;
end;
implementation
{ TImplDataTupleValue }
@@ -169,32 +68,19 @@ begin
FSingleton := TImplDataTupleType.Create;
end;
function TImplDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
begin
Result := TImplDataTupleValue.Create(AItems);
end;
function TImplDataTupleType.GetName: String;
begin
Result := 'Tuple';
end;
{ TDataValueHelper }
function TDataValueHelper.AsTuple: TTupleValue;
function TImplDataTupleType.GetKind: TDataKind;
begin
Result := Self.DataValue as IDataTupleValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsTuple: TTupleType;
begin
Result := Self.DataType as IDataTupleType;
end;
{ TTuple }
class function TTuple.Create(const AItems: array of IDataValue): IDataTupleValue;
begin
// Create a new value instance. The instance itself knows its item count
// and will report the singleton "Tuple" type via its DataType property.
Result := TImplDataTupleValue.Create(AItems);
Result := dkTuple;
end;
end.
Src/Data/Myc.Data.Types.pas
+225 -12
View File
@@ -2,10 +2,18 @@ unit Myc.Data.Types;
interface
uses
System.Generics.Collections,
System.SysUtils;
type
TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray);
IDataType = interface
function GetName: String;
function GetKind: TDataKind;
property Name: String read GetName;
property Kind: TDataKind read GetKind;
end;
IDataValue = interface
@@ -14,29 +22,42 @@ type
end;
IDataOrdinalValue = interface(IDataValue)
['{DF512FD0-D513-4B96-9687-C80624E475A4}']
function GetValue: Int64;
property Value: Int64 read GetValue;
end;
IDataOrdinalType = interface(IDataType)
['{BE97F145-3634-4F56-9783-FD2C3DD485CA}']
function CreateValue(Init: Int64): IDataOrdinalValue;
end;
IDataFloatValue = interface(IDataValue)
['{A6E1E8B5-B8E5-4F4B-9B2E-8E8E9F8F8B8E}']
function GetValue: Double;
property Value: Double read GetValue;
end;
IDataFloatType = interface(IDataType)
['{B7E2E9B6-B9E6-4F5B-9C3E-9E9E0F9F9C9F}']
function CreateValue(Init: Double): IDataFloatValue;
end;
IDataTextValue = interface(IDataValue)
function GetValue: string;
property Value: string read GetValue;
end;
IDataTextType = interface(IDataType)
function CreateValue(const AValue: string): IDataTextValue;
end;
IDataTimestampValue = interface(IDataValue)
function GetValue: TDateTime;
property Value: TDateTime read GetValue;
end;
IDataTimestampType = interface(IDataType)
function CreateValue(const AValue: TDateTime): IDataTimestampValue;
end;
IDataRecordValue = interface(IDataValue)
['{53B63A49-720D-4E3E-8EE5-3EA45BA93E58}']
function GetItem(Idx: Integer): IDataValue;
property Items[Idx: Integer]: IDataValue read GetItem; default;
end;
@@ -44,12 +65,10 @@ type
TRecordField = record
Name: string;
DataType: IDataType;
public
constructor Create(const AName: string; const ADataType: IDataType);
end;
IDataRecordType = interface(IDataType)
['{7A266BA0-B1AF-416B-941F-A730D6EDA333}']
function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer;
@@ -59,7 +78,6 @@ type
end;
IDataTupleValue = interface(IDataValue)
['{E1D5B0D1-8A1C-4B7E-9F2D-3A4B5C6D7E8F}']
function GetItemCount: Integer;
function GetItem(Idx: Integer): IDataValue;
property ItemCount: Integer read GetItemCount;
@@ -67,11 +85,10 @@ type
end;
IDataTupleType = interface(IDataType)
['{9442043E-99AC-4464-99E4-75F1BE1F3118}']
function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
end;
IDataArrayValue = interface(IDataValue)
['{1F3A4B5C-6D7E-4F1A-8B9C-0D1E2F3A4B5C}']
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
property ElementCount: Integer read GetElementCount;
@@ -79,22 +96,38 @@ type
end;
IDataArrayType = interface(IDataType)
['{7E8F9A0B-C1D2-4E3F-A4B5-C6D7E8F9A0B1}']
function GetElementType: IDataType;
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
property ElementType: IDataType read GetElementType;
end;
TDataType = record
private
strict private
FDataType: IDataType;
function GetName: String; inline;
class var
FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
class var
FRecordTypeRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
class constructor CreateClass;
class destructor DestroyClass;
public
constructor Create(const ADataType: IDataType);
class operator Implicit(const A: IDataType): TDataType; overload;
class operator Implicit(const A: TDataType): IDataType; overload;
// Type factories
class function Ordinal: IDataOrdinalType; static;
class function Float: IDataFloatType; static;
class function Text: IDataTextType; static;
class function Timestamp: IDataTimestampType; static;
class function Tuple: IDataTupleType; static;
class function ArrayOfType(const AElementType: IDataType): IDataArrayType; static;
class function RecordOf(const Fields: TArray<TRecordField>): IDataRecordType; overload; static;
class function RecordOf(const Fields: array of TRecordField): IDataRecordType; overload; static;
property DataType: IDataType read FDataType;
property Name: String read GetName;
end;
@@ -106,15 +139,42 @@ type
public
constructor Create(const ADataValue: IDataValue);
// Casting
function AsOrdinal: IDataOrdinalValue;
function AsFloat: IDataFloatValue;
function AsText: IDataTextValue;
function AsTimestamp: IDataTimestampValue;
function AsRecord: IDataRecordValue;
function AsTuple: IDataTupleValue;
function AsArray: IDataArrayValue;
class operator Implicit(const A: IDataValue): TDataValue; overload;
class operator Implicit(const A: TDataValue): IDataValue; overload;
// Value factories
class function FromOrdinal(const AValue: Int64): IDataOrdinalValue; static;
class function FromFloat(const AValue: Double): IDataFloatValue; static;
class function FromText(const AValue: string): IDataTextValue; static;
class function FromTimestamp(const AValue: TDateTime): IDataTimestampValue; static;
class function FromTuple(const AItems: array of IDataValue): IDataTupleValue; static;
property DataValue: IDataValue read FDataValue;
property DataType: IDataType read GetDataType;
end;
implementation
uses
System.SyncObjs,
System.Generics.Defaults,
Myc.Data.Types.Ordinal,
Myc.Data.Types.Float,
Myc.Data.Types.Text,
Myc.Data.Types.Timestamp,
Myc.Data.Types.Arrays,
Myc.Data.Types.Records,
Myc.Data.Types.Tuple;
{ TRecordField }
constructor TRecordField.Create(const AName: string; const ADataType: IDataType);
@@ -130,6 +190,40 @@ begin
FDataType := ADataType;
end;
class constructor TDataType.CreateClass;
begin
FArrayTypeRegistry := TDictionary<IDataType, IDataArrayType>.Create;
FRecordTypeRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
end;
class destructor TDataType.DestroyClass;
begin
FArrayTypeRegistry.Free;
FRecordTypeRegistry.Free;
end;
class function TDataType.ArrayOfType(const AElementType: IDataType): IDataArrayType;
begin
if not Assigned(AElementType) then
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
TMonitor.Enter(FArrayTypeRegistry);
try
if not FArrayTypeRegistry.TryGetValue(AElementType, Result) then
begin
Result := TImplDataArrayType.Create(AElementType);
FArrayTypeRegistry.Add(AElementType, Result);
end;
finally
TMonitor.Exit(FArrayTypeRegistry);
end;
end;
class function TDataType.Float: IDataFloatType;
begin
Result := TImplDataFloatType.Singleton;
end;
function TDataType.GetName: String;
begin
if Assigned(FDataType) then
@@ -138,6 +232,51 @@ begin
Result := '';
end;
class function TDataType.Ordinal: IDataOrdinalType;
begin
Result := TImplDataOrdinalType.Singleton;
end;
class function TDataType.RecordOf(const Fields: TArray<TRecordField>): IDataRecordType;
begin
TMonitor.Enter(FRecordTypeRegistry);
try
if not FRecordTypeRegistry.TryGetValue(Fields, Result) then
begin
Result := TImplDataRecordType.Create(Fields);
FRecordTypeRegistry.Add(Fields, Result);
end;
finally
TMonitor.Exit(FRecordTypeRegistry);
end;
end;
class function TDataType.RecordOf(const Fields: array of TRecordField): IDataRecordType;
var
tFields: TArray<TRecordField>;
i: Integer;
begin
SetLength(tFields, Length(Fields));
for i := 0 to High(Fields) do
tFields[i] := Fields[i];
Result := RecordOf(tFields);
end;
class function TDataType.Text: IDataTextType;
begin
Result := TImplDataTextType.Singleton;
end;
class function TDataType.Timestamp: IDataTimestampType;
begin
Result := TImplDataTimestampType.Singleton;
end;
class function TDataType.Tuple: IDataTupleType;
begin
Result := TImplDataTupleType.Singleton;
end;
class operator TDataType.Implicit(const A: TDataType): IDataType;
begin
Result := A.FDataType;
@@ -155,6 +294,80 @@ begin
FDataValue := ADataValue;
end;
function TDataValue.AsArray: IDataArrayValue;
begin
if FDataValue.DataType.Kind <> dkArray then
raise EInvalidCast.Create('Array expected');
Result := IDataArrayValue(FDataValue);
end;
function TDataValue.AsFloat: IDataFloatValue;
begin
if FDataValue.DataType.Kind <> dkFloat then
raise EInvalidCast.Create('Float expected');
Result := IDataFloatValue(FDataValue);
end;
function TDataValue.AsText: IDataTextValue;
begin
if FDataValue.DataType.Kind <> dkText then
raise EInvalidCast.Create('Text expected');
Result := IDataTextValue(FDataValue);
end;
function TDataValue.AsTimestamp: IDataTimestampValue;
begin
if FDataValue.DataType.Kind <> dkTimestamp then
raise EInvalidCast.Create('Timestamp expected');
Result := IDataTimestampValue(FDataValue);
end;
function TDataValue.AsOrdinal: IDataOrdinalValue;
begin
if FDataValue.DataType.Kind <> dkOrdinal then
raise EInvalidCast.Create('Ordinal expected');
Result := IDataOrdinalValue(FDataValue);
end;
function TDataValue.AsRecord: IDataRecordValue;
begin
if FDataValue.DataType.Kind <> dkRecord then
raise EInvalidCast.Create('Record expected');
Result := IDataRecordValue(FDataValue);
end;
function TDataValue.AsTuple: IDataTupleValue;
begin
if FDataValue.DataType.Kind <> dkTuple then
raise EInvalidCast.Create('Tuple expected');
Result := IDataTupleValue(FDataValue);
end;
class function TDataValue.FromOrdinal(const AValue: Int64): IDataOrdinalValue;
begin
Result := TImplDataOrdinalType.Singleton.CreateValue(AValue);
end;
class function TDataValue.FromFloat(const AValue: Double): IDataFloatValue;
begin
Result := TImplDataFloatType.Singleton.CreateValue(AValue);
end;
class function TDataValue.FromText(const AValue: string): IDataTextValue;
begin
Result := TImplDataTextType.Singleton.CreateValue(AValue);
end;
class function TDataValue.FromTimestamp(const AValue: TDateTime): IDataTimestampValue;
begin
Result := TImplDataTimestampType.Singleton.CreateValue(AValue);
end;
class function TDataValue.FromTuple(const AItems: array of IDataValue): IDataTupleValue;
begin
Result := TImplDataTupleType.Singleton.CreateValue(AItems);
end;
function TDataValue.GetDataType: IDataType;
begin
if Assigned(FDataValue) then
Src/Data/TestDataTypes.pas
+283
View File
@@ -0,0 +1,283 @@
unit TestDataTypes;
interface
uses
DUnitX.TestFramework;
type
[TestFixture]
TMyTestObject = class
public
[Test]
procedure TestCreateRecords;
[Test]
procedure TestTuples;
[Test]
procedure TestArrays;
[Test]
procedure TestTexts;
[Test]
procedure TestTimestamps;
end;
implementation
uses
System.SysUtils,
Myc.Data.Types;
{ TMyTestObject }
procedure TMyTestObject.TestCreateRecords;
var
intType: IDataType;
floatType: IDataType;
personType1, personType2, otherType: IDataRecordType;
personValue: IDataValue;
idValue: IDataOrdinalValue;
floatValue: IDataFloatValue;
begin
// --- 1. Setup: Define base types and a record structure ---
intType := TDataType.Ordinal;
floatType := TDataType.Float;
// --- 2. Test Type Creation and Caching ---
personType1 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
// Assertions for the created type
Assert.IsNotNull(personType1, 'RecordType should be created');
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
Assert.AreSame(intType, personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value');
Assert.AreSame(floatType, personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0');
Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
Assert.AreEqual('Record<ID: Integer, Value: Float>', personType1.Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance
personType2 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance');
// Test if a different definition returns a new instance
otherType := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Data', floatType)]);
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types');
// --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]);
Assert.IsNotNull(TDataValue(personValue).AsRecord, 'RecordValue should be created');
Assert.AreSame(personType1, TDataValue(personValue).DataType, 'Value should have the correct data type');
// Access by index
idValue := TDataValue(TDataValue(personValue).AsRecord.Items[0]).AsOrdinal;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[1]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[personType1.IndexOf('Value')]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test for duplicate field names during type creation
Assert.WillRaise(
procedure begin TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('ID', floatType)]); end,
EArgumentException,
'Duplicate field names should raise an exception'
);
// Test for wrong number of items during value creation
Assert.WillRaise(
procedure begin personType1.CreateValue([TDataValue.FromOrdinal(99)]); end,
EArgumentException,
'Wrong number of items should raise exception'
);
// Test for wrong item type during value creation
Assert.WillRaise(
procedure
begin
// Passing Float instead of Integer for the first item
personType1.CreateValue([TDataValue.FromFloat(1.0), TDataValue.FromFloat(2.0)]);
end,
EArgumentException,
'Wrong item type should raise exception'
);
end;
procedure TMyTestObject.TestTuples;
var
intValue: IDataValue;
floatValue: IDataValue;
tuple1, tuple2, tuple3: IDataTupleValue;
type1, type2, type3: IDataType;
begin
// --- 1. Setup: Create some values ---
intValue := TDataValue.FromOrdinal(123);
floatValue := TDataValue.FromFloat(45.67);
// --- 2. Test Value Creation and basic properties ---
tuple1 := TDataValue.FromTuple([intValue, floatValue]);
Assert.IsNotNull(tuple1, 'Tuple value should be created');
Assert.AreEqual(2, TDataValue(tuple1).AsTuple.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(intValue, TDataValue(tuple1).AsTuple.Items[0], 'Item at index 0 is incorrect');
Assert.AreSame(floatValue, TDataValue(tuple1).AsTuple.Items[1], 'Item at index 1 is incorrect');
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
tuple2 := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromFloat(1.1)]);
tuple3 := TDataValue.FromTuple([intValue]);
// Access the DataType via the underlying interface
type1 := tuple1.DataType;
type2 := tuple2.DataType;
type3 := tuple3.DataType;
Assert.IsNotNull(type1, 'DataType interface should be accessible');
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
// The core test: All tuples, regardless of their content, must share the exact same singleton type object.
Assert.AreSame(type1, type2, 'All tuple types should be the same singleton instance');
Assert.AreSame(type1, type3, 'All tuple types should be the same singleton instance');
end;
procedure TMyTestObject.TestArrays;
var
intType: IDataType;
floatType: IDataType;
intArrayType1, intArrayType2, floatArrayType: IDataArrayType;
arrayValue: IDataArrayValue;
v1, v2: IDataValue;
begin
// --- 1. Setup ---
intType := TDataType.Ordinal;
floatType := TDataType.Float;
// --- 2. Test Type Creation and Caching ---
intArrayType1 := TDataType.ArrayOfType(intType);
Assert.IsNotNull(intArrayType1, 'ArrayType should be created');
Assert.AreSame(intType, intArrayType1.ElementType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
// Test caching
intArrayType2 := TDataType.ArrayOfType(intType);
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
// Test uniqueness
floatArrayType := TDataType.ArrayOfType(floatType);
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types');
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TDataValue.FromOrdinal(10);
v2 := TDataValue.FromOrdinal(20);
arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(arrayValue, 'ArrayValue should be created');
Assert.AreEqual(2, TDataValue(arrayValue).AsArray.ElementCount, 'ElementCount should be 2');
// Access items and check values
Assert.AreEqual(Int64(10), TDataValue(TDataValue(arrayValue).AsArray.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(TDataValue(arrayValue).AsArray.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
Assert.WillRaise(procedure begin TDataType.ArrayOfType(nil); end, EArgumentException, 'Nil element type should raise an exception');
// Test creating a value with an incorrect element type (homogeneity check)
Assert.WillRaise(
procedure
begin
// Try to add a float value to an Array<Integer>
intArrayType1.CreateValue([v1, TDataValue.FromFloat(3.14)]);
end,
EArgumentException,
'Wrong element type should raise an exception'
);
end;
procedure TMyTestObject.TestTexts;
var
textType: IDataTextType;
textValue1, textValue2: IDataTextValue;
dataValue: IDataValue;
begin
// --- 1. Test Type Creation ---
textType := TDataType.Text;
Assert.IsNotNull(textType, 'TextType should be created');
Assert.AreEqual('Text', textType.Name, 'Type name should be Text');
Assert.AreEqual(dkText, textType.Kind, 'Type kind should be dkText');
// --- 2. Test Value Creation and Access ---
textValue1 := TDataValue.FromText('Hello World');
Assert.IsNotNull(textValue1, 'TextValue should be created');
Assert.AreSame(textType, textValue1.DataType, 'Value should have the correct data type');
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
// Test another text value
textValue2 := TDataValue.FromText('Delphi');
Assert.AreEqual('Delphi', textValue2.Value, 'Value should be ''Delphi''');
// --- 3. Test AsText casting ---
dataValue := TDataValue.FromText('Test Text');
Assert.AreEqual('Test Text', TDataValue(dataValue).AsText.Value, 'AsText should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
Assert
.WillRaise(procedure begin TDataValue(dataValue).AsText; end, EInvalidCast, 'Casting non-text to AsText should raise EInvalidCast');
end;
procedure TMyTestObject.TestTimestamps;
var
tsType: IDataTimestampType;
tsValue1, tsValue2: IDataTimestampValue;
dataValue: IDataValue;
now: TDateTime;
begin
// --- 1. Test Type Creation ---
tsType := TDataType.Timestamp;
Assert.IsNotNull(tsType, 'TimestampType should be created');
Assert.AreEqual('Timestamp', tsType.Name, 'Type name should be Timestamp');
Assert.AreEqual(dkTimestamp, tsType.Kind, 'Type kind should be dkTimestamp');
// --- 2. Test Value Creation and Access ---
now := Now;
tsValue1 := TDataValue.FromTimestamp(now);
Assert.IsNotNull(tsValue1, 'TimestampValue should be created');
Assert.AreSame(tsType, tsValue1.DataType, 'Value should have the correct data type');
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
// Test another text value
tsValue2 := TDataValue.FromTimestamp(Date);
Assert.AreEqual(Date, tsValue2.Value, 'Value should be the same');
// --- 3. Test AsTimestamp casting ---
dataValue := TDataValue.FromTimestamp(now);
Assert.AreEqual(now, TDataValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
Assert.WillRaise(
procedure begin TDataValue(dataValue).AsTimestamp; end,
EInvalidCast,
'Casting non-timestamp to AsTimestamp should raise EInvalidCast'
);
end;
initialization
TDUnitX.RegisterTestFixture(TMyTestObject);
end.
Test/MycTests.dpr
+2 -2
View File
@@ -29,9 +29,9 @@ uses
Myc.Data.Types in '..\Src\Myc.Data.Types.pas',
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
Myc.Data.Types.Records in 'Myc.Data.Types.Records.pas',
TestDataTypes in 'TestDataTypes.pas',
Myc.Data.Types.Float in 'Myc.Data.Types.Float.pas',
Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.pas';
Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.pas',
TestDataTypes in '..\Src\Data\TestDataTypes.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
Test/MycTests.dproj
+1 -1
View File
@@ -130,9 +130,9 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Data.Types.pas"/>
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/>
<DCCReference Include="Myc.Data.Types.Records.pas"/>
<DCCReference Include="TestDataTypes.pas"/>
<DCCReference Include="Myc.Data.Types.Float.pas"/>
<DCCReference Include="Myc.Data.Types.Arrays.pas"/>
<DCCReference Include="..\Src\Data\TestDataTypes.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Test/TestDataTypes.pas
-231
View File
@@ -1,231 +0,0 @@
unit TestDataTypes;
interface
uses
DUnitX.TestFramework;
type
[TestFixture]
TMyTestObject = class
public
[Test]
procedure TestCreateRecords;
[Test]
procedure TestTuples;
[Test]
procedure TestArrays;
end;
implementation
uses
System.SysUtils,
Myc.Data.Types,
Myc.Data.Types.Ordinal,
Myc.Data.Types.Float,
Myc.Data.Types.Tuple,
Myc.Data.Types.Arrays,
Myc.Data.Types.Records;
{ TMyTestObject }
procedure TMyTestObject.TestCreateRecords;
var
intType: TDataType;
floatType: TDataType;
fieldDef: TArray<TRecordField>;
personType1, personType2, otherType: TRecordType;
personValue: TDataValue;
idValue: IDataOrdinalValue;
floatValue: IDataFloatValue;
begin
// --- 1. Setup: Define base types and a record structure ---
intType := TOrdinalType.CreateValue(0).DataType;
floatType := TFloatType.CreateValue(0.0).DataType;
SetLength(fieldDef, 2);
fieldDef[0] := TRecordField.Create('ID', intType);
fieldDef[1] := TRecordField.Create('Value', floatType);
// --- 2. Test Type Creation and Caching ---
personType1 := TRecordTypes.GetType(fieldDef);
// Assertions for the created type
Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
Assert.AreSame(intType.DataType, personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value');
Assert.AreSame(floatType.DataType, personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0');
Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
Assert.AreEqual('Record<ID: Integer, Value: Float>', personType1.Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance
personType2 := TRecordTypes.GetType(fieldDef);
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance');
// Test if a different definition returns a new instance
fieldDef[1] := TRecordField.Create('Data', floatType); // Change field name
otherType := TRecordTypes.GetType(fieldDef);
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types');
fieldDef[1] := TRecordField.Create('Value', floatType); // Reset for next test
// --- 3. Test Value Creation and Access ---
personType1 := TRecordTypes.GetType(fieldDef); // Get the original type again
personValue := personType1.CreateValue([TOrdinalType.CreateValue(123), TFloatType.CreateValue(45.67)]);
Assert.IsNotNull(IDataRecordValue(personValue.AsRecord), 'RecordValue should be created');
Assert.IsTrue(personType1 = personValue.AsRecord.DataType, 'Value should have the correct data type');
// Access by index
idValue := personValue.AsRecord.Items[0].DataValue as IDataOrdinalValue;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := personValue.AsRecord.Items[1].DataValue as IDataFloatValue;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := personValue.AsRecord.Items[personType1.IndexOf('Value')].DataValue as IDataFloatValue;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test for duplicate field names during type creation
Assert.WillRaise(
procedure
var
duplicateDef: TArray<TRecordField>;
begin
SetLength(duplicateDef, 2);
duplicateDef[0] := TRecordField.Create('ID', intType);
duplicateDef[1] := TRecordField.Create('ID', floatType); // Duplicate name
TRecordTypes.GetType(duplicateDef);
end,
EArgumentException,
'Duplicate field names should raise an exception'
);
// Test for wrong number of items during value creation
Assert.WillRaise(
procedure begin personType1.CreateValue([TOrdinalType.CreateValue(99)]); end,
EArgumentException,
'Wrong number of items should raise exception'
);
// Test for wrong item type during value creation
Assert.WillRaise(
procedure
begin
// Passing Float instead of Integer for the first item
personType1.CreateValue([TFloatType.CreateValue(1.0), TFloatType.CreateValue(2.0)]);
end,
EArgumentException,
'Wrong item type should raise exception'
);
end;
procedure TMyTestObject.TestTuples;
var
intValue: IDataValue;
floatValue: IDataValue;
tuple1, tuple2, tuple3: IDataTupleValue;
tuple1Helper: TTupleValue;
type1, type2, type3: IDataType;
begin
// --- 1. Setup: Create some values ---
intValue := TOrdinalType.CreateValue(123);
floatValue := TFloatType.CreateValue(45.67);
// --- 2. Test Value Creation and basic properties ---
tuple1 := TTuple.Create([intValue, floatValue]);
tuple1Helper := TTupleValue.Create(tuple1); // Use helper for convenience
Assert.IsNotNull(tuple1, 'Tuple value should be created');
Assert.AreEqual(2, tuple1Helper.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(intValue, tuple1Helper.Items[0].DataValue, 'Item at index 0 is incorrect');
Assert.AreSame(floatValue, tuple1Helper.Items[1].DataValue, 'Item at index 1 is incorrect');
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
tuple2 := TTuple.Create([TOrdinalType.CreateValue(99), TFloatType.CreateValue(1.1)]);
tuple3 := TTuple.Create([intValue]);
// Access the DataType via the underlying interface, as the helper is "blind".
type1 := IDataValue(tuple1).DataType;
type2 := IDataValue(tuple2).DataType;
type3 := IDataValue(tuple3).DataType;
Assert.IsNotNull(type1, 'DataType interface should be accessible');
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
// The core test: All tuples, regardless of their content, must share the exact same singleton type object.
Assert.AreSame(type1, type2, 'All tuple types should be the same singleton instance');
Assert.AreSame(type1, type3, 'All tuple types should be the same singleton instance');
end;
procedure TMyTestObject.TestArrays;
var
intType: TDataType;
floatType: TDataType;
intArrayType1, intArrayType2, floatArrayType: TArrayType;
arrayValue: TArrayValue;
v1, v2: IDataValue;
begin
// --- 1. Setup ---
intType := TOrdinalType.CreateValue(0).DataType;
floatType := TFloatType.CreateValue(0.0).DataType;
// --- 2. Test Type Creation and Caching ---
intArrayType1 := TArrayTypes.GetType(intType);
Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
Assert.AreSame(intType.DataType, intArrayType1.ElementType.DataType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
// Test caching
intArrayType2 := TArrayTypes.GetType(intType);
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
// Test uniqueness
floatArrayType := TArrayTypes.GetType(floatType);
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types');
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TOrdinalType.CreateValue(10);
v2 := TOrdinalType.CreateValue(20);
arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
// Access items and check values
Assert.AreEqual(Int64(10), (arrayValue.Items[0].DataValue as IDataOrdinalValue).Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), (arrayValue.Items[1].DataValue as IDataOrdinalValue).Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
Assert.WillRaise(
procedure begin TArrayTypes.GetType(TDataType.Create(nil)); end,
EArgumentException,
'Nil element type should raise an exception'
);
// Test creating a value with an incorrect element type (homogeneity check)
Assert.WillRaise(
procedure
begin
// Try to add a float value to an Array<Integer>
intArrayType1.CreateValue([v1, TFloatType.CreateValue(3.14)]);
end,
EArgumentException,
'Wrong element type should raise an exception'
);
end;
initialization
TDUnitX.RegisterTestFixture(TMyTestObject);
end.