From ce653c83b1766b8136e4fbc372576a703984731f Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 25 Aug 2025 14:01:22 +0200 Subject: [PATCH] Data Types next --- Src/Data/Myc.Data.Types.Arrays.pas | 204 ++----------------- Src/Data/Myc.Data.Types.Float.pas | 52 +---- Src/Data/Myc.Data.Types.Ordinal.pas | 50 +---- Src/Data/Myc.Data.Types.Records.pas | 263 +++--------------------- Src/Data/Myc.Data.Types.Text.pas | 73 +++++++ Src/Data/Myc.Data.Types.Timestamp.pas | 73 +++++++ Src/Data/Myc.Data.Types.Tuple.pas | 134 +----------- Src/Data/Myc.Data.Types.pas | 237 +++++++++++++++++++-- Src/Data/TestDataTypes.pas | 283 ++++++++++++++++++++++++++ Test/MycTests.dpr | 4 +- Test/MycTests.dproj | 2 +- Test/TestDataTypes.pas | 231 --------------------- 12 files changed, 728 insertions(+), 878 deletions(-) create mode 100644 Src/Data/Myc.Data.Types.Text.pas create mode 100644 Src/Data/Myc.Data.Types.Timestamp.pas create mode 100644 Src/Data/TestDataTypes.pas delete mode 100644 Test/TestDataTypes.pas diff --git a/Src/Data/Myc.Data.Types.Arrays.pas b/Src/Data/Myc.Data.Types.Arrays.pas index 7fc3605..8fd46be 100644 --- a/Src/Data/Myc.Data.Types.Arrays.pas +++ b/Src/Data/Myc.Data.Types.Arrays.pas @@ -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; - 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.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. diff --git a/Src/Data/Myc.Data.Types.Float.pas b/Src/Data/Myc.Data.Types.Float.pas index 512a0b6..094d30c 100644 --- a/Src/Data/Myc.Data.Types.Float.pas +++ b/Src/Data/Myc.Data.Types.Float.pas @@ -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. diff --git a/Src/Data/Myc.Data.Types.Ordinal.pas b/Src/Data/Myc.Data.Types.Ordinal.pas index b7865cb..de27d31 100644 --- a/Src/Data/Myc.Data.Types.Ordinal.pas +++ b/Src/Data/Myc.Data.Types.Ordinal.pas @@ -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. diff --git a/Src/Data/Myc.Data.Types.Records.pas b/Src/Data/Myc.Data.Types.Records.pas index b423e58..54b8036 100644 --- a/Src/Data/Myc.Data.Types.Records.pas +++ b/Src/Data/Myc.Data.Types.Records.pas @@ -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, IDataRecordType>; - class constructor CreateClass; - class destructor DestroyClass; - public - class function GetType(const AFields: TArray): TRecordType; static; - end; - -implementation - -uses - System.Generics.Defaults, - System.Hash, - System.SyncObjs; - -type - {fwd} - TImplDataRecordType = class; - // Custom comparer for TArray to be used as a dictionary key. TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer>) public @@ -89,6 +17,24 @@ type function GetHashCode(const Value: TArray): Integer; reintroduce; end; + TImplDataRecordValue = class; // fwd + + // Implements the record data type. + TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType) + private + FFields: TArray; + FFieldMap: TDictionary; // 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; - FFieldMap: TDictionary; // 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, IDataRecordType>.Create(TRecordFieldComparer.Create); -end; - -class destructor TRecordTypes.DestroyClass; -begin - FRegistry.Free; -end; - -class function TRecordTypes.GetType(const AFields: TArray): 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. diff --git a/Src/Data/Myc.Data.Types.Text.pas b/Src/Data/Myc.Data.Types.Text.pas new file mode 100644 index 0000000..5739b76 --- /dev/null +++ b/Src/Data/Myc.Data.Types.Text.pas @@ -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. diff --git a/Src/Data/Myc.Data.Types.Timestamp.pas b/Src/Data/Myc.Data.Types.Timestamp.pas new file mode 100644 index 0000000..377c453 --- /dev/null +++ b/Src/Data/Myc.Data.Types.Timestamp.pas @@ -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. diff --git a/Src/Data/Myc.Data.Types.Tuple.pas b/Src/Data/Myc.Data.Types.Tuple.pas index 93f3c8e..f68220b 100644 --- a/Src/Data/Myc.Data.Types.Tuple.pas +++ b/Src/Data/Myc.Data.Types.Tuple.pas @@ -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. diff --git a/Src/Data/Myc.Data.Types.pas b/Src/Data/Myc.Data.Types.pas index 143e1c6..7d715d4 100644 --- a/Src/Data/Myc.Data.Types.pas +++ b/Src/Data/Myc.Data.Types.pas @@ -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; + class var + FRecordTypeRegistry: TDictionary, 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): 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.Create; + FRecordTypeRegistry := TDictionary, 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): 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; + 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 diff --git a/Src/Data/TestDataTypes.pas b/Src/Data/TestDataTypes.pas new file mode 100644 index 0000000..baea821 --- /dev/null +++ b/Src/Data/TestDataTypes.pas @@ -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', 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', intArrayType1.Name, 'Type name should be Array'); + + // 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', floatArrayType.Name, 'Type name should be Array'); + + // --- 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 + 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. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index e968096..883c047 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -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} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index db7c46c..0ef366c 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -130,9 +130,9 @@ $(PreBuildEvent)]]> - + Base diff --git a/Test/TestDataTypes.pas b/Test/TestDataTypes.pas deleted file mode 100644 index c3a73cf..0000000 --- a/Test/TestDataTypes.pas +++ /dev/null @@ -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; - 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', 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; - 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', intArrayType1.Name, 'Type name should be Array'); - - // 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', floatArrayType.Name, 'Type name should be Array'); - - // --- 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 - intArrayType1.CreateValue([v1, TFloatType.CreateValue(3.14)]); - end, - EArgumentException, - 'Wrong element type should raise an exception' - ); -end; - -initialization - TDUnitX.RegisterTestFixture(TMyTestObject); - -end.