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; Myc.Data.Types;
type type
// An interface helper for IDataArrayValue. TImplDataArrayValue = class; // fwd
TArrayValue = record
// Implements the array data type.
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private private
FArrayValue: IDataArrayValue; FElementType: IDataType;
function GetElementCount: Integer; inline; function GetElementType: IDataType;
function GetItem(Idx: Integer): TDataValue; inline; function GetName: String;
function GetKind: TDataKind;
public public
constructor Create(const AArrayValue: IDataArrayValue); constructor Create(const AElementType: IDataType);
function CreateValue(const AItems: array of IDataValue): 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;
end; 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. // Implements the array data value.
TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue) TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private private
@@ -84,90 +34,10 @@ type
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue); constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end; end;
// Implements the array data type. implementation
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;
{ TArrayValue } uses
System.SyncObjs;
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;
{ TImplDataArrayValue } { TImplDataArrayValue }
@@ -233,53 +103,9 @@ begin
Result := Format('Array<%s>', [FElementType.Name]); Result := Format('Array<%s>', [FElementType.Name]);
end; end;
{ TDataValueHelper } function TImplDataArrayType.GetKind: TDataKind;
function TDataValueHelper.AsArray: TArrayValue;
begin begin
Result := Self.DataValue as IDataArrayValue; Result := dkArray;
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;
end; end;
end. end.
Src/Data/Myc.Data.Types.Float.pas
+9 -43
View File
@@ -3,30 +3,9 @@ unit Myc.Data.Types.Float;
interface interface
uses uses
System.SysUtils,
Myc.Data.Types; 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 type
// Implements the float data value. // Implements the float data value.
TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue) TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
@@ -50,10 +29,13 @@ type
class constructor CreateClass; class constructor CreateClass;
public public
function GetName: String; function GetName: String;
function GetKind: TDataKind;
function CreateValue(Init: Double): IDataFloatValue; function CreateValue(Init: Double): IDataFloatValue;
class property Singleton: IDataFloatType read FSingleton; class property Singleton: IDataFloatType read FSingleton;
end; end;
implementation
{ TImplDataFloatValue } { TImplDataFloatValue }
constructor TImplDataFloatValue.Create(const AValue: Double); constructor TImplDataFloatValue.Create(const AValue: Double);
@@ -84,30 +66,14 @@ begin
Result := 'Float'; Result := 'Float';
end; end;
function TImplDataFloatType.GetKind: TDataKind;
begin
Result := dkFloat;
end;
function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue; function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
begin begin
Result := TImplDataFloatValue.Create(Init); Result := TImplDataFloatValue.Create(Init);
end; 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. end.
Src/Data/Myc.Data.Types.Ordinal.pas
+9 -41
View File
@@ -3,26 +3,7 @@ unit Myc.Data.Types.Ordinal;
interface interface
uses uses
Myc.Data.Types; 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
System.SysUtils; System.SysUtils;
type type
@@ -48,10 +29,13 @@ type
class constructor CreateClass; class constructor CreateClass;
public public
function GetName: String; function GetName: String;
function GetKind: TDataKind;
function CreateValue(Init: Int64): IDataOrdinalValue; function CreateValue(Init: Int64): IDataOrdinalValue;
class property Singleton: IDataOrdinalType read FSingleton; class property Singleton: IDataOrdinalType read FSingleton;
end; end;
implementation
{ TImplDataOrdinalValue } { TImplDataOrdinalValue }
constructor TImplDataOrdinalValue.Create(const AValue: Int64); constructor TImplDataOrdinalValue.Create(const AValue: Int64);
@@ -82,30 +66,14 @@ begin
Result := 'Integer'; Result := 'Integer';
end; end;
function TImplDataOrdinalType.GetKind: TDataKind;
begin
Result := dkOrdinal;
end;
function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue; function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin begin
Result := TImplDataOrdinalValue.Create(Init); Result := TImplDataOrdinalValue.Create(Init);
end; 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. end.
Src/Data/Myc.Data.Types.Records.pas
+28 -235
View File
@@ -5,83 +5,11 @@ interface
uses uses
System.Generics.Collections, System.Generics.Collections,
System.SysUtils, System.SysUtils,
System.Generics.Defaults,
System.Hash,
Myc.Data.Types; Myc.Data.Types;
type 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. // Custom comparer for TArray<TRecordField> to be used as a dictionary key.
TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>) TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>)
public public
@@ -89,6 +17,24 @@ type
function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce; function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce;
end; 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. // Implements the record data value.
TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue) TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
private private
@@ -100,125 +46,10 @@ type
constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
end; end;
// Implements the record data type. implementation
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;
{ TRecordValue } uses
System.SyncObjs;
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;
{ TRecordFieldComparer } { TRecordFieldComparer }
@@ -347,53 +178,15 @@ begin
end; end;
end; end;
function TImplDataRecordType.GetKind: TDataKind;
begin
Result := dkRecord;
end;
function TImplDataRecordType.IndexOf(const AName: string): Integer; function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin begin
if not FFieldMap.TryGetValue(AName, Result) then if not FFieldMap.TryGetValue(AName, Result) then
Result := -1; Result := -1;
end; 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. 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, System.SysUtils,
Myc.Data.Types; 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 type
// Implements the simple tuple data value. // Implements the simple tuple data value.
TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
@@ -73,67 +26,13 @@ type
class constructor CreateClass; class constructor CreateClass;
private private
function GetName: String; function GetName: String;
function GetKind: TDataKind;
public public
function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
class property Singleton: IDataTupleType read FSingleton; class property Singleton: IDataTupleType read FSingleton;
end; end;
{ TTupleValue } implementation
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;
{ TImplDataTupleValue } { TImplDataTupleValue }
@@ -169,32 +68,19 @@ begin
FSingleton := TImplDataTupleType.Create; FSingleton := TImplDataTupleType.Create;
end; end;
function TImplDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
begin
Result := TImplDataTupleValue.Create(AItems);
end;
function TImplDataTupleType.GetName: String; function TImplDataTupleType.GetName: String;
begin begin
Result := 'Tuple'; Result := 'Tuple';
end; end;
{ TDataValueHelper } function TImplDataTupleType.GetKind: TDataKind;
function TDataValueHelper.AsTuple: TTupleValue;
begin begin
Result := Self.DataValue as IDataTupleValue; Result := dkTuple;
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);
end; end;
end. end.
Src/Data/Myc.Data.Types.pas
+225 -12
View File
@@ -2,10 +2,18 @@ unit Myc.Data.Types;
interface interface
uses
System.Generics.Collections,
System.SysUtils;
type type
TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray);
IDataType = interface IDataType = interface
function GetName: String; function GetName: String;
function GetKind: TDataKind;
property Name: String read GetName; property Name: String read GetName;
property Kind: TDataKind read GetKind;
end; end;
IDataValue = interface IDataValue = interface
@@ -14,29 +22,42 @@ type
end; end;
IDataOrdinalValue = interface(IDataValue) IDataOrdinalValue = interface(IDataValue)
['{DF512FD0-D513-4B96-9687-C80624E475A4}']
function GetValue: Int64; function GetValue: Int64;
property Value: Int64 read GetValue; property Value: Int64 read GetValue;
end; end;
IDataOrdinalType = interface(IDataType) IDataOrdinalType = interface(IDataType)
['{BE97F145-3634-4F56-9783-FD2C3DD485CA}']
function CreateValue(Init: Int64): IDataOrdinalValue; function CreateValue(Init: Int64): IDataOrdinalValue;
end; end;
IDataFloatValue = interface(IDataValue) IDataFloatValue = interface(IDataValue)
['{A6E1E8B5-B8E5-4F4B-9B2E-8E8E9F8F8B8E}']
function GetValue: Double; function GetValue: Double;
property Value: Double read GetValue; property Value: Double read GetValue;
end; end;
IDataFloatType = interface(IDataType) IDataFloatType = interface(IDataType)
['{B7E2E9B6-B9E6-4F5B-9C3E-9E9E0F9F9C9F}']
function CreateValue(Init: Double): IDataFloatValue; function CreateValue(Init: Double): IDataFloatValue;
end; 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) IDataRecordValue = interface(IDataValue)
['{53B63A49-720D-4E3E-8EE5-3EA45BA93E58}']
function GetItem(Idx: Integer): IDataValue; function GetItem(Idx: Integer): IDataValue;
property Items[Idx: Integer]: IDataValue read GetItem; default; property Items[Idx: Integer]: IDataValue read GetItem; default;
end; end;
@@ -44,12 +65,10 @@ type
TRecordField = record TRecordField = record
Name: string; Name: string;
DataType: IDataType; DataType: IDataType;
public
constructor Create(const AName: string; const ADataType: IDataType); constructor Create(const AName: string; const ADataType: IDataType);
end; end;
IDataRecordType = interface(IDataType) IDataRecordType = interface(IDataType)
['{7A266BA0-B1AF-416B-941F-A730D6EDA333}']
function GetFieldCount: Integer; function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField; function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer; function IndexOf(const AName: string): Integer;
@@ -59,7 +78,6 @@ type
end; end;
IDataTupleValue = interface(IDataValue) IDataTupleValue = interface(IDataValue)
['{E1D5B0D1-8A1C-4B7E-9F2D-3A4B5C6D7E8F}']
function GetItemCount: Integer; function GetItemCount: Integer;
function GetItem(Idx: Integer): IDataValue; function GetItem(Idx: Integer): IDataValue;
property ItemCount: Integer read GetItemCount; property ItemCount: Integer read GetItemCount;
@@ -67,11 +85,10 @@ type
end; end;
IDataTupleType = interface(IDataType) IDataTupleType = interface(IDataType)
['{9442043E-99AC-4464-99E4-75F1BE1F3118}'] function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
end; end;
IDataArrayValue = interface(IDataValue) IDataArrayValue = interface(IDataValue)
['{1F3A4B5C-6D7E-4F1A-8B9C-0D1E2F3A4B5C}']
function GetElementCount: Integer; function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue; function GetItem(Idx: Integer): IDataValue;
property ElementCount: Integer read GetElementCount; property ElementCount: Integer read GetElementCount;
@@ -79,22 +96,38 @@ type
end; end;
IDataArrayType = interface(IDataType) IDataArrayType = interface(IDataType)
['{7E8F9A0B-C1D2-4E3F-A4B5-C6D7E8F9A0B1}']
function GetElementType: IDataType; function GetElementType: IDataType;
function CreateValue(const AItems: array of IDataValue): IDataArrayValue; function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
property ElementType: IDataType read GetElementType; property ElementType: IDataType read GetElementType;
end; end;
TDataType = record TDataType = record
private strict private
FDataType: IDataType; FDataType: IDataType;
function GetName: String; inline; function GetName: String; inline;
class var
FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
class var
FRecordTypeRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
class constructor CreateClass;
class destructor DestroyClass;
public public
constructor Create(const ADataType: IDataType); constructor Create(const ADataType: IDataType);
class operator Implicit(const A: IDataType): TDataType; overload; class operator Implicit(const A: IDataType): TDataType; overload;
class operator Implicit(const A: TDataType): IDataType; 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 DataType: IDataType read FDataType;
property Name: String read GetName; property Name: String read GetName;
end; end;
@@ -106,15 +139,42 @@ type
public public
constructor Create(const ADataValue: IDataValue); 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: IDataValue): TDataValue; overload;
class operator Implicit(const A: TDataValue): IDataValue; 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 DataValue: IDataValue read FDataValue;
property DataType: IDataType read GetDataType; property DataType: IDataType read GetDataType;
end; end;
implementation 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 } { TRecordField }
constructor TRecordField.Create(const AName: string; const ADataType: IDataType); constructor TRecordField.Create(const AName: string; const ADataType: IDataType);
@@ -130,6 +190,40 @@ begin
FDataType := ADataType; FDataType := ADataType;
end; 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; function TDataType.GetName: String;
begin begin
if Assigned(FDataType) then if Assigned(FDataType) then
@@ -138,6 +232,51 @@ begin
Result := ''; Result := '';
end; 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; class operator TDataType.Implicit(const A: TDataType): IDataType;
begin begin
Result := A.FDataType; Result := A.FDataType;
@@ -155,6 +294,80 @@ begin
FDataValue := ADataValue; FDataValue := ADataValue;
end; 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; function TDataValue.GetDataType: IDataType;
begin begin
if Assigned(FDataValue) then 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 in '..\Src\Myc.Data.Types.pas',
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas', Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
Myc.Data.Types.Records in 'Myc.Data.Types.Records.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.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 } { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT} {$IFNDEF TESTINSIGHT}
Test/MycTests.dproj
+1 -1
View File
@@ -130,9 +130,9 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Data.Types.pas"/> <DCCReference Include="..\Src\Myc.Data.Types.pas"/>
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/> <DCCReference Include="Myc.Data.Types.Ordinal.pas"/>
<DCCReference Include="Myc.Data.Types.Records.pas"/> <DCCReference Include="Myc.Data.Types.Records.pas"/>
<DCCReference Include="TestDataTypes.pas"/>
<DCCReference Include="Myc.Data.Types.Float.pas"/> <DCCReference Include="Myc.Data.Types.Float.pas"/>
<DCCReference Include="Myc.Data.Types.Arrays.pas"/> <DCCReference Include="Myc.Data.Types.Arrays.pas"/>
<DCCReference Include="..\Src\Data\TestDataTypes.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </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.