source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,955 @@
|
||||
unit PerfTestCases;
|
||||
|
||||
interface
|
||||
|
||||
{$I Synopse.inc}
|
||||
|
||||
// enable/disable third-party libraries
|
||||
{.$define USENEXUSDB}
|
||||
{.$define USEBDE}
|
||||
{.$define USEUNIDAC}
|
||||
{.$define USEZEOS}
|
||||
{.$define USEFIREDAC}
|
||||
|
||||
// enable/disable database engines
|
||||
{.$define USEJET}
|
||||
{.$define USEFIREBIRDEMB}
|
||||
{.$define ODBCSQLITEFIREBIRD}
|
||||
{.$define USELOCALMSSQLEXPRESS} // SQL Server 2008 R2 Express locally
|
||||
{.$define USELOCALDBMSSQLEXPRESS} // SQL Server 2012 LocalDB edition
|
||||
{.$define USELOCALDB2}
|
||||
{.$define USELOCALPOSTGRESQL}
|
||||
{.$define USELOCALMYSQL}
|
||||
{.$define USEMONGODB}
|
||||
|
||||
{$ifdef CPU64}
|
||||
{$undef USENEXUSDB} // official NexusDB is not yet 64 bit ready :(
|
||||
{$undef USEJET} // MS Access / JET is not available under Win64
|
||||
{$endif}
|
||||
|
||||
// if defined, will create two "stored false" properties, to test UNIQUE columns
|
||||
{.$define UNIK}
|
||||
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
SynCommons,
|
||||
SynTable,
|
||||
SynLog,
|
||||
SynTests,
|
||||
mORMot,
|
||||
SynSQLite3, SynSQLite3Static,
|
||||
SynDB, SynDBSQLite3, SynDBOracle, SynDBPostgres, SynDBRemote,
|
||||
mORMotSQLite3,
|
||||
{$ifdef MSWINDOWS}
|
||||
SynOleDB,
|
||||
SynDBDataSet,
|
||||
{$endif}
|
||||
SynDBODBC,
|
||||
{$ifdef USENEXUSDB}
|
||||
SynDBNexusDB,
|
||||
{$endif}
|
||||
{$ifdef USEBDE}
|
||||
SynDBBDE,
|
||||
{$endif}
|
||||
{$ifdef USEUNIDAC}
|
||||
SynDBUniDAC,
|
||||
SQLiteUniProvider, InterbaseUniProvider, OracleUniProvider, DB2UniProvider,
|
||||
SQLServerUniProvider, PostgreSQLUniProvider, MySqlUniProvider,
|
||||
{$endif}
|
||||
{$ifdef USEZEOS}
|
||||
SynDBZeos,
|
||||
{$endif}
|
||||
{$ifdef USEFIREDAC}
|
||||
SynDBFireDAC,
|
||||
{$ifdef ISDELPHIXE5}
|
||||
FireDAC.Phys.Oracle, FireDAC.Phys.MSAcc, FireDAC.Phys.MSSQL, FireDAC.Phys.MySQL,
|
||||
FireDAC.Phys.SQLite, FireDAC.Phys.IB, FireDAC.Phys.PG, FireDAC.Phys.DB2,
|
||||
{$else}
|
||||
uADPhysOracle, uADPhysMSAcc, uADPhysMSSQL,
|
||||
uADPhysSQLite, uADPhysIB, uADPhysPG, uADPhysDB2, uADPhysMySQL,
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$ifdef USEMONGODB}
|
||||
SynMongoDB, mORMotMongoDB,
|
||||
{$endif}
|
||||
mORMotDB;
|
||||
|
||||
type
|
||||
TStat = class(TSynPersistent)
|
||||
private
|
||||
fCreateTable: RawUTF8;
|
||||
fNumberOfElements: integer;
|
||||
fInsertTime: RawUTF8;
|
||||
fEngine: RawUTF8;
|
||||
fClientCloseTime: RawUTF8;
|
||||
fInsertRate: integer;
|
||||
fReadOneByOneTime: RawUTF8;
|
||||
fReadOneByOneRate: integer;
|
||||
fInsertBatchTransactionRate: integer;
|
||||
fInsertTransactionRate: integer;
|
||||
fInsertBatchRate: integer;
|
||||
fInsertBatchTransactionTime: RawUTF8;
|
||||
fInsertTransactionTime: RawUTF8;
|
||||
fInsertBatchTime: RawUTF8;
|
||||
fReadAllVirtualRate: integer;
|
||||
fReadAllDirectRate: integer;
|
||||
fReadAllDirectTime: RawUTF8;
|
||||
fReadAllVirtualTime: RawUTF8;
|
||||
{$ifdef UNIK}
|
||||
fReadOneByNameRate: integer;
|
||||
fReadOneByNameTime: RawUTF8;
|
||||
{$endif}
|
||||
published
|
||||
property Engine: RawUTF8 read fEngine;
|
||||
property CreateTableTime: RawUTF8 read fCreateTable write fCreateTable;
|
||||
property NumberOfElements: integer read fNumberOfElements write fNumberOfElements;
|
||||
property InsertTime: RawUTF8 read fInsertTime;
|
||||
property InsertRate: integer read fInsertRate;
|
||||
property InsertBatchTime: RawUTF8 read fInsertBatchTime;
|
||||
property InsertBatchRate: integer read fInsertBatchRate;
|
||||
property InsertTransactionTime: RawUTF8 read fInsertTransactionTime;
|
||||
property InsertTransactionRate: integer read fInsertTransactionRate;
|
||||
property InsertBatchTransactionTime: RawUTF8 read fInsertBatchTransactionTime;
|
||||
property InsertBatchTransactionRate: integer read fInsertBatchTransactionRate;
|
||||
property ReadOneByOneTime: RawUTF8 read fReadOneByOneTime;
|
||||
property ReadOneByOneRate: integer read fReadOneByOneRate;
|
||||
{$ifdef UNIK}
|
||||
property ReadOneByNameTime: RawUTF8 read fReadOneByNameTime;
|
||||
property ReadOneByNameRate: integer read fReadOneByNameRate;
|
||||
{$endif}
|
||||
property ReadAllVirtualTime: RawUTF8 read fReadAllVirtualTime;
|
||||
property ReadAllVirtualRate: integer read fReadAllVirtualRate;
|
||||
property ReadAllDirectTime: RawUTF8 read fReadAllDirectTime;
|
||||
property ReadAllDirectRate: integer read fReadAllDirectRate;
|
||||
property ClientCloseTime: RawUTF8 read fClientCloseTime;
|
||||
end;
|
||||
|
||||
TSQLRecordSample = class(TSQLRecord)
|
||||
private
|
||||
fFirstName: RawUTF8;
|
||||
fLastName: RawUTF8;
|
||||
fAmount: Currency;
|
||||
fBirthDate: TDateTime;
|
||||
fLastChange: TModTime;
|
||||
fCreatedAt: TCreateTime;
|
||||
published
|
||||
property FirstName: RawUTF8 index 40 read fFirstName write fFirstName
|
||||
{$ifdef UNIK}stored AS_UNIQUE{$endif};
|
||||
property LastName: RawUTF8 index 40 read fLastName write fLastName
|
||||
{$ifdef UNIK}stored AS_UNIQUE{$endif};
|
||||
property Amount: Currency read fAmount write fAmount;
|
||||
property BirthDate: TDateTime read fBirthDate write fBirthDate;
|
||||
property LastChange: TModTime read fLastChange write fLastChange;
|
||||
property CreatedAt: TCreateTime read fCreatedAt write fCreatedAt;
|
||||
end;
|
||||
|
||||
|
||||
TTestDatabaseBenchmark = class(TSynTestsLogged)
|
||||
public
|
||||
Ini: RawUTF8;
|
||||
Stats: TSynObjectList;
|
||||
constructor Create(const Ident: string = ''); override;
|
||||
destructor Destroy; override;
|
||||
procedure SaveStats;
|
||||
published
|
||||
procedure DirectDatabaseAccess;
|
||||
procedure ExternalDatabaseAccess;
|
||||
end;
|
||||
|
||||
TTestDatabaseAbstract = class(TSynTestCase)
|
||||
protected
|
||||
Main: TTestDatabaseBenchmark;
|
||||
Value: TSQLRecordSample;
|
||||
Stat: TStat;
|
||||
Namee, Num: RawUTF8;
|
||||
ChangeStart: TTimeLog;
|
||||
RunTimer: TPrecisionTimer;
|
||||
SQlite3Mode: TSQLSynchronousMode;
|
||||
SQlite3Lock: TSQLLockingMode;
|
||||
Client: TSQLRestClientDB;
|
||||
DBFileName: TFileName;
|
||||
DBPassword: RawUTF8;
|
||||
ValueLastName, ValueFirstName: TRawUTF8DynArray;
|
||||
Res: TIDDynArray;
|
||||
Flags: set of (dbIsFile, dbInMemory, dbInMemoryVirtual, dbPropIsMemory,
|
||||
dbPropUntouched, dbDropTable);
|
||||
procedure Setup; override;
|
||||
procedure Cleanup; override;
|
||||
procedure MethodSetup; override;
|
||||
procedure MethodCleanup; override;
|
||||
procedure RunTests; virtual;
|
||||
function ModelCreate: TSQLModel; virtual;
|
||||
procedure ClientCreate; virtual;
|
||||
procedure ClientFree; virtual;
|
||||
procedure RunWrites(UseTransactions, UseBatch: boolean); virtual;
|
||||
procedure ValueCheck(i: PtrInt);
|
||||
procedure RunModeLock(Mode: TSQLSynchronousMode; Lock: TSQLLockingMode); virtual;
|
||||
end;
|
||||
|
||||
TTestDirectSqliteEngine = class(TTestDatabaseAbstract)
|
||||
protected
|
||||
procedure RunModeLock(Mode: TSQLSynchronousMode; Lock: TSQLLockingMode); override;
|
||||
published
|
||||
procedure SqliteFileFull;
|
||||
procedure SqliteFileOff;
|
||||
procedure SqliteFileOffExc;
|
||||
procedure SqliteFileOffExcAes;
|
||||
procedure SqliteInMemory;
|
||||
end;
|
||||
|
||||
TTestInMemoryEngine = class(TTestDatabaseAbstract)
|
||||
protected
|
||||
function ModelCreate: TSQLModel; override;
|
||||
procedure ClientCreate; override;
|
||||
published
|
||||
procedure InMemoryStatic;
|
||||
procedure InMemoryVirtual;
|
||||
end;
|
||||
|
||||
TTestDatabaseExternalAbstract = class(TTestDatabaseAbstract)
|
||||
protected
|
||||
Props: TSQLDBConnectionProperties;
|
||||
function ModelCreate: TSQLModel; override;
|
||||
procedure ClientCreate; override;
|
||||
procedure ClientFree; override;
|
||||
procedure RunExternal(P: TSQLDBConnectionProperties); virtual;
|
||||
public
|
||||
end;
|
||||
|
||||
TTestSqliteExternal = class(TTestDatabaseExternalAbstract)
|
||||
protected
|
||||
procedure ClientCreate; override;
|
||||
published
|
||||
procedure ExternalSqliteFileFull;
|
||||
procedure ExternalSqliteFileOff;
|
||||
procedure ExternalSqliteFileOffExc;
|
||||
procedure ExternalSqliteInMemory;
|
||||
end;
|
||||
|
||||
TTestSqliteRemote = class(TTestDatabaseExternalAbstract)
|
||||
protected
|
||||
RemoteProps: TSQLDBSQLite3ConnectionProperties;
|
||||
RemoteServer: TSQLDBServerRemote;
|
||||
RemoteClient: TSQLDBConnectionPropertiesClass;
|
||||
procedure ClientCreate; override;
|
||||
procedure ClientFree; override;
|
||||
published
|
||||
{$ifdef MSWINDOWS}
|
||||
procedure RemoteSqliteWinHTTP;
|
||||
{$endif}
|
||||
procedure RemoteSqliteSocket;
|
||||
end;
|
||||
|
||||
{$ifdef USELOCALPOSTGRESQL}
|
||||
TTestPostgresql = class(TTestDatabaseExternalAbstract)
|
||||
published
|
||||
procedure _SynDBPostgres;
|
||||
{$ifdef USEZEOS}
|
||||
procedure ZeosPostgres;
|
||||
{$endif}
|
||||
end;
|
||||
{$endif USELOCALPOSTGRESQL}
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestDatabaseAbstract }
|
||||
|
||||
procedure TTestDatabaseAbstract.Setup;
|
||||
begin
|
||||
EnsureDirectoryExists(ExeVersion.ProgramFilePath + 'db');
|
||||
Main := Owner as TTestDatabaseBenchmark;
|
||||
Value := TSQLRecordSample.Create;
|
||||
Namee := 'Name/ ';
|
||||
UniqueRawUTF8(Namee); // FPC does not call it
|
||||
PWord(@Namee[4])^ := $a9c3; // some 'e'acute to test UTF-8 encoding
|
||||
SQlite3Mode := smOff; // fastest mode by default
|
||||
SQlite3Lock := lmExclusive;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.Cleanup;
|
||||
begin // warning: this method could be called several times after a single Setup
|
||||
FreeAndNil(Value);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.MethodSetup;
|
||||
begin
|
||||
Flags := [];
|
||||
Stat := TStat.Create;
|
||||
Stat.fEngine := ToUTF8(Owner.CurrentMethodInfo^.TestName);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.MethodCleanup;
|
||||
begin
|
||||
if Stat.Engine <> '' then
|
||||
Main.Stats.Add(Stat)
|
||||
else
|
||||
FreeAndNil(Stat);
|
||||
ClientFree;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.RunTests;
|
||||
const
|
||||
_ID: array['1'..'4'] of RawUTF8 = ('', ' batch', ' trans', ' batch trans');
|
||||
var
|
||||
trans, batch, UseDirect: boolean;
|
||||
time: RawUTF8;
|
||||
rate: QWord;
|
||||
i: PtrInt;
|
||||
log: ISynLog;
|
||||
begin
|
||||
// Insertion tests
|
||||
Num := '1';
|
||||
for trans := false to true do
|
||||
for batch := false to true do
|
||||
begin
|
||||
log := TSynLog.Enter('% Insert%',[Owner.CurrentMethodInfo^.IdentTestName,
|
||||
_ID[Num[1]]],self);
|
||||
RunWrites(trans, batch);
|
||||
NotifyTestSpeed('insert%',[_ID[Num[1]]],Stat.NumberOfElements,0,@RunTimer);
|
||||
time := RunTimer.LastTime;
|
||||
rate := RunTimer.PerSec(Stat.NumberOfElements);
|
||||
log := nil;
|
||||
case Num[1] of
|
||||
'1':
|
||||
begin
|
||||
Stat.fInsertTime := time;
|
||||
Stat.fInsertRate := rate;
|
||||
end;
|
||||
'2':
|
||||
begin
|
||||
Stat.fInsertBatchTime := time;
|
||||
Stat.fInsertBatchRate := rate;
|
||||
end;
|
||||
'3':
|
||||
begin
|
||||
Stat.fInsertTransactionTime := time;
|
||||
Stat.fInsertTransactionRate := rate;
|
||||
end;
|
||||
'4':
|
||||
begin
|
||||
Stat.fInsertBatchTransactionTime := time;
|
||||
Stat.fInsertBatchTransactionRate := rate;
|
||||
break; // still need Client for Read tests
|
||||
end;
|
||||
end;
|
||||
inc(Num[1]);
|
||||
ClientFree;
|
||||
end;
|
||||
// Read tests
|
||||
log := TSynLog.Enter('% Read One',[Owner.CurrentMethodInfo^.IdentTestName],self);
|
||||
Value.ClearProperties;
|
||||
RunTimer.Start;
|
||||
for i := 0 to Stat.NumberOfElements-1 do
|
||||
begin
|
||||
Client.Retrieve(Res[i],Value);
|
||||
ValueCheck(i);
|
||||
end;
|
||||
NotifyTestSpeed('read one',Stat.NumberOfElements,0,@RunTimer);
|
||||
Stat.fReadOneByOneTime := RunTimer.LastTime;
|
||||
Stat.fReadOneByOneRate := RunTimer.PerSec(Stat.NumberOfElements);
|
||||
log := nil;
|
||||
{$ifdef UNIK}
|
||||
// one by one retrieve values using Name property
|
||||
log := TSynLog.Enter('% Read Unique',[Owner.CurrentMethodInfo^.IdentTestName],self);
|
||||
RunTimer.Start;
|
||||
for i := 0 to Stat.NumberOfElements-1 do
|
||||
begin
|
||||
Client.Retrieve('LastName=?',[],[ValueLastName[i]],Value);
|
||||
Check((Value.IDValue=Res[i]) and
|
||||
(PInt64(@Value.Amount)^=(i+1)*100) and
|
||||
(Value.LastChange>=ChangeStart));
|
||||
end;
|
||||
NotifyTestSpeed('read unique',Stat.NumberOfElements,0,@RunTimer);
|
||||
Stat.fReadOneByNameTime := RunTimer.LastTime;
|
||||
Stat.fReadOneByNameRate := RunTimer.PerSec(Stat.NumberOfElements);
|
||||
{$endif UNIK}
|
||||
// retrieve all rows with or without the virtual module
|
||||
for UseDirect := false to true do
|
||||
begin
|
||||
log := nil;
|
||||
log := TSynLog.Enter('% Read Direct=%',
|
||||
[Owner.CurrentMethodInfo^.IdentTestName, BOOL_STR[UseDirect]],self);
|
||||
with Client.Server do
|
||||
begin
|
||||
Cache.Flush; // fair benchmark
|
||||
DB.CacheFlush; // fair benchmark (16100 rows/s->456000 with cache!)
|
||||
StaticVirtualTableDirect := UseDirect;
|
||||
end;
|
||||
RunTimer.Start;
|
||||
Value.ClearProperties;
|
||||
Check(Value.FillPrepare(Client,'order by RowId'), 'FillPrepare');
|
||||
//FileFromString((Value.FillTable as TSQLTableJSON).PrivateInternalCopy,Stat.Engine+'.json');
|
||||
i := 0;
|
||||
while Value.FillOne do
|
||||
begin
|
||||
ValueCheck(i);
|
||||
inc(i);
|
||||
end;
|
||||
CheckEqual(i,Stat.NumberOfElements,'FillOne');
|
||||
if UseDirect then
|
||||
begin
|
||||
NotifyTestSpeed('read direct',Stat.NumberOfElements,0,@RunTimer);
|
||||
Stat.fReadAllDirectTime := RunTimer.LastTime;
|
||||
Stat.fReadAllDirectRate := RunTimer.PerSec(Stat.NumberOfElements);
|
||||
end else
|
||||
begin
|
||||
NotifyTestSpeed('read virtual',Stat.NumberOfElements,0,@RunTimer);
|
||||
Stat.fReadAllVirtualTime := RunTimer.LastTime;
|
||||
Stat.fReadAllVirtualRate := RunTimer.PerSec(Stat.NumberOfElements);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestDatabaseAbstract.ModelCreate: TSQLModel;
|
||||
begin
|
||||
result := TSQLModel.Create([TSQLRecordSample]);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.ClientCreate;
|
||||
var
|
||||
fn: TFileName;
|
||||
begin
|
||||
if dbIsFile in Flags then
|
||||
fn := DBFileName
|
||||
else
|
||||
fn := SQLITE_MEMORY_DATABASE_NAME;
|
||||
Client := TSQLRestClientDB.Create(ModelCreate, nil, fn, TSQLRestServerDB,
|
||||
{auth=}false, DBPassword);
|
||||
Client.Model.Owner := Client;
|
||||
Client.Server.DB.Synchronous := SQlite3Mode;
|
||||
Client.Server.DB.LockingMode := SQlite3Lock;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.ClientFree;
|
||||
begin
|
||||
FreeAndNil(Client);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.RunWrites(UseTransactions, UseBatch: boolean);
|
||||
var
|
||||
i: PtrInt;
|
||||
forceID: boolean;
|
||||
begin
|
||||
DBFileName := FormatString('%db%%.%.db',[ExeVersion.ProgramFilePath, PathDelim,
|
||||
Owner.CurrentMethodInfo^.MethodName, Num]);
|
||||
if FileExists(DBFileName) then
|
||||
DeleteFile(DBFileName);
|
||||
RunTimer.Start;
|
||||
ClientCreate;
|
||||
if CheckFailed(Client <> nil,'Client?') then
|
||||
exit; // avoid GPF
|
||||
Client.Server.CreateMissingTables;
|
||||
ChangeStart := Client.ServerTimestamp; // use by ValueCheck
|
||||
if Stat.CreateTableTime='' then
|
||||
Stat.CreateTableTime := RunTimer.Stop;
|
||||
if (SQlite3Mode = smFull) and not UseTransactions then // full synch is slow
|
||||
Stat.NumberOfElements := 500
|
||||
else
|
||||
Stat.NumberOfElements := 5000;
|
||||
SetLength(ValueLastName, Stat.NumberOfElements);
|
||||
SetLength(ValueFirstName, Stat.NumberOfElements);
|
||||
for i := 0 to Stat.NumberOfElements - 1 do
|
||||
if ValueLastName[i] = '' then
|
||||
begin
|
||||
UInt32ToUtf8(i + 1, ValueLastName[i]);
|
||||
{$ifndef UNIK}
|
||||
if i <> 100 then // test https://synopse.info/fossil/info/e8c211062e
|
||||
{$endif}
|
||||
ValueFirstName[i] := Namee + ValueLastName[i];
|
||||
end;
|
||||
RunTimer.Start;
|
||||
if UseTransactions then
|
||||
Client.TransactionBegin(TSQLRecordSample);
|
||||
if UseBatch then
|
||||
Client.BatchStart(TSQLRecordSample)
|
||||
else
|
||||
if length(Res)<Stat.NumberOfElements then
|
||||
SetLength(Res,Stat.NumberOfElements);
|
||||
for i := 0 to Stat.NumberOfElements-1 do
|
||||
begin
|
||||
Value.Amount := (i+1)*0.01;
|
||||
Value.LastName := ValueLastName[i];
|
||||
Value.FirstName := ValueFirstName[i];
|
||||
Value.BirthDate := i+1;
|
||||
forceID := i and 3=1;
|
||||
if forceID then
|
||||
if {$ifdef UNIK}(dbInMemory in Flags) or {$endif} (Res[i-1] = 0) then
|
||||
forceID := false // not yet in TSQLRestStorageInMemory.AddOne
|
||||
else
|
||||
Value.IDValue := Res[i-1]+1;
|
||||
if UseBatch then
|
||||
Check(Client.BatchAdd(Value,true,forceID)>=0)
|
||||
else
|
||||
begin
|
||||
Res[i] := Client.Add(Value,true,forceID);
|
||||
Check(Res[i]>0,'Add');
|
||||
end;
|
||||
end;
|
||||
if UseBatch then
|
||||
Check(Client.BatchSend(Res)=HTTP_SUCCESS);
|
||||
if UseTransactions then
|
||||
Client.Commit;
|
||||
Value.ClearProperties;
|
||||
Check(Client.Retrieve(Res[1],Value),'One Retrieve after Add');
|
||||
ValueCheck(1);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.ValueCheck(i: PtrInt);
|
||||
begin
|
||||
CheckEqual(Value.IDValue, Res[i], 'ID');
|
||||
CheckEqual(PInt64(@Value.Amount)^, (i+1)*100, 'Amount');
|
||||
Check(Value.LastChange >= ChangeStart, 'LastChange');
|
||||
CheckEqual(Value.FirstName, ValueFirstName[i], 'FirstName');
|
||||
Value.IDValue := 0;
|
||||
Value.Amount := 0;
|
||||
Value.FirstName := '';
|
||||
Value.LastChange := 0;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseAbstract.RunModeLock(Mode: TSQLSynchronousMode;
|
||||
Lock: TSQLLockingMode);
|
||||
begin
|
||||
SQlite3Mode := Mode;
|
||||
SQlite3Lock := Lock;
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
|
||||
{ TTestDirectSqliteEngine }
|
||||
|
||||
procedure TTestDirectSqliteEngine.RunModeLock(Mode: TSQLSynchronousMode; Lock: TSQLLockingMode);
|
||||
begin
|
||||
Flags := [dbIsFile];
|
||||
inherited RunModeLock(Mode, Lock);
|
||||
end;
|
||||
|
||||
procedure TTestDirectSqliteEngine.SqliteFileFull;
|
||||
begin
|
||||
RunModeLock(smFull, lmNormal);
|
||||
end;
|
||||
|
||||
procedure TTestDirectSqliteEngine.SqliteFileOff;
|
||||
begin
|
||||
RunModeLock(smOff, lmNormal);
|
||||
end;
|
||||
|
||||
procedure TTestDirectSqliteEngine.SqliteFileOffExc;
|
||||
begin
|
||||
RunModeLock(smOff, lmExclusive);
|
||||
end;
|
||||
|
||||
procedure TTestDirectSqliteEngine.SqliteFileOffExcAes;
|
||||
begin
|
||||
DBPassword := 'password';
|
||||
RunModeLock(smOff, lmExclusive);
|
||||
DBPassword := '';
|
||||
end;
|
||||
|
||||
procedure TTestDirectSqliteEngine.SqliteInMemory;
|
||||
begin
|
||||
Flags := [];
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
|
||||
{ TTestInMemoryEngine }
|
||||
|
||||
function TTestInMemoryEngine.ModelCreate: TSQLModel;
|
||||
begin
|
||||
result := inherited ModelCreate;
|
||||
// registration should be done BEFORE Client is initialized
|
||||
if dbInMemoryVirtual in Flags then
|
||||
result.VirtualTableRegister(TSQLRecordSample, TSQLVirtualTableBinary)
|
||||
end;
|
||||
|
||||
procedure TTestInMemoryEngine.ClientCreate;
|
||||
begin
|
||||
inherited ClientCreate;
|
||||
if not (dbInMemoryVirtual in Flags) then
|
||||
Client.Server.StaticDataCreate(TSQLRecordSample, DBFileName, {binary=}true);
|
||||
end;
|
||||
|
||||
procedure TTestInMemoryEngine.InMemoryStatic;
|
||||
begin
|
||||
Flags := [dbInMemory];
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
procedure TTestInMemoryEngine.InMemoryVirtual;
|
||||
begin
|
||||
Flags := [dbInMemory, dbInMemoryVirtual];
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
|
||||
{ TTestDatabaseExternalAbstract }
|
||||
|
||||
function TTestDatabaseExternalAbstract.ModelCreate: TSQLModel;
|
||||
begin
|
||||
result := inherited ModelCreate;
|
||||
// registration should be done BEFORE Client is initialized
|
||||
VirtualTableExternalRegister(result, TSQLRecordSample, Props, 'SampleRecord');
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseExternalAbstract.ClientCreate;
|
||||
begin
|
||||
if (Props <> nil) and (dbDropTable in Flags) then
|
||||
Props.ExecuteNoResult('drop table SAMPLERECORD', []);
|
||||
inherited ClientCreate;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseExternalAbstract.ClientFree;
|
||||
begin
|
||||
inherited ClientFree;
|
||||
if not(dbPropUntouched in Flags) then
|
||||
FreeAndNil(Props);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseExternalAbstract.RunExternal(P: TSQLDBConnectionProperties);
|
||||
begin
|
||||
Flags := [dbPropUntouched, dbDropTable];
|
||||
Props := P;
|
||||
try
|
||||
Props.ThreadSafeConnection.Connect;
|
||||
Check(Props.ThreadSafeConnection.Connected, 'connected');
|
||||
RunTests;
|
||||
finally
|
||||
FreeAndNil(Props);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TTestSqliteExternal }
|
||||
|
||||
procedure TTestSqliteExternal.ClientCreate;
|
||||
begin
|
||||
if dbPropIsMemory in Flags then
|
||||
DBFileName := SQLITE_MEMORY_DATABASE_NAME;
|
||||
if not (dbPropUntouched in Flags) then
|
||||
Props := TSQLDBSQLite3ConnectionProperties.Create(DBFileName, '', '', '');
|
||||
with TSQLDBSQLite3Connection(Props.MainConnection) do
|
||||
begin
|
||||
Synchronous := SQlite3Mode;
|
||||
LockingMode := SQlite3Lock;
|
||||
end;
|
||||
inherited ClientCreate;
|
||||
end;
|
||||
|
||||
procedure TTestSqliteExternal.ExternalSqliteFileFull;
|
||||
begin
|
||||
RunModeLock(smFull, lmNormal);
|
||||
end;
|
||||
|
||||
procedure TTestSqliteExternal.ExternalSqliteFileOff;
|
||||
begin
|
||||
RunModeLock(smOff, lmNormal);
|
||||
end;
|
||||
|
||||
procedure TTestSqliteExternal.ExternalSqliteFileOffExc;
|
||||
begin
|
||||
RunModeLock(smOff, lmExclusive);
|
||||
end;
|
||||
|
||||
procedure TTestSqliteExternal.ExternalSqliteInMemory;
|
||||
begin
|
||||
Flags := [dbPropIsMemory];
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
|
||||
{ TTestSqliteRemote }
|
||||
|
||||
procedure TTestSqliteRemote.ClientCreate;
|
||||
begin
|
||||
RemoteProps := TSQLDBSQLite3ConnectionProperties.Create(SQLITE_MEMORY_DATABASE_NAME, '', '', '');
|
||||
RemoteProps.MainSQLite3DB.Synchronous := SQlite3Mode;
|
||||
RemoteProps.MainSQLite3DB.LockingMode := SQlite3Lock;
|
||||
RemoteServer := TSQLDBServerRemote.Create(RemoteProps, 'root', '8888', 'user', 'password');
|
||||
Props := RemoteClient.Create('localhost:8888', 'root', 'user', 'password');
|
||||
inherited ClientCreate;
|
||||
end;
|
||||
|
||||
procedure TTestSqliteRemote.ClientFree;
|
||||
begin
|
||||
inherited ClientFree;
|
||||
RemoteServer.Free;
|
||||
RemoteProps.Free;
|
||||
end;
|
||||
|
||||
procedure TTestSqliteRemote.RemoteSqliteSocket;
|
||||
begin
|
||||
RemoteClient := TSQLDBSocketConnectionProperties;
|
||||
RunTests;
|
||||
end;
|
||||
|
||||
{$ifdef MSWINDOWS}
|
||||
procedure TTestSqliteRemote.RemoteSqliteWinHTTP;
|
||||
begin
|
||||
RemoteClient := TSQLDBWinHTTPConnectionProperties;
|
||||
RunTests;
|
||||
end;
|
||||
{$endif MSWINDOWS}
|
||||
|
||||
|
||||
{$ifdef USELOCALPOSTGRESQL}
|
||||
|
||||
{ TTestPostgresql }
|
||||
|
||||
procedure TTestPostgresql._SynDBPostgres;
|
||||
begin
|
||||
RunExternal(TSQLDBPostgresConnectionProperties.Create(
|
||||
'localhost','postgres','postgres','docker'));
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef USEZEOS}
|
||||
procedure TTestPostgresql.ZeosPostgres;
|
||||
begin
|
||||
RunExternal(TSQLDBZEOSConnectionProperties.Create(TSQLDBZEOSConnectionProperties.URI(
|
||||
dPostgreSQL,'localhost','libpq.so.5',false),'postgres','postgres','docker'));
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$endif USELOCALPOSTGRESQL}
|
||||
|
||||
|
||||
{ TTestDatabaseBenchmark }
|
||||
|
||||
constructor TTestDatabaseBenchmark.Create(const Ident: string);
|
||||
var
|
||||
fn: TFileName;
|
||||
begin
|
||||
Stats := TSynObjectList.Create;
|
||||
fn := ChangeFileExt(ExeVersion.ProgramFileName, '.ini');
|
||||
if FileExists(fn) then
|
||||
Ini := StringFromFile(fn)
|
||||
else
|
||||
FileFromString('', fn);
|
||||
inherited Create(Ident);
|
||||
end;
|
||||
|
||||
destructor TTestDatabaseBenchmark.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
SaveStats;
|
||||
Stats.Free;
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseBenchmark.SaveStats;
|
||||
type TStatArray = array[0..1000] of TStat;
|
||||
var Stat: ^TStatArray;
|
||||
mode,s,txt: RawUTF8;
|
||||
m,nCat, col1len: integer;
|
||||
max,Cat1,Cat2,Eng1,Eng2,Eng: RawUTF8;
|
||||
Rows: TRawUTF8DynArray;
|
||||
Doc, Cons: RawUTF8;
|
||||
procedure SetCategories(const Title: RawUTF8; const Cat: array of RawUTF8);
|
||||
var i: integer;
|
||||
begin
|
||||
mode := UrlEncode(Title);
|
||||
s := s+'<h1>'+copy(Title,1,posEx(' (',Title)-1)+'</h1>'#13#10;
|
||||
max := Int32ToUtf8(m);
|
||||
nCat := length(Cat);
|
||||
Cat1 := '';
|
||||
Cat2 := '';
|
||||
SetLength(Rows,Stats.Count+1);
|
||||
Rows[0] := '<td> </td>';
|
||||
cons := cons+#13#10+Title+#13#10+StringOfChar(' ',col1len+2);
|
||||
for i := 0 to high(Cat) do begin
|
||||
Rows[0] := Rows[0]+'<td><b>'+Cat[i]+'</b></td>';
|
||||
Cat1 := Cat1+UrlEncode(Cat[i])+'|';
|
||||
Cat2 := Cat2+UrlEncode(Cat[high(Cat)-i])+'|';
|
||||
cons := cons+Cat[i];
|
||||
if i<>high(Cat) then
|
||||
cons := cons+StringOfChar(' ',12-length(Cat[i]));
|
||||
end;
|
||||
cons := cons+#13#10;
|
||||
SetLength(Cat1,length(Cat1)-1);
|
||||
SetLength(Cat2,length(Cat2)-1);
|
||||
Eng1 := '';
|
||||
Eng2 := '';
|
||||
for i := 0 to Stats.Count-1 do begin
|
||||
Eng := Stat[i].Engine;
|
||||
{ j := PosEx(' ',Eng);
|
||||
if j>0 then begin
|
||||
Delete(Eng,j,1);
|
||||
insert('<br>',Eng,j);
|
||||
end;}
|
||||
Rows[i+1] := '<td><b>'+Eng+'</b></td>';
|
||||
Eng1 := Eng1+UrlEncode(Stat[i].Engine)+'|';
|
||||
Eng2 := Eng2+UrlEncode(Stat[Stats.Count-1-i].Engine)+'|';
|
||||
end;
|
||||
SetLength(Eng1,length(Eng1)-1);
|
||||
SetLength(Eng2,length(Eng2)-1);
|
||||
end;
|
||||
procedure Pic1(const Leg: RawUTF8; n: integer);
|
||||
var i: integer;
|
||||
begin
|
||||
txt := 'http://chart.apis.google.com/chart?chtt='+mode+'&chxl=1:|'+Leg+
|
||||
'&chxt=x,y&chbh=a&chs=600x500&cht=bhg&chco=';
|
||||
// for i := 1 to 5 do txt := txt+IntToHex($309F30+i*$010101,3)+',';
|
||||
// txt[length(txt)] := '&';
|
||||
// '3D7930,3D8930,309F30,6070F0,5070E0,40C355,65D055,80C1A2,F05050,F0A280'+
|
||||
txt := txt+'3D7930,3D8930,309F30,40C355&';//,6070F0,5070E0,65D055,80C1A2,3D7930,3D8930,F05050,F04050,F04040,F01040,F0A280&';
|
||||
txt := txt+'chxr=0,0,'+max+'&chds=';
|
||||
for i := 1 to n do
|
||||
txt := txt+'0,'+max+',';
|
||||
txt[length(txt)] := '&';
|
||||
txt := txt+'chd=t:';
|
||||
end;
|
||||
procedure PicEnd(const Legend: RawUTF8);
|
||||
begin
|
||||
txt[length(txt)] := '&';
|
||||
s := s+'<p><img src='+txt+'chdl='+Legend+'></p>'#13#10;
|
||||
txt := '';
|
||||
end;
|
||||
procedure SetValues(var Rows: RawUTF8; const eng: RawUTF8; const v: array of const);
|
||||
var j: integer;
|
||||
fmt,s: RawUTF8;
|
||||
begin
|
||||
for j := 2 to length(v) do
|
||||
fmt := fmt+'%,';
|
||||
fmt := fmt+'%|';
|
||||
txt := txt+FormatUTF8(fmt,v);
|
||||
fmt := '';
|
||||
for j := 1 to length(v) do
|
||||
fmt := fmt+'<td>%</td>';
|
||||
Rows := Rows+FormatUTF8(fmt,v);
|
||||
fmt := eng+StringOfChar(' ',col1len-length(eng)+2);
|
||||
for j := 0 to high(v) do begin
|
||||
VarRecToUTF8(v[j],s);
|
||||
if j<>high(v) then
|
||||
s := s+StringOfChar(' ',12-length(s));
|
||||
fmt := fmt+s;
|
||||
end;
|
||||
cons := cons+fmt+#13#10;
|
||||
end;
|
||||
procedure Table;
|
||||
var i: integer;
|
||||
begin
|
||||
s := s+'<p><table>';
|
||||
for i := 0 to High(Rows) do
|
||||
s := s+'<tr align=center>'+Rows[i]+'</tr>'#13#10;
|
||||
s := s+'</table></p>';
|
||||
Doc := Doc+'|%30';
|
||||
for i := 1 to nCat do
|
||||
Doc := Doc+'%15';
|
||||
Doc := Doc+#13#10;
|
||||
for i := 0 to High(Rows) do begin
|
||||
Doc := Doc+StringReplaceAll(Rows[i], ['</td>','', '</tr>','', '<tr align=center>','',
|
||||
'</b>','}', '</td>','', '<b>','{\b ', '<td>','|', ' ',''])+#13#10;
|
||||
end;
|
||||
Doc := Doc+'|%'#13#10;
|
||||
end;
|
||||
var i,j: integer;
|
||||
begin
|
||||
// introducting text
|
||||
Stat := pointer(Stats.List);
|
||||
s := FormatUTF8('Running tests using Synopse mORMot framework %, '+
|
||||
'compiled with %, against SQLite %, on %, at %.',
|
||||
[SYNOPSE_FRAMEWORK_VERSION, GetDelphiCompilerVersion, SQLite3.libversion,
|
||||
OSVersionText, NowToString]);
|
||||
cons := '[code]'#13#10+s+#13#10#13#10;
|
||||
s := '<p>'+s+'</p>';
|
||||
// compute max Insertion rate value for charts
|
||||
m := 0;
|
||||
col1len := 0;
|
||||
for i := 0 to Stats.Count-1 do
|
||||
with Stat[i] do begin
|
||||
if InsertRate>m then m := InsertRate;
|
||||
if InsertBatchRate>m then m := InsertBatchRate;
|
||||
if InsertTransactionRate>m then m := InsertTransactionRate;
|
||||
if InsertBatchTransactionRate>m then m := InsertBatchTransactionRate;
|
||||
j := length(Engine);
|
||||
if j>col1len then
|
||||
col1len := j;
|
||||
end;
|
||||
// Insertion Categories
|
||||
SetCategories('Insertion speed (rows/second)',['Direct','Batch','Trans','Batch Trans']);
|
||||
// Insertion per-Engine Values and Chart
|
||||
Pic1(Cat2,5);
|
||||
for i := 0 to Stats.Count-1 do
|
||||
with Stat[i] do
|
||||
SetValues(Rows[i+1], Engine,
|
||||
[InsertRate,InsertBatchRate,InsertTransactionRate,InsertBatchTransactionRate]);
|
||||
Table;
|
||||
PicEnd(Eng1);
|
||||
// Insertion per-Category Chart
|
||||
Pic1(Eng2,Stats.Count);
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].InsertRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].InsertBatchRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].InsertTransactionRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].InsertBatchTransactionRate)+',';
|
||||
PicEnd(Cat1);
|
||||
// compute max Reading rate value for charts
|
||||
m := 0;
|
||||
for i := 0 to Stats.Count-1 do
|
||||
with Stat[i] do begin
|
||||
if ReadOneByOneRate>m then m := ReadOneByOneRate;
|
||||
{$ifdef UNIK}
|
||||
if ReadOneByNameRate>m then m := ReadOneByNameRate;
|
||||
{$endif}
|
||||
if ReadAllVirtualRate>m then m := ReadAllVirtualRate;
|
||||
if ReadAllDirectRate>m then m := ReadAllDirectRate;
|
||||
end;
|
||||
// Reading Categories
|
||||
SetCategories('Read speed (rows/second)',['By one',
|
||||
{$ifdef UNIK}'By name',{$endif}'All Virtual','All Direct']);
|
||||
// Reading per-Engine Values and Chart
|
||||
Pic1(Cat2,{$ifdef UNIK}4{$else}3{$endif});
|
||||
for i := 0 to Stats.Count-1 do
|
||||
with Stat[i] do
|
||||
SetValues(Rows[i+1], Engine,
|
||||
[ReadOneByOneRate,{$ifdef UNIK}ReadOneByNameRate,{$endif}
|
||||
ReadAllVirtualRate,ReadAllDirectRate]);
|
||||
Table;
|
||||
PicEnd(Eng1);
|
||||
// Reading per-Category Chart
|
||||
Pic1(Eng2,Stats.Count);
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].ReadOneByOneRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
{$ifdef UNIK}
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].ReadOneByNameRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
{$endif}
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].ReadAllVirtualRate)+',';
|
||||
txt[length(txt)] := '|';
|
||||
for i := 0 to Stats.Count-1 do
|
||||
txt := txt+Int32ToUtf8(Stat[i].ReadAllDirectRate)+',';
|
||||
PicEnd(Cat1);
|
||||
// save to local files
|
||||
FileFromString(Doc,ChangeFileExt(ExeVersion.ProgramFileName,'.doc'));
|
||||
FileFromString(cons+'[/code]',ChangeFileExt(ExeVersion.ProgramFileName,'.txt'));
|
||||
FileFromString('<html><body>'#13#10+s,ChangeFileExt(ExeVersion.ProgramFileName,'.htm'));
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseBenchmark.DirectDatabaseAccess;
|
||||
begin
|
||||
//exit;
|
||||
AddCase(TTestDirectSqliteEngine);
|
||||
AddCase(TTestInMemoryEngine);
|
||||
end;
|
||||
|
||||
procedure TTestDatabaseBenchmark.ExternalDatabaseAccess;
|
||||
begin
|
||||
//exit;
|
||||
AddCase(TTestSqliteExternal);
|
||||
AddCase(TTestSqliteRemote);
|
||||
{$ifdef USELOCALPOSTGRESQL}
|
||||
AddCase(TTestPostgresql);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user