Proof of concept
This commit is contained in:
parent
d050b7bb1c
commit
f0aed6f1e4
|
@ -0,0 +1,6 @@
|
||||||
|
__history
|
||||||
|
Win32
|
||||||
|
|
||||||
|
*.local
|
||||||
|
*.identcache
|
||||||
|
*.res
|
|
@ -0,0 +1,48 @@
|
||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{CE176D45-2767-4150-B737-D72F170B25C3}</ProjectGuid>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<Projects Include="UnitTests\DaintyUnitTests.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
<Projects Include="Packages\DaintyDXE2.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Default.Personality/>
|
||||||
|
</BorlandProject>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Target Name="DaintyUnitTests">
|
||||||
|
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="DaintyUnitTests:Clean">
|
||||||
|
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="DaintyUnitTests:Make">
|
||||||
|
<MSBuild Projects="UnitTests\DaintyUnitTests.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="DaintyDXE2">
|
||||||
|
<MSBuild Projects="Packages\DaintyDXE2.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="DaintyDXE2:Clean">
|
||||||
|
<MSBuild Projects="Packages\DaintyDXE2.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="DaintyDXE2:Make">
|
||||||
|
<MSBuild Projects="Packages\DaintyDXE2.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Build">
|
||||||
|
<CallTarget Targets="DaintyUnitTests;DaintyDXE2"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Clean">
|
||||||
|
<CallTarget Targets="DaintyUnitTests:Clean;DaintyDXE2:Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Make">
|
||||||
|
<CallTarget Targets="DaintyUnitTests:Make;DaintyDXE2:Make"/>
|
||||||
|
</Target>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/>
|
||||||
|
</Project>
|
|
@ -0,0 +1,39 @@
|
||||||
|
package DaintyDXE2;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
|
||||||
|
{$ALIGN 8}
|
||||||
|
{$ASSERTIONS ON}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO ON}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA ON}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS ON}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION OFF}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO ON}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES ON}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST OFF}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $400000}
|
||||||
|
{$DEFINE DEBUG}
|
||||||
|
{$ENDIF IMPLICITBUILDING}
|
||||||
|
{$RUNONLY}
|
||||||
|
{$IMPLICITBUILD ON}
|
||||||
|
|
||||||
|
requires
|
||||||
|
rtl,
|
||||||
|
dbrtl;
|
||||||
|
|
||||||
|
contains
|
||||||
|
Dainty in '..\Source\Dainty.pas',
|
||||||
|
Dainty.ValueSetter.Default in '..\Source\Dainty.ValueSetter.Default.pas';
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,140 @@
|
||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{EFB63B96-967A-4C05-BD7C-50D48E7E8E43}</ProjectGuid>
|
||||||
|
<MainSource>DaintyDXE2.dpk</MainSource>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<FrameworkType>None</FrameworkType>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Package</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<RuntimeOnlyPackage>true</RuntimeOnlyPackage>
|
||||||
|
<VerInfo_Locale>1043</VerInfo_Locale>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
<DCC_BplOutput>$(DELPHIBIN)</DCC_BplOutput>
|
||||||
|
<DCC_DcpOutput>$(DELPHIBIN)</DCC_DcpOutput>
|
||||||
|
<DCC_CBuilderOutput>All</DCC_CBuilderOutput>
|
||||||
|
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<GenPackage>true</GenPackage>
|
||||||
|
<GenDll>true</GenDll>
|
||||||
|
<DCC_DcuOutput>$(DELPHILIB)</DCC_DcuOutput>
|
||||||
|
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_Optimize>false</DCC_Optimize>
|
||||||
|
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||||
|
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||||
|
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="rtl.dcp"/>
|
||||||
|
<DCCReference Include="dbrtl.dcp"/>
|
||||||
|
<DCCReference Include="..\Source\Dainty.pas"/>
|
||||||
|
<DCCReference Include="..\Source\Dainty.ValueSetter.Default.pas"/>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">DaintyDXE2.dpk</Source>
|
||||||
|
</Source>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Deployment/>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
|
@ -0,0 +1,118 @@
|
||||||
|
{
|
||||||
|
Dainty
|
||||||
|
Simple object mapper for Delphi
|
||||||
|
|
||||||
|
Copyright (c) 2020 M. van Renswoude
|
||||||
|
https://github.com/MvRens/Dainty
|
||||||
|
|
||||||
|
|
||||||
|
This is free and unencumbered software released into the public domain.
|
||||||
|
|
||||||
|
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||||
|
distribute this software, either in source code form or as a compiled
|
||||||
|
binary, for any purpose, commercial or non-commercial, and by any
|
||||||
|
means.
|
||||||
|
|
||||||
|
In jurisdictions that recognize copyright laws, the author or authors
|
||||||
|
of this software dedicate any and all copyright interest in the
|
||||||
|
software to the public domain. We make this dedication for the benefit
|
||||||
|
of the public at large and to the detriment of our heirs and
|
||||||
|
successors. We intend this dedication to be an overt act of
|
||||||
|
relinquishment in perpetuity of all present and future rights to this
|
||||||
|
software under copyright law.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||||
|
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||||
|
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||||
|
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||||
|
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||||
|
OTHER DEALINGS IN THE SOFTWARE.
|
||||||
|
|
||||||
|
For more information, please refer to <http://unlicense.org/>
|
||||||
|
}
|
||||||
|
unit Dainty.ValueSetter.Default;
|
||||||
|
|
||||||
|
interface
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
Data.DB,
|
||||||
|
System.Rtti,
|
||||||
|
System.TypInfo,
|
||||||
|
|
||||||
|
Dainty;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TDaintyDefaultValueSetterFactory = class(TDaintyAbstractValueSetterFactory)
|
||||||
|
public
|
||||||
|
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyDefaultValueSetterFactory }
|
||||||
|
class function TDaintyDefaultValueSetterFactory.Construct(AMember: TDaintyRttiMember): TDaintyValueSetter;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
|
||||||
|
case AMember.RttiType.TypeKind of
|
||||||
|
tkString,
|
||||||
|
tkLString,
|
||||||
|
tkWString,
|
||||||
|
tkUString,
|
||||||
|
tkChar,
|
||||||
|
tkWChar:
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
tkInteger:
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsInteger);
|
||||||
|
end;
|
||||||
|
|
||||||
|
tkEnumeration:
|
||||||
|
if AMember.RttiType.Handle = TypeInfo(Boolean) then
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsBoolean);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsInteger);
|
||||||
|
end;
|
||||||
|
|
||||||
|
tkInt64:
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsLargeInt);
|
||||||
|
end;
|
||||||
|
|
||||||
|
tkFloat:
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, AField.AsFloat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
tkVariant:
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
begin
|
||||||
|
AMember.SetValue(AInstance, TValue.FromVariant(AField.Value));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TDaintyDefaultValueSetterFactory);
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,845 @@
|
||||||
|
{
|
||||||
|
Dainty
|
||||||
|
Simple object mapper for Delphi
|
||||||
|
|
||||||
|
Copyright (c) 2020 M. van Renswoude
|
||||||
|
https://github.com/MvRens/Dainty
|
||||||
|
|
||||||
|
|
||||||
|
This is free and unencumbered software released into the public domain.
|
||||||
|
|
||||||
|
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||||
|
distribute this software, either in source code form or as a compiled
|
||||||
|
binary, for any purpose, commercial or non-commercial, and by any
|
||||||
|
means.
|
||||||
|
|
||||||
|
In jurisdictions that recognize copyright laws, the author or authors
|
||||||
|
of this software dedicate any and all copyright interest in the
|
||||||
|
software to the public domain. We make this dedication for the benefit
|
||||||
|
of the public at large and to the detriment of our heirs and
|
||||||
|
successors. We intend this dedication to be an overt act of
|
||||||
|
relinquishment in perpetuity of all present and future rights to this
|
||||||
|
software under copyright law.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||||
|
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||||
|
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||||
|
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||||
|
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||||
|
OTHER DEALINGS IN THE SOFTWARE.
|
||||||
|
|
||||||
|
For more information, please refer to <http://unlicense.org/>
|
||||||
|
}
|
||||||
|
unit Dainty;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Data.DB,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.Rtti,
|
||||||
|
System.SysUtils,
|
||||||
|
|
||||||
|
Dainty.ValueSetter.Default;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TDaintyMapper<T: class> = class;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Annotates a field or property to change it's field name in the DataSet
|
||||||
|
/// as used for the Dainty methods.
|
||||||
|
/// </summary>
|
||||||
|
FieldName = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FFieldName: string;
|
||||||
|
public
|
||||||
|
constructor Create(const AFieldName: string);
|
||||||
|
|
||||||
|
property FieldName: string read FFieldName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Allows for direct calls to TDainty methods from any DataSet instance, for example
|
||||||
|
/// DataSet.Rows<> or DataSet.GetFirstOrDefault<>.
|
||||||
|
/// </summary>
|
||||||
|
/// <remarks>
|
||||||
|
/// Because class helpers are not exactly extension methods and only one can apply,
|
||||||
|
/// if you're having conflicts you can call TDainty.Rows<>(DataSet) instead.
|
||||||
|
/// </remarks>
|
||||||
|
TDaintyDataSetHelper = class helper for TDataSet
|
||||||
|
public
|
||||||
|
/// <summary>
|
||||||
|
/// Returns a typed enumerable which iterates the DataSet and returns the mapped
|
||||||
|
/// object for each row.
|
||||||
|
/// </summary>
|
||||||
|
/// <remarks>
|
||||||
|
/// Note that the DataSet is not reset to First and will instead start at the current record.
|
||||||
|
/// </remarks>
|
||||||
|
function Rows<T: class>: TEnumerable<T>;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Provides access to the mapper which allows control over the DataSet loop.
|
||||||
|
/// </summary>
|
||||||
|
function GetMapper<T: class>: TDaintyMapper<T>;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||||
|
/// row is active.
|
||||||
|
/// </summary>
|
||||||
|
function GetFirst<T: class>: T;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Returns the value of
|
||||||
|
/// ADefault if no row is active.
|
||||||
|
/// </summary>
|
||||||
|
function GetFirstOrDefault<T: class>(const ADefault: T): T;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||||
|
/// row is active or if more than one row is remaining.
|
||||||
|
/// </summary>
|
||||||
|
function GetSingle<T: class>: T;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Returns the value of
|
||||||
|
/// ADefault if no row is active or if more than one row is remaining.
|
||||||
|
/// </summary>
|
||||||
|
function GetSingleOrDefault<T: class>(const ADefault: T): T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Provides row to object mapping functionality. Usually accessed using the TDaintyDataSetHelper.
|
||||||
|
/// </summary>
|
||||||
|
TDainty = class
|
||||||
|
public
|
||||||
|
/// <summary>
|
||||||
|
/// Returns a typed enumerable which iterates the DataSet and returns the mapped
|
||||||
|
/// object for each row.
|
||||||
|
/// </summary>
|
||||||
|
/// <remarks>
|
||||||
|
/// Note that the DataSet is not reset to First and will instead start at the current record.
|
||||||
|
/// </remarks>
|
||||||
|
class function Rows<T: class>(ADataSet: TDataSet): TEnumerable<T>;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Provides access to the mapper which allows control over the DataSet loop.
|
||||||
|
/// </summary>
|
||||||
|
class function GetMapper<T: class>(ADataSet: TDataSet): TDaintyMapper<T>;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||||
|
/// row is active.
|
||||||
|
/// </summary>
|
||||||
|
class function GetFirst<T: class>(ADataSet: TDataSet): T;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Returns the value of
|
||||||
|
/// ADefault if no row is active.
|
||||||
|
/// </summary>
|
||||||
|
class function GetFirstOrDefault<T: class>(ADataSet: TDataSet; const ADefault: T): T;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Throws an exception if no
|
||||||
|
/// row is active or if more than one row is remaining.
|
||||||
|
/// </summary>
|
||||||
|
class function GetSingle<T: class>(ADataSet: TDataSet): T;
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Returns the current row mapped to the specified class. Returns the value of
|
||||||
|
/// ADefault if no row is active or if more than one row is remaining.
|
||||||
|
/// </summary>
|
||||||
|
class function GetSingleOrDefault<T: class>(ADataSet: TDataSet; const ADefault: T): T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Performs the mapping of the current row to the specified type.
|
||||||
|
/// </summary>
|
||||||
|
TDaintyMapper<T: class> = class
|
||||||
|
public
|
||||||
|
function MapRow: T; virtual; abstract;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Enumerates over the rows of a DataSet and returns the mapped objects.
|
||||||
|
/// Returned by the Rows<> method.
|
||||||
|
/// </summary>
|
||||||
|
TDaintyEnumerable<T: class> = class(TEnumerable<T>)
|
||||||
|
private
|
||||||
|
FMapper: TDaintyMapper<T>;
|
||||||
|
FDataSet: TDataSet;
|
||||||
|
protected
|
||||||
|
function DoGetEnumerator: TEnumerator<T>; override;
|
||||||
|
public
|
||||||
|
constructor Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
/// <summary>
|
||||||
|
/// Internal enumerator returned by TDaintyEnumerable.
|
||||||
|
/// </summary>
|
||||||
|
/// <remarks>
|
||||||
|
/// For internal use only. It's only in the interface section to prevent "Method of parameterized type declared in interface section must not use local symbol" error.
|
||||||
|
/// </remarks>
|
||||||
|
TDaintyEnumerator<T: class> = class(TEnumerator<T>)
|
||||||
|
private
|
||||||
|
FMapper: TDaintyMapper<T>;
|
||||||
|
FDataSet: TDataSet;
|
||||||
|
FCurrent: T;
|
||||||
|
protected
|
||||||
|
function DoGetCurrent: T; override;
|
||||||
|
function DoMoveNext: Boolean; override;
|
||||||
|
public
|
||||||
|
constructor Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyValueSetter = reference to procedure(AInstance: TObject; AField: TField);
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiFieldNameMapping = record
|
||||||
|
FieldName: string;
|
||||||
|
ValueSetter: TDaintyValueSetter;
|
||||||
|
|
||||||
|
constructor Create(const AFieldName: string; const AValueSetter: TDaintyValueSetter);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDaintyRttiClassMapping = class
|
||||||
|
private
|
||||||
|
FConstruct: TFunc<TObject>;
|
||||||
|
FFieldNameMapping: TList<TDaintyRttiFieldNameMapping>;
|
||||||
|
public
|
||||||
|
constructor Create(AConstruct: TFunc<TObject>);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
property Construct: TFunc<TObject> read FConstruct;
|
||||||
|
property FieldNameMapping: TList<TDaintyRttiFieldNameMapping> read FFieldNameMapping;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDaintyRttiFieldMapping = record
|
||||||
|
Field: TField;
|
||||||
|
ValueSetter: TDaintyValueSetter;
|
||||||
|
|
||||||
|
constructor Create(const AField: TField; const AValueSetter: TDaintyValueSetter);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiMapper<T: class> = class(TDaintyMapper<T>)
|
||||||
|
private
|
||||||
|
FConstruct: TFunc<TObject>;
|
||||||
|
FFieldMapping: TList<TDaintyRttiFieldMapping>;
|
||||||
|
public
|
||||||
|
constructor Create(AClassMapping: TDaintyRttiClassMapping; ADataSet: TDataSet);
|
||||||
|
|
||||||
|
function MapRow: T; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiMember = class
|
||||||
|
private
|
||||||
|
FRttiMember: TRttiMember;
|
||||||
|
protected
|
||||||
|
function GetRttiType: TRttiType; virtual; abstract;
|
||||||
|
public
|
||||||
|
constructor Create(ARttiMember: TRttiMember);
|
||||||
|
|
||||||
|
procedure SetValue(AInstance: TObject; const AValue: TValue); virtual; abstract;
|
||||||
|
|
||||||
|
property RttiMember: TRttiMember read FRttiMember;
|
||||||
|
property RttiType: TRttiType read GetRttiType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiFieldMember = class(TDaintyRttiMember)
|
||||||
|
private
|
||||||
|
FField: TRttiField;
|
||||||
|
protected
|
||||||
|
function GetRttiType: TRttiType; override;
|
||||||
|
public
|
||||||
|
constructor Create(AField: TRttiField);
|
||||||
|
|
||||||
|
procedure SetValue(AInstance: TObject; const AValue: TValue); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDaintyRttiPropertyMember = class(TDaintyRttiMember)
|
||||||
|
private
|
||||||
|
FProperty: TRttiProperty;
|
||||||
|
protected
|
||||||
|
function GetRttiType: TRttiType; override;
|
||||||
|
public
|
||||||
|
constructor Create(AProperty: TRttiProperty);
|
||||||
|
|
||||||
|
procedure SetValue(AInstance: TObject; const AValue: TValue); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyAbstractValueSetterFactoryClass = class of TDaintyAbstractValueSetterFactory;
|
||||||
|
|
||||||
|
TDaintyAbstractValueSetterFactory = class
|
||||||
|
public
|
||||||
|
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; virtual; abstract;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiMapperFactory = class
|
||||||
|
private type
|
||||||
|
TValueSetterRegistration = record
|
||||||
|
Factory: TDaintyAbstractValueSetterFactoryClass;
|
||||||
|
Priority: Integer;
|
||||||
|
|
||||||
|
constructor Create(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||||
|
end;
|
||||||
|
private class var
|
||||||
|
SContext: TRttiContext;
|
||||||
|
SClassMappingCacheLock: TMultiReadExclusiveWriteSynchronizer;
|
||||||
|
SClassMappingCache: TDictionary<Pointer, TDaintyRttiClassMapping>;
|
||||||
|
SValueSettersLock: TMultiReadExclusiveWriteSynchronizer;
|
||||||
|
SValueSetters: TList<TValueSetterRegistration>;
|
||||||
|
SMembers: TObjectList<TDaintyRttiMember>;
|
||||||
|
private
|
||||||
|
class function GetClassMapping<T: class>: TDaintyRttiClassMapping;
|
||||||
|
class function GetFieldName(AMember: TRttiNamedObject): string;
|
||||||
|
class function GetValueSetter(AMember: TRttiMember): TDaintyValueSetter;
|
||||||
|
protected
|
||||||
|
class procedure Initialize;
|
||||||
|
class procedure Finalize;
|
||||||
|
public
|
||||||
|
class function Construct<T: class>(ADataSet: TDataSet): TDaintyRttiMapper<T>;
|
||||||
|
|
||||||
|
class procedure RegisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer = 0);
|
||||||
|
class procedure UnregisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.TypInfo;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyDataSetHelper }
|
||||||
|
function TDaintyDataSetHelper.Rows<T>: TEnumerable<T>;
|
||||||
|
begin
|
||||||
|
Result := TDainty.Rows<T>(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyDataSetHelper.GetMapper<T>: TDaintyMapper<T>;
|
||||||
|
begin
|
||||||
|
Result := TDainty.GetMapper<T>(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyDataSetHelper.GetFirst<T>: T;
|
||||||
|
begin
|
||||||
|
Result := TDainty.GetFirst<T>(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyDataSetHelper.GetFirstOrDefault<T>(const ADefault: T): T;
|
||||||
|
begin
|
||||||
|
Result := TDainty.GetFirstOrDefault<T>(Self, ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyDataSetHelper.GetSingle<T>: T;
|
||||||
|
begin
|
||||||
|
Result := TDainty.GetSingle<T>(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyDataSetHelper.GetSingleOrDefault<T>(const ADefault: T): T;
|
||||||
|
begin
|
||||||
|
Result := TDainty.GetSingleOrDefault<T>(Self, ADefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDainty }
|
||||||
|
class function TDainty.Rows<T>(ADataSet: TDataSet): TEnumerable<T>;
|
||||||
|
var
|
||||||
|
mapper: TDaintyMapper<T>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
mapper := GetMapper<T>(ADataSet);
|
||||||
|
Result := TDaintyEnumerable<T>.Create(mapper, ADataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDainty.GetMapper<T>(ADataSet: TDataSet): TDaintyMapper<T>;
|
||||||
|
begin
|
||||||
|
Result := TDaintyRttiMapperFactory.Construct<T>(ADataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDainty.GetFirst<T>(ADataSet: TDataSet): T;
|
||||||
|
var
|
||||||
|
enumerator: TEnumerator<T>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||||
|
try
|
||||||
|
if not enumerator.MoveNext then
|
||||||
|
raise EDatabaseError.Create('Expected at least 1 record but none found');
|
||||||
|
|
||||||
|
Result := enumerator.Current;
|
||||||
|
finally
|
||||||
|
FreeAndNil(enumerator);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDainty.GetFirstOrDefault<T>(ADataSet: TDataSet; const ADefault: T): T;
|
||||||
|
var
|
||||||
|
enumerator: TEnumerator<T>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||||
|
try
|
||||||
|
if enumerator.MoveNext then
|
||||||
|
Result := enumerator.Current
|
||||||
|
else
|
||||||
|
Result := ADefault;
|
||||||
|
finally
|
||||||
|
FreeAndNil(enumerator);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDainty.GetSingle<T>(ADataSet: TDataSet): T;
|
||||||
|
var
|
||||||
|
enumerator: TEnumerator<T>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||||
|
try
|
||||||
|
if not enumerator.MoveNext then
|
||||||
|
raise EDatabaseError.Create('Expected 1 record but none found');
|
||||||
|
|
||||||
|
Result := enumerator.Current;
|
||||||
|
|
||||||
|
if enumerator.MoveNext then
|
||||||
|
raise EDatabaseError.Create('Expected 1 record but more found');
|
||||||
|
finally
|
||||||
|
FreeAndNil(enumerator);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDainty.GetSingleOrDefault<T>(ADataSet: TDataSet; const ADefault: T): T;
|
||||||
|
var
|
||||||
|
enumerator: TEnumerator<T>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
enumerator := Rows<T>(ADataSet).GetEnumerator;
|
||||||
|
try
|
||||||
|
if not enumerator.MoveNext then
|
||||||
|
Exit(ADefault);
|
||||||
|
|
||||||
|
Result := enumerator.Current;
|
||||||
|
|
||||||
|
if enumerator.MoveNext then
|
||||||
|
Exit(ADefault);
|
||||||
|
finally
|
||||||
|
FreeAndNil(enumerator);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyEnumerable<T> }
|
||||||
|
constructor TDaintyEnumerable<T>.Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FMapper := AMapper;
|
||||||
|
FDataSet := ADataSet;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyEnumerable<T>.DoGetEnumerator: TEnumerator<T>;
|
||||||
|
begin
|
||||||
|
Result := TDaintyEnumerator<T>.Create(FMapper, FDataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyEnumerator<T> }
|
||||||
|
constructor TDaintyEnumerator<T>.Create(AMapper: TDaintyMapper<T>; ADataSet: TDataSet);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FMapper := AMapper;
|
||||||
|
FDataSet := ADataSet;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyEnumerator<T>.DoGetCurrent: T;
|
||||||
|
begin
|
||||||
|
Result := FCurrent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyEnumerator<T>.DoMoveNext: Boolean;
|
||||||
|
begin
|
||||||
|
if FDataSet.Eof then
|
||||||
|
Exit(False);
|
||||||
|
|
||||||
|
FCurrent := FMapper.MapRow;
|
||||||
|
Result := True;
|
||||||
|
|
||||||
|
FDataSet.Next;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiMapper<T> }
|
||||||
|
constructor TDaintyRttiMapper<T>.Create(AClassMapping: TDaintyRttiClassMapping; ADataSet: TDataSet);
|
||||||
|
var
|
||||||
|
fieldNameMapping: TDaintyRttiFieldNameMapping;
|
||||||
|
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FConstruct := AClassMapping.Construct;
|
||||||
|
FFieldMapping := TList<TDaintyRttiFieldMapping>.Create;
|
||||||
|
|
||||||
|
for fieldNameMapping in AClassMapping.FieldNameMapping do
|
||||||
|
FFieldMapping.Add(TDaintyRttiFieldMapping.Create(ADataSet.FieldByName(fieldNameMapping.FieldName), fieldNameMapping.ValueSetter));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiMember }
|
||||||
|
constructor TDaintyRttiMember.Create(ARttiMember: TRttiMember);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FRttiMember := ARttiMember;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiFieldMember }
|
||||||
|
constructor TDaintyRttiFieldMember.Create(AField: TRttiField);
|
||||||
|
begin
|
||||||
|
inherited Create(AField);
|
||||||
|
|
||||||
|
FField := AField;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyRttiFieldMember.GetRttiType: TRttiType;
|
||||||
|
begin
|
||||||
|
Result := FField.FieldType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyRttiFieldMember.SetValue(AInstance: TObject; const AValue: TValue);
|
||||||
|
begin
|
||||||
|
FField.SetValue(AInstance, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiPropertyMember }
|
||||||
|
constructor TDaintyRttiPropertyMember.Create(AProperty: TRttiProperty);
|
||||||
|
begin
|
||||||
|
inherited Create(AProperty);
|
||||||
|
|
||||||
|
FProperty := AProperty;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TDaintyRttiPropertyMember.GetRttiType: TRttiType;
|
||||||
|
begin
|
||||||
|
Result := FProperty.PropertyType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyRttiPropertyMember.SetValue(AInstance: TObject; const AValue: TValue);
|
||||||
|
begin
|
||||||
|
FProperty.SetValue(AInstance, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiMapperFactory }
|
||||||
|
class procedure TDaintyRttiMapperFactory.Initialize;
|
||||||
|
begin
|
||||||
|
if Assigned(SClassMappingCache) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
SContext := TRttiContext.Create;
|
||||||
|
SClassMappingCacheLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
||||||
|
SClassMappingCache := TObjectDictionary<Pointer, TDaintyRttiClassMapping>.Create([doOwnsValues]);
|
||||||
|
SValueSettersLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
||||||
|
SValueSetters := TList<TValueSetterRegistration>.Create;
|
||||||
|
SMembers := TObjectList<TDaintyRttiMember>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class procedure TDaintyRttiMapperFactory.RegisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||||
|
var
|
||||||
|
registration: TValueSetterRegistration;
|
||||||
|
registrationIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ Initialization for Dainty.ValueSetter.Default runs before ours, make sure we are initialized }
|
||||||
|
Initialize;
|
||||||
|
|
||||||
|
SValueSettersLock.BeginWrite;
|
||||||
|
try
|
||||||
|
registration := TValueSetterRegistration.Create(AFactory, APriority);
|
||||||
|
|
||||||
|
for registrationIndex := 0 to Pred(SValueSetters.Count) do
|
||||||
|
if SValueSetters[registrationIndex].Priority <= APriority then
|
||||||
|
begin
|
||||||
|
SValueSetters.Insert(registrationIndex, registration);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
SValueSetters.Add(registration);
|
||||||
|
finally
|
||||||
|
SValueSettersLock.EndWrite;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class procedure TDaintyRttiMapperFactory.UnregisterValueSetterFactory(AFactory: TDaintyAbstractValueSetterFactoryClass);
|
||||||
|
var
|
||||||
|
registrationIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
SValueSettersLock.BeginWrite;
|
||||||
|
try
|
||||||
|
for registrationIndex := Pred(SValueSetters.Count) downto 0 do
|
||||||
|
if SValueSetters[registrationIndex].Factory = AFactory then
|
||||||
|
SValueSetters.Delete(registrationIndex);
|
||||||
|
finally
|
||||||
|
SValueSettersLock.EndWrite;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class procedure TDaintyRttiMapperFactory.Finalize;
|
||||||
|
begin
|
||||||
|
FreeAndNil(SValueSetters);
|
||||||
|
FreeAndNil(SValueSettersLock);
|
||||||
|
FreeAndNil(SClassMappingCache);
|
||||||
|
FreeAndNil(SClassMappingCacheLock);
|
||||||
|
SContext.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDaintyRttiMapperFactory.Construct<T>(ADataSet: TDataSet): TDaintyRttiMapper<T>;
|
||||||
|
var
|
||||||
|
mapping: TDaintyRttiClassMapping;
|
||||||
|
|
||||||
|
begin
|
||||||
|
mapping := GetClassMapping<T>;
|
||||||
|
Result := TDaintyRttiMapper<T>.Create(mapping, ADataSet);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDaintyRttiMapperFactory.GetClassMapping<T>: TDaintyRttiClassMapping;
|
||||||
|
var
|
||||||
|
typeInfoHandle: Pointer;
|
||||||
|
classInfo: TRttiType;
|
||||||
|
method: TRttiMethod;
|
||||||
|
instanceClassType: TClass;
|
||||||
|
fieldInfo: TRttiField;
|
||||||
|
propertyInfo: TRttiProperty;
|
||||||
|
valueSetter: TProc<TObject, TField>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
SClassMappingCacheLock.BeginRead;
|
||||||
|
try
|
||||||
|
typeInfoHandle := TypeInfo(T);
|
||||||
|
if SClassMappingCache.TryGetValue(typeInfoHandle, Result) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
SClassMappingCacheLock.BeginWrite;
|
||||||
|
try
|
||||||
|
{ Between the call to BeginWrite and actually acquiring the lock the state
|
||||||
|
may have changed. Check again to be sure. }
|
||||||
|
if SClassMappingCache.TryGetValue(typeInfoHandle, Result) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
classInfo := SContext.GetType(typeInfoHandle);
|
||||||
|
Result := nil;
|
||||||
|
|
||||||
|
for method in classInfo.GetMethods do
|
||||||
|
begin
|
||||||
|
if method.IsConstructor and (Length(method.GetParameters) = 0) then
|
||||||
|
begin
|
||||||
|
instanceClassType := classInfo.AsInstance.MetaclassType;
|
||||||
|
Result := TDaintyRttiClassMapping.Create(
|
||||||
|
function: TObject
|
||||||
|
begin
|
||||||
|
Result := method.Invoke(instanceClassType, []).AsObject;
|
||||||
|
end);
|
||||||
|
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not Assigned(Result) then
|
||||||
|
raise ENoConstructException.Create('A constructor with no parameter is required for Dainty');
|
||||||
|
|
||||||
|
|
||||||
|
for fieldInfo in classInfo.GetFields do
|
||||||
|
begin
|
||||||
|
if not (fieldInfo.Visibility in [mvPublic, mvPublished]) then
|
||||||
|
Continue;
|
||||||
|
|
||||||
|
Result.FieldNameMapping.Add(TDaintyRttiFieldNameMapping.Create(GetFieldName(fieldInfo), GetValueSetter(fieldInfo)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
for propertyInfo in classInfo.GetProperties do
|
||||||
|
begin
|
||||||
|
if not (propertyInfo.Visibility in [mvPublic, mvPublished]) then
|
||||||
|
Continue;
|
||||||
|
|
||||||
|
if not propertyInfo.IsWritable then
|
||||||
|
Continue;
|
||||||
|
|
||||||
|
Result.FieldNameMapping.Add(TDaintyRttiFieldNameMapping.Create(GetFieldName(propertyInfo), GetValueSetter(propertyInfo)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
SClassMappingCache.Add(typeInfoHandle, Result);
|
||||||
|
finally
|
||||||
|
SClassMappingCacheLock.EndWrite;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SClassMappingCacheLock.EndRead;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDaintyRttiMapperFactory.GetFieldName(AMember: TRttiNamedObject): string;
|
||||||
|
var
|
||||||
|
attribute: TCustomAttribute;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for attribute in AMember.GetAttributes do
|
||||||
|
begin
|
||||||
|
if attribute is FieldName then
|
||||||
|
Exit(FieldName(attribute).FieldName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := AMember.Name;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
class function TDaintyRttiMapperFactory.GetValueSetter(AMember: TRttiMember): TDaintyValueSetter;
|
||||||
|
var
|
||||||
|
member: TDaintyRttiMember;
|
||||||
|
registration: TValueSetterRegistration;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if AMember is TRttiField then
|
||||||
|
member := TDaintyRttiFieldMember.Create(TRttiField(AMember))
|
||||||
|
else if AMember is TRttiProperty then
|
||||||
|
member := TDaintyRttiPropertyMember.Create(TRttiProperty(AMember))
|
||||||
|
else
|
||||||
|
raise EInvalidOpException.CreateFmt('Member type not supported: %s', [AMember.ClassName]);
|
||||||
|
|
||||||
|
SValueSettersLock.BeginRead;
|
||||||
|
try
|
||||||
|
for registration in SValueSetters do
|
||||||
|
begin
|
||||||
|
Result := registration.Factory.Construct(member);
|
||||||
|
if Assigned(Result) then
|
||||||
|
begin
|
||||||
|
SMembers.Add(member);
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SValueSettersLock.EndRead;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not Assigned(Result) then
|
||||||
|
begin
|
||||||
|
FreeAndNil(member);
|
||||||
|
raise ENotSupportedException.CreateFmt('Member %s has unsupported type for Dainty: %d', [AMember.Name, Ord(member.RttiType.TypeKind)]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiMapperFactory.TValueSetterRegistration }
|
||||||
|
constructor TDaintyRttiMapperFactory.TValueSetterRegistration.Create(AFactory: TDaintyAbstractValueSetterFactoryClass; APriority: Integer);
|
||||||
|
begin
|
||||||
|
Factory := AFactory;
|
||||||
|
Priority := APriority;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiMapper<T> }
|
||||||
|
function TDaintyRttiMapper<T>.MapRow: T;
|
||||||
|
var
|
||||||
|
fieldMapping: TDaintyRttiFieldMapping;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := FConstruct() as T;
|
||||||
|
|
||||||
|
for fieldMapping in FFieldMapping do
|
||||||
|
fieldMapping.ValueSetter(Result, fieldMapping.Field);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiFieldNameMapping }
|
||||||
|
constructor TDaintyRttiFieldNameMapping.Create(const AFieldName: string; const AValueSetter: TDaintyValueSetter);
|
||||||
|
begin
|
||||||
|
FieldName := AFieldName;
|
||||||
|
ValueSetter := AValueSetter;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiFieldMapping }
|
||||||
|
constructor TDaintyRttiFieldMapping.Create(const AField: TField; const AValueSetter: TDaintyValueSetter);
|
||||||
|
begin
|
||||||
|
Field := AField;
|
||||||
|
ValueSetter := AValueSetter;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyRttiClassMapping }
|
||||||
|
constructor TDaintyRttiClassMapping.Create(AConstruct: TFunc<TObject>);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FConstruct := AConstruct;
|
||||||
|
FFieldNameMapping := TList<TDaintyRttiFieldNameMapping>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TDaintyRttiClassMapping.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FFieldNameMapping);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ FieldName }
|
||||||
|
constructor FieldName.Create(const AFieldName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FFieldName := AFieldName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
TDaintyRttiMapperFactory.Initialize;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
TDaintyRttiMapperFactory.Finalize;
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,316 @@
|
||||||
|
unit DaintyTests;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Data.DB,
|
||||||
|
Datasnap.DBClient,
|
||||||
|
MidasLib,
|
||||||
|
TestFramework,
|
||||||
|
|
||||||
|
Dainty;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TDaintyTest = class(TTestCase)
|
||||||
|
private
|
||||||
|
FDataSet: TClientDataSet;
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
|
||||||
|
procedure FillTestData(ARowCount: Integer);
|
||||||
|
|
||||||
|
property DataSet: TClientDataSet read FDataSet;
|
||||||
|
published
|
||||||
|
procedure SimpleTypes;
|
||||||
|
|
||||||
|
procedure GetFirst;
|
||||||
|
procedure GetFirstMultipleRows;
|
||||||
|
procedure GetFirstNoData;
|
||||||
|
procedure GetFirstOrDefault;
|
||||||
|
|
||||||
|
procedure GetSingle;
|
||||||
|
procedure GetSingleMultipleRows;
|
||||||
|
procedure GetSingleNoData;
|
||||||
|
procedure GetSingleOrDefaultMultipleRows;
|
||||||
|
procedure GetSingleOrDefaultNoData;
|
||||||
|
|
||||||
|
procedure FieldNameAttribute;
|
||||||
|
procedure FieldNameAttributeProperty;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyTest }
|
||||||
|
procedure TDaintyTest.SetUp;
|
||||||
|
begin
|
||||||
|
inherited SetUp;
|
||||||
|
|
||||||
|
FDataSet := TClientDataSet.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.TearDown;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FDataSet);
|
||||||
|
|
||||||
|
inherited TearDown;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TSimpleTypesRecord = class
|
||||||
|
StringField: string;
|
||||||
|
IntegerField: Integer;
|
||||||
|
DateTimeField: TDateTime;
|
||||||
|
BooleanField: Boolean;
|
||||||
|
FloatField: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.SimpleTypes;
|
||||||
|
|
||||||
|
procedure AddRow(const AStringValue: string; AIntegerValue: Integer; ADateTimeValue: TDateTime; ABooleanValue: Boolean; AFloatValue: Double);
|
||||||
|
begin
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('STRINGFIELD').AsString := AStringValue;
|
||||||
|
DataSet.FieldByName('INTEGERFIELD').AsInteger := AIntegerValue;
|
||||||
|
DataSet.FieldByName('DATETIMEFIELD').AsDateTime := ADateTimeValue;
|
||||||
|
DataSet.FieldByName('BOOLEANFIELD').AsBoolean := ABooleanValue;
|
||||||
|
DataSet.FieldByName('FLOATFIELD').AsFloat := AFloatValue;
|
||||||
|
DataSet.Post;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
row: TSimpleTypesRecord;
|
||||||
|
rowIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||||
|
DataSet.FieldDefs.Add('INTEGERFIELD', ftInteger);
|
||||||
|
DataSet.FieldDefs.Add('DATETIMEFIELD', ftDate);
|
||||||
|
DataSet.FieldDefs.Add('BOOLEANFIELD', ftBoolean);
|
||||||
|
DataSet.FieldDefs.Add('FLOATFIELD', ftFloat);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
AddRow('Hello', 42, EncodeDate(2020, 9, 7), True, 3.1415);
|
||||||
|
AddRow('world!', 69, EncodeDate(2006, 1, 1), False, 1.618);
|
||||||
|
|
||||||
|
|
||||||
|
DataSet.First;
|
||||||
|
rowIndex := 0;
|
||||||
|
|
||||||
|
for row in DataSet.Rows<TSimpleTypesRecord> do
|
||||||
|
begin
|
||||||
|
case rowIndex of
|
||||||
|
0:
|
||||||
|
begin
|
||||||
|
CheckEquals('Hello', row.StringField, 'StringField');
|
||||||
|
CheckEquals(42, row.IntegerField, 'IntegerField');
|
||||||
|
CheckEquals(EncodeDate(2020, 9, 7), row.DateTimeField, 0.9, 'DateTimeField');
|
||||||
|
CheckEquals(True, row.BooleanField, 'BooleanField');
|
||||||
|
CheckEquals(3.1415, row.FloatField, 0.0001, 'FloatField');
|
||||||
|
end;
|
||||||
|
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
CheckEquals('world!', row.StringField);
|
||||||
|
CheckEquals(69, row.IntegerField, 'IntegerField');
|
||||||
|
CheckEquals(EncodeDate(2006, 1, 1), row.DateTimeField, 0.9, 'DateTimeField');
|
||||||
|
CheckEquals(False, row.BooleanField, 'BooleanField');
|
||||||
|
CheckEquals(1.618, row.FloatField, 0.0001, 'FloatField');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Inc(rowIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TTestRow = class
|
||||||
|
RowNumber: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.FillTestData(ARowCount: Integer);
|
||||||
|
var
|
||||||
|
rowNumber: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('ROWNUMBER', ftInteger);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
for rowNumber := 1 to ARowCount do
|
||||||
|
begin
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('ROWNUMBER').AsInteger := rowNumber;
|
||||||
|
DataSet.Post;
|
||||||
|
end;
|
||||||
|
|
||||||
|
DataSet.First;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetFirst;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(1);
|
||||||
|
row := DataSet.GetFirst<TTestRow>;
|
||||||
|
|
||||||
|
CheckEquals(1, row.RowNumber);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetFirstMultipleRows;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(2);
|
||||||
|
row := DataSet.GetFirst<TTestRow>;
|
||||||
|
|
||||||
|
CheckEquals(1, row.RowNumber);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetFirstNoData;
|
||||||
|
begin
|
||||||
|
FillTestData(0);
|
||||||
|
ExpectedException := EDatabaseError;
|
||||||
|
DataSet.GetFirst<TTestRow>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetFirstOrDefault;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(0);
|
||||||
|
row := DataSet.GetFirstOrDefault<TTestRow>(nil);
|
||||||
|
CheckNull(row);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetSingle;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(1);
|
||||||
|
row := DataSet.GetSingle<TTestRow>;
|
||||||
|
CheckEquals(1, row.RowNumber);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetSingleMultipleRows;
|
||||||
|
begin
|
||||||
|
ExpectedException := EDatabaseError;
|
||||||
|
FillTestData(2);
|
||||||
|
DataSet.GetSingle<TTestRow>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetSingleNoData;
|
||||||
|
begin
|
||||||
|
ExpectedException := EDatabaseError;
|
||||||
|
FillTestData(0);
|
||||||
|
DataSet.GetSingle<TTestRow>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetSingleOrDefaultMultipleRows;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(2);
|
||||||
|
row := DataSet.GetSingleOrDefault<TTestRow>(nil);
|
||||||
|
CheckNull(row);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.GetSingleOrDefaultNoData;
|
||||||
|
var
|
||||||
|
row: TTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FillTestData(0);
|
||||||
|
row := DataSet.GetSingleOrDefault<TTestRow>(nil);
|
||||||
|
CheckNull(row);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TAttributeTestRow = class
|
||||||
|
[FieldName('STRING_FIELD')]
|
||||||
|
StringField: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.FieldNameAttribute;
|
||||||
|
var
|
||||||
|
row: TAttributeTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('STRING_FIELD', ftString, 50);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('STRING_FIELD').AsString := 'Hello world!';
|
||||||
|
DataSet.Post;
|
||||||
|
|
||||||
|
row := DataSet.GetFirst<TAttributeTestRow>;
|
||||||
|
CheckEquals('Hello world!', row.StringField);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TPropertyAttributeTestRow = class
|
||||||
|
private
|
||||||
|
FStringField: string;
|
||||||
|
public
|
||||||
|
[FieldName('STRING_FIELD')]
|
||||||
|
property StringField: string read FStringField write FStringField;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyTest.FieldNameAttributeProperty;
|
||||||
|
var
|
||||||
|
row: TPropertyAttributeTestRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('STRING_FIELD', ftString, 50);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('STRING_FIELD').AsString := 'Hello world!';
|
||||||
|
DataSet.Post;
|
||||||
|
|
||||||
|
row := DataSet.GetFirst<TPropertyAttributeTestRow>;
|
||||||
|
CheckEquals('Hello world!', row.StringField);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterTest(TDaintyTest.Suite);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
|
@ -0,0 +1,14 @@
|
||||||
|
program DaintyUnitTests;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
uses
|
||||||
|
GUITestRunner,
|
||||||
|
Dainty in '..\Source\Dainty.pas',
|
||||||
|
DaintyTests in 'DaintyTests.pas',
|
||||||
|
Dainty.ValueSetter.Default in '..\Source\Dainty.ValueSetter.Default.pas',
|
||||||
|
DaintyValueSetterTests in 'DaintyValueSetterTests.pas';
|
||||||
|
|
||||||
|
begin
|
||||||
|
RunRegisteredTests;
|
||||||
|
end.
|
|
@ -0,0 +1,142 @@
|
||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{79A2C681-52DB-432C-B68F-67E68341B6C3}</ProjectGuid>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<FrameworkType>None</FrameworkType>
|
||||||
|
<MainSource>DaintyUnitTests.dpr</MainSource>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Console</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||||
|
<Base_Win64>true</Base_Win64>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<DCC_UsePackage>DBXInterBaseDriver;DataSnapServer;DataSnapCommon;DbxCommonDriver;dbxcds;CustomIPTransport;dsnap;IndyCore;FmxTeeUI;IPIndyImpl;bindcompfmx;dbrtl;bindcomp;inetdb;xmlrtl;ibxpress;soaprtl;FMXTee;bindengine;DBXInformixDriver;DBXFirebirdDriver;inet;DBXSybaseASADriver;dbexpress;fmx;IndySystem;DataSnapClient;DataSnapProviderClient;DBXOracleDriver;inetdbxpress;rtl;DbxClientDriver;IndyProtocols;DBXMySQLDriver;DataSnapIndy10ServerTransport;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
|
||||||
|
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||||
|
<DCC_UsePackage>dxTileControlRS16;cxLibraryRS16;dxPsPrVwAdvRS16;dxRibbonCustomizationFormRS16;dxPSCoreRS16;dxRichEditInplaceRS16;dxPScxTLLnkRS16;dxPSdxSpreadSheetLnkRS16;cxPageControlRS16;dxPScxGridLnkRS16;vclimg;dxComnRS16;vcldb;dxOfficeCoreRS16;dxBarExtDBItemsRS16;dxSpreadSheetInplaceRichEditRS16;dxSpreadSheetCoreRS16;cxDataRS16;dxDockingRS16;dxPSDBTeeChartRS16;dxSpreadSheetReportDesignerRS16;dxBarExtItemsRS16;dxPSLnksRS16;dxPSdxPDFViewerLnkRS16;dxPSTeeChartRS16;dxPSdxLCLnkRS16;cxVerticalGridRS16;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;dxNavBarRS16;dxSpreadSheetCoreDialogsRS16;dxSpreadSheetCoreConditionalFormattingDialogsRS16;cxSchedulerTreeBrowserRS16;DBXOdbcDriver;dxdbtrRS16;dxRichEditCoreRS16;dxPSdxDBTVLnkRS16;vclactnband;dxPScxSchedulerLnkRS16;dxServerModeRS16;bindcompvcl;vclie;dsnapcon;dxHttpIndyRequestRS16;vclx;dxFlowChartRS16;dxGDIPlusRS16;dxdborRS16;dxPDFViewerRS16;dxEMFRS16;dxLayoutControlRS16;dxSpreadSheetRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;dxPScxVGridLnkRS16;cxExportRS16;dxPSdxMapControlLnkRS16;dxBarRS16;TeeDB;dxDBXServerModeRS16;cxTreeListdxBarPopupMenuRS16;dxPSdxGaugeControlLnkRS16;dxRibbonRS16;DBXSybaseASEDriver;dxSpreadSheetConditionalFormattingDialogsRS16;cxTreeListRS16;vcldsnap;dxGaugeControlRS16;DBXDb2Driver;vcl;DBXMSSQLDriver;cxSchedulerGridRS16;dxRichEditControlCoreRS16;webdsnap;dxtrmdRS16;adortl;dxRichEditControlRS16;dxRichEditDocumentModelRS16;dxPSdxDBOCLnkRS16;Tee;cxPivotGridChartRS16;dxmdsRS16;dxSpellCheckerRS16;dxMapControlRS16;cxGridRS16;dxPScxCommonRS16;dxPSPrVwRibbonRS16;cxEditorsRS16;TeeUI;cxPivotGridRS16;cxSchedulerRibbonStyleEventEditorRS16;cxSchedulerRS16;vcltouch;websnap;dxFlowChartAdvancedCustomizeFormRS16;VclSmp;dxTabbedMDIRS16;dxPSRichEditControlLnkRS16;dxPSdxOCLnkRS16;dxPSdxFCLnkRS16;dxThemeRS16;dxPScxPCProdRS16;dxBarDBNavRS16;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<DCC_UsePackage>dxTileControlRS16;JvGlobus;JvMM;cxLibraryRS16;JvManagedThreads;JvCrypt;rbDIDE1516;dxPsPrVwAdvRS16;dxRibbonCustomizationFormRS16;rbTCUI1516;dxPSCoreRS16;dxRichEditInplaceRS16;dxPScxTLLnkRS16;dxPSdxSpreadSheetLnkRS16;JvNet;cxPageControlRS16;dxPScxGridLnkRS16;JvDotNetCtrls;vclimg;rbDAD1516;dxComnRS16;JvXPCtrls;rbRCL1516;vcldb;dxOfficeCoreRS16;dxBarExtDBItemsRS16;rbIBE1516;dxSpreadSheetInplaceRichEditRS16;dclRBIBE1516;dclRBADO1516;dxSpreadSheetCoreRS16;CloudService;rbRAP1516;cxDataRS16;dxDockingRS16;dxPSDBTeeChartRS16;JvDB;JvRuntimeDesign;dxSpreadSheetReportDesignerRS16;X2CLMB;dxBarExtItemsRS16;dxPSLnksRS16;dxPSdxPDFViewerLnkRS16;JclDeveloperTools;dxPSTeeChartRS16;dxPSdxLCLnkRS16;cxVerticalGridRS16;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;vcldbx;rbDBDE1516;dxNavBarRS16;dclRBE1516;dxSpreadSheetCoreDialogsRS16;rbIDE1516;JvPluginSystem;dxSpreadSheetCoreConditionalFormattingDialogsRS16;cxSchedulerTreeBrowserRS16;DBXOdbcDriver;JvCmp;dxdbtrRS16;madDisAsm_;dxRichEditCoreRS16;JvTimeFramework;dxPSdxDBTVLnkRS16;vclactnband;dxPScxSchedulerLnkRS16;dxServerModeRS16;bindcompvcl;Jcl;vclie;madExcept_;dsnapcon;dxHttpIndyRequestRS16;JvPascalInterpreter;vclx;rbDBE1516;dxFlowChartRS16;dxGDIPlusRS16;JvBDE;dxdborRS16;dxPDFViewerRS16;dxEMFRS16;dxLayoutControlRS16;dxSpreadSheetRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;dxPScxVGridLnkRS16;cxExportRS16;dxPSdxMapControlLnkRS16;dxBarRS16;JvDlgs;cxSchedulerWebServiceStorageRS16;TeeDB;dxDBXServerModeRS16;cxTreeListdxBarPopupMenuRS16;dxPSdxGaugeControlLnkRS16;vclib;inetdbbde;dxRibbonRS16;DBXSybaseASEDriver;dxSpreadSheetConditionalFormattingDialogsRS16;rbTC1516;cxTreeListRS16;vcldsnap;X2CLGL;dxGaugeControlRS16;DBXDb2Driver;dclRBBDE1516;rbDB1516;JvCore;vcl;DBXMSSQLDriver;JvAppFrm;cxSchedulerGridRS16;dxRichEditControlCoreRS16;webdsnap;dxtrmdRS16;rbRIDE1516;JvDocking;adortl;JvWizards;dxRichEditControlRS16;rbADO1516;madBasic_;JvHMI;dxRichEditDocumentModelRS16;JvBands;dxPSdxDBOCLnkRS16;Tee;rbUSERDesign1516;JvSystem;svnui;cxPivotGridChartRS16;JvControls;dxmdsRS16;dxSpellCheckerRS16;dxMapControlRS16;cxGridRS16;dxPScxCommonRS16;dxPSPrVwRibbonRS16;cxEditorsRS16;TeeUI;cxPivotGridRS16;rbUSER1516;JvJans;JvPrintPreview;JvPageComps;dclRBDBE1516;JvStdCtrls;JvCustom;cxSchedulerRibbonStyleEventEditorRS16;rbBDE1516;cxSchedulerRS16;vcltouch;websnap;dxFlowChartAdvancedCustomizeFormRS16;VclSmp;dxTabbedMDIRS16;dxPSRichEditControlLnkRS16;DataSnapConnectors;dxPSdxOCLnkRS16;dxPSdxFCLnkRS16;dxThemeRS16;JclVcl;dxPScxPCProdRS16;rbCIDE1516;svn;bdertl;VirtualTreesR;dxAuthorizationAgentsRS16;dxBarDBNavRS16;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_Optimize>false</DCC_Optimize>
|
||||||
|
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||||
|
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||||
|
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<DCC_DebugDCUs>true</DCC_DebugDCUs>
|
||||||
|
<Manifest_File>None</Manifest_File>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="..\Source\Dainty.pas"/>
|
||||||
|
<DCCReference Include="DaintyTests.pas"/>
|
||||||
|
<DCCReference Include="..\Source\Dainty.ValueSetter.Default.pas"/>
|
||||||
|
<DCCReference Include="DaintyValueSetterTests.pas"/>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">DaintyUnitTests.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Deployment/>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
|
@ -0,0 +1,171 @@
|
||||||
|
unit DaintyValueSetterTests;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Data.DB,
|
||||||
|
DataSnap.DBClient,
|
||||||
|
MidasLib,
|
||||||
|
TestFramework,
|
||||||
|
|
||||||
|
Dainty;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TDaintyValueSetterTest = class(TTestCase)
|
||||||
|
private
|
||||||
|
FDataSet: TClientDataSet;
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
|
||||||
|
property DataSet: TClientDataSet read FDataSet;
|
||||||
|
published
|
||||||
|
procedure CustomRecordMapping;
|
||||||
|
procedure GenericCustomRecordMapping;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.Rtti,
|
||||||
|
System.SysUtils,
|
||||||
|
System.TypInfo,
|
||||||
|
System.Variants;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDaintyValueSetterTest }
|
||||||
|
procedure TDaintyValueSetterTest.SetUp;
|
||||||
|
begin
|
||||||
|
inherited SetUp;
|
||||||
|
|
||||||
|
FDataSet := TClientDataSet.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyValueSetterTest.TearDown;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FDataSet);
|
||||||
|
|
||||||
|
inherited TearDown;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TCustomRecord = record
|
||||||
|
Value: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TCustomRecordRow = class
|
||||||
|
StringField: TCustomRecord;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Mimics our proprietary implementation of generic nullables, which is based on:
|
||||||
|
https://community.embarcadero.com/blogs/entry/a-andquotnullableandquot-post-38869 }
|
||||||
|
TGenericCustomRecord<T> = record
|
||||||
|
Value: T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGenericCustomRecordRow = class
|
||||||
|
StringField: TGenericCustomRecord<string>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TCustomRecordValueSetterFactory = class(TDaintyAbstractValueSetterFactory)
|
||||||
|
public
|
||||||
|
class function Construct(AMember: TDaintyRttiMember): TDaintyValueSetter; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TCustomRecordValueSetterFactory }
|
||||||
|
class function TCustomRecordValueSetterFactory.Construct(AMember: TDaintyRttiMember): TDaintyValueSetter;
|
||||||
|
begin
|
||||||
|
if AMember.RttiType.TypeKind <> tkRecord then
|
||||||
|
Exit(nil);
|
||||||
|
|
||||||
|
if AMember.RttiType.Handle = TypeInfo(TCustomRecord) then
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
var
|
||||||
|
customRecord: TCustomRecord;
|
||||||
|
|
||||||
|
begin
|
||||||
|
customRecord.Value := AField.AsString;
|
||||||
|
AMember.SetValue(AInstance, TValue.From(customRecord));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Unfortunately I have not found a way to make this generic, if you do let me know!
|
||||||
|
The workaround is to handle all types you want to support explicitly, which is
|
||||||
|
good enough for our use case with nullable implementations. }
|
||||||
|
end else if AMember.RttiType.Handle = TypeInfo(TGenericCustomRecord<string>) then
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
procedure(AInstance: TObject; AField: TField)
|
||||||
|
var
|
||||||
|
value: TGenericCustomRecord<string>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
value.Value := AField.AsString;
|
||||||
|
AMember.SetValue(AInstance, TValue.From(value));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyValueSetterTest.CustomRecordMapping;
|
||||||
|
var
|
||||||
|
row: TCustomRecordRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('STRINGFIELD').AsString := 'Hello world!';
|
||||||
|
DataSet.Post;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TCustomRecordValueSetterFactory, 1);
|
||||||
|
try
|
||||||
|
DataSet.First;
|
||||||
|
row := DataSet.GetFirst<TCustomRecordRow>;
|
||||||
|
|
||||||
|
CheckEquals('Hello world!', row.StringField.Value);
|
||||||
|
finally
|
||||||
|
TDaintyRttiMapperFactory.UnregisterValueSetterFactory(TCustomRecordValueSetterFactory);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TDaintyValueSetterTest.GenericCustomRecordMapping;
|
||||||
|
var
|
||||||
|
row: TGenericCustomRecordRow;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DataSet.FieldDefs.Add('STRINGFIELD', ftString, 50);
|
||||||
|
DataSet.CreateDataSet;
|
||||||
|
DataSet.LogChanges := False;
|
||||||
|
|
||||||
|
DataSet.Append;
|
||||||
|
DataSet.FieldByName('STRINGFIELD').AsString := 'Hello world!';
|
||||||
|
DataSet.Post;
|
||||||
|
|
||||||
|
|
||||||
|
TDaintyRttiMapperFactory.RegisterValueSetterFactory(TCustomRecordValueSetterFactory, 1);
|
||||||
|
try
|
||||||
|
DataSet.First;
|
||||||
|
row := DataSet.GetFirst<TGenericCustomRecordRow>;
|
||||||
|
|
||||||
|
CheckEquals('Hello world!', row.StringField.Value);
|
||||||
|
finally
|
||||||
|
TDaintyRttiMapperFactory.UnregisterValueSetterFactory(TCustomRecordValueSetterFactory);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterTest(TDaintyValueSetterTest.Suite);
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue