Skip to content

Commit

Permalink
support test any user dll powered by #gdd
Browse files Browse the repository at this point in the history
  • Loading branch information
turborium committed Nov 11, 2023
1 parent 1f1909c commit 9339da5
Show file tree
Hide file tree
Showing 2 changed files with 130 additions and 14 deletions.
131 changes: 119 additions & 12 deletions Pascal/Test/MainUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,8 @@ function MsvcrtWcstod(Str: PWideChar; PtrEnd: PPWideChar): Double; cdecl; extern
var
pure_parse_float_library: HMODULE;
pure_parse_float: function(Str: PAnsiChar; Double: PDouble; PtrEnd: PPAnsiChar): Double; cdecl;
dll_pure_parse_float_library: HMODULE;
dll_pure_parse_float: function(Str: PAnsiChar; Double: PDouble; PtrEnd: PPAnsiChar): Double; cdecl;

// from ieee_convert32.dll/ieee_convert64.dll
function IeeeStringToDouble(Str: UnicodeString; out Value: Double): Integer;
Expand Down Expand Up @@ -103,6 +105,20 @@ function PureStringToDoubleC(Str: UnicodeString; out Value: Double): Integer;
Result := PEnd - PAnsiChar(AnsiStr);
end;

// from user dll
function PureStringToDoubleUserDll(Str: UnicodeString; out Value: Double): Integer;
var
AnsiStr: AnsiString;
PEnd: PAnsiChar;
begin
Value := 0.0;
AnsiStr := AnsiString(Str);// unicode -> ansi

dll_pure_parse_float(PAnsiChar(AnsiStr), @Value, @PEnd);

Result := PEnd - PAnsiChar(AnsiStr);
end;

// form MSVCRT.dll
function MsvcrtStringToDouble(Str: UnicodeString; out Value: Double): Integer;
var
Expand Down Expand Up @@ -159,6 +175,14 @@ procedure AssertEqual(S: UnicodeString);
begin
CountA := IeeeStringToDouble(S, A);

if @dll_pure_parse_float <> nil then
begin
CountB := PureStringToDoubleUserDll(S, B);
Assert(CountA = CountB);
Assert(ABin = BBin);
exit;
end;

case Mode of
ModePure:
begin
Expand Down Expand Up @@ -202,6 +226,21 @@ function UlpDiff(S: UnicodeString): TUlpDiffType;
BBin: Int64 absolute B;
begin
IeeeStringToDouble(S, A);

if @dll_pure_parse_float <> nil then
begin
PureStringToDoubleUserDll(S, B);
if ABin = BBin then
begin
exit(udtSame);
end;
if (ABin - 1 = BBin) or (ABin + 1 = BBin) then
begin
exit(udtOne);
end;
exit(udtMoreThanOne);
end;

case Mode of
ModePure:
begin
Expand Down Expand Up @@ -713,7 +752,7 @@ procedure Benchmark();
AnsiTestStrings := AnsiTestStrings + [AnsiString(S)];
end;

Times := [0, 0, 0, 0, 0];
Times := [0, 0, 0, 0, 0, 0];
for N := 0 to 400 - 1 do
begin
// netlib/David M. Gay
Expand Down Expand Up @@ -762,6 +801,17 @@ procedure Benchmark();
end;
Times[4] := Times[4] + Int64(TThread.GetTickCount64() - Time);
end;

// ParseFloat dll
if @dll_pure_parse_float <> nil then
begin
Time := TThread.GetTickCount64();
for I := 0 to High(AnsiTestStrings) do
begin
dll_pure_parse_float(PAnsiChar(AnsiTestStrings[I]), @D, @PAnsiEnd);
end;
Times[5] := Times[5] + Int64(TThread.GetTickCount64() - Time);
end;
end;

Writeln('Netlib strtod: ', Times[0], 'ms');
Expand All @@ -779,6 +829,10 @@ procedure Benchmark();
Writeln(' ', (Times[4] / Times[3]):0:2, 'x slower');
end;
end;
if @dll_pure_parse_float <> nil then
begin
Writeln('User DLL ParseFloat: ', Times[5], 'ms');
end;
end;

procedure DoRunTests();
Expand All @@ -787,9 +841,57 @@ procedure DoRunTests();
I: Integer;
SuccessCount: Integer;
CmdSize, CmdMode: UnicodeString;
DllName, DllFunctionName: UnicodeString;
begin
Writeln('=== PureFloatParser Test ===');

if FindCmdLineSwitch('dll') then
begin
if not FindCmdLineSwitch('function') then
begin
Writeln('Please use -function with -dll option!');
exit;
end;
// load dll
{$IFDEF FPC}
DllName := GetCmdLineArg('dll', ['-']);
{$ELSE}
DllName := '';
FindCmdLineSwitch('dll', DllName, True, [clstValueNextParam]);
{$ENDIF}
if DllName = '' then
begin
Writeln('Bad -dll param!');
exit;
end;
dll_pure_parse_float_library := LoadLibrary(PWideChar(DllName));
if pure_parse_float_library = 0 then
begin
Writeln('Can''t open "' + DllName + '" dll!');
exit;
end;
// load func
{$IFDEF FPC}
DllFunctionName := GetCmdLineArg('function', ['-']);
{$ELSE}
DllFunctionName := '';
FindCmdLineSwitch('function', DllFunctionName, True, [clstValueNextParam]);
{$ENDIF}
if DllFunctionName = '' then
begin
Writeln('Bad -function param!');
exit;
end;
@dll_pure_parse_float := GetProcAddress(dll_pure_parse_float_library, PWideChar(DllFunctionName));
if @dll_pure_parse_float = nil then
begin
Writeln('Can''t load function "' + DllFunctionName + '" from dll!');
exit;
end;
// print info
Writeln('*** Parser function "' + DllFunctionName + '", from user DLL "', DllName, '" ***');
end;

if FindCmdLineSwitch('c') then
begin
if @pure_parse_float = nil then
Expand Down Expand Up @@ -855,7 +957,8 @@ procedure DoRunTests();
Writeln('Bad param parser!');
exit;
end;
end else
end
else if @dll_pure_parse_float = nil then
begin
Writeln('Use "-parser pure/delphi/microsoft" for change a parser under test.');
Writeln(' Parser=Pure by default.');
Expand All @@ -867,23 +970,26 @@ procedure DoRunTests();
else
Writeln(' 64 bit cpu');

case Mode of
ModePure: Writeln(' Parser=Pure');
ModeDelphi: Writeln(' Parser=Delphi');
ModeMicrosoft: Writeln(' Parser=Microsoft');
end;
if @dll_pure_parse_float = nil then
begin
case Mode of
ModePure: Writeln(' Parser=Pure');
ModeDelphi: Writeln(' Parser=Delphi');
ModeMicrosoft: Writeln(' Parser=Microsoft');
end;
if TestCVersion then
begin
Writeln(' Test C Version');
end;
end else
Writeln(' Parser=User DLL');

case TestCount of
SizeSmall: Writeln(' Size=Small');
SizeMedium: Writeln(' Size=Medium');
SizeLarge: Writeln(' Size=Large');
end;

if TestCVersion then
begin
Writeln(' Test C Version');
end;

Writeln;

// make tests
Expand Down Expand Up @@ -971,6 +1077,7 @@ initialization

finalization
FreeLibrary(pure_parse_float_library);
FreeLibrary(dll_pure_parse_float_library);

end.

13 changes: 11 additions & 2 deletions Pascal/Test/Test.dproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,12 @@
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
<Cfg_1_Win64>true</Cfg_1_Win64>
<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>
Expand Down Expand Up @@ -68,7 +74,7 @@
<DCC_UsePackage>vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;ibxbindings;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
<Debugger_RunParams>-size medium -parser pure </Debugger_RunParams>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<OutputExt>32.exe</OutputExt>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
Expand All @@ -80,7 +86,7 @@
<DCC_UsePackage>vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;ibxbindings;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
<Debugger_RunParams>-size medium -parser pure </Debugger_RunParams>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<OutputExt>64.exe</OutputExt>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
Expand All @@ -96,6 +102,9 @@
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<Debugger_RunParams>-size medium -parser pure</Debugger_RunParams>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
Expand Down

0 comments on commit 9339da5

Please sign in to comment.