paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 04:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* restructured the test-suite

Browse Source 
+ added several tests
 + added a connector for TMemDataset

git-svn-id: trunk@5745 -
This commit is contained in:
joost 2006-12-29 21:33:20 +00:00
parent 4264f5d041
commit 0cab61a2e0
9 changed files with 1158 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -778,7 +778,7 @@ fcl/dbtests/Makefile.fpc -text
fcl/dbtests/database.ini -text
fcl/dbtests/dbftoolsunit.pas -text
fcl/dbtests/dbtestframework.pas -text
fcl/dbtests/settings.inc -text
fcl/dbtests/memdstoolsunit.pas svneol=native#text/plain
fcl/dbtests/sqldbtoolsunit.pas -text
fcl/dbtests/testbasics.pas svneol=native#text/plain
fcl/dbtests/testdbbasics.pas -text

25
fcl/dbtests/database.ini
View File

@ -1,31 +1,40 @@
[Database]
type=oracle
type=interbase
[postgresql]
connector=sql
connectorparams=postgresql
name=testdb
user=
password=
hostname=
[mysql40]
name=test
connector=sql
connectorparams=mysql40
name=cnoc02
user=root
password=
password=rosivrepus
hostname=192.168.3.1
[oracle]
connector=sql
connectorparams=oracle
name=xe
user=system
password=
password=rosivrepus
hostname=192.168.3.1
[interbase]
connector=sql
connectorparams=interbase
name=/opt/firebird/examples/employee.fdb
user=sysdba
password=masterkey
password=rosivrepus
[dbf]
connector=dbf
name=/tmp
user=
password=
hostname=
[memds]
connector=memds

115
fcl/dbtests/dbftoolsunit.pas
View File

@ -8,53 +8,104 @@ interface
uses
Classes, SysUtils, toolsunit,
db,
Dbf, dbf_fields;
db, Dbf;
type
{ TDBFDBConnector }
{ TDBFDBConnector }
TDBFDBConnector = class(TDBConnector)
private
protected
Function CreateNDataset(n : integer) : TDataset; override;
Procedure FreeNDataset(var ds : TDataset); override;
public
destructor Destroy; override;
end;
TDBFDBConnector = class(TDBConnector)
protected
procedure CreateNDatasets; override;
procedure CreateFieldDataset; override;
procedure DropNDatasets; override;
procedure DropFieldDataset; override;
Function InternalGetNDataset(n : integer) : TDataset; override;
Function InternalGetFieldDataset : TDataSet; override;
end;
implementation
destructor TDBFDBConnector.Destroy;
procedure TDBFDBConnector.CreateNDatasets;
var countID,n : integer;
begin
inherited Destroy;
for n := 0 to MaxDataSet do
begin
with TDbf.Create(nil) do
begin
FilePath := dbname;
TableName := 'fpdev_'+inttostr(n)+'.db';
FieldDefs.Add('ID',ftInteger);
FieldDefs.Add('NAME',ftString,50);
CreateTable;
Open;
if n > 0 then for countId := 1 to n do
begin
Append;
FieldByName('ID').AsInteger := countID;
FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
end;
if state = dsinsert then
Post;
Close;
Free;
end;
end;
end;
function TDBFDBConnector.CreateNDataset(n: integer): TDataset;
var countID : integer;
procedure TDBFDBConnector.CreateFieldDataset;
var i : integer;
begin
with TDbf.Create(nil) do
begin
FilePath := dbname;
TableName := 'fpdev_'+inttostr(n)+'.db';
TableName := 'fpdev_field.db';
FieldDefs.Add('ID',ftInteger);
FieldDefs.Add('NAME',ftString,50);
FieldDefs.Add('FSTRING',ftString,10);
FieldDefs.Add('FSMALLINT',ftSmallint);
FieldDefs.Add('FINTEGER',ftInteger);
// FieldDefs.Add('FWORD',ftWord);
FieldDefs.Add('FBOOLEAN',ftBoolean);
FieldDefs.Add('FFLOAT',ftFloat);
// FieldDefs.Add('FCURRENCY',ftCurrency);
// FieldDefs.Add('FBCD',ftBCD);
FieldDefs.Add('FDATE',ftDate);
// FieldDefs.Add('FTIME',ftTime);
FieldDefs.Add('FDATETIME',ftDateTime);
FieldDefs.Add('FLARGEINT',ftLargeint);
CreateTable;
Open;
for countId := 1 to n do
for i := 0 to testValuesCount-1 do
begin
Append;
FieldByName('ID').AsInteger := countID;
FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
end;
if state = dsinsert then
FieldByName('ID').AsInteger := i;
FieldByName('FSTRING').AsString := testStringValues[i];
FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
FieldByName('FINTEGER').AsInteger := testIntValues[i];
FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
FieldByName('FFLOAT').AsFloat := testFloatValues[i];
ShortDateFormat := 'yyyy-mm-dd';
FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i]);
FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
Post;
end;
Close;
Free;
end;
// A dataset that has been opened and closed can't be used. Or else the tests
// for a newly generated dataset can't work properly.
end;
procedure TDBFDBConnector.DropNDatasets;
var n : integer;
begin
for n := 0 to MaxDataSet do
DeleteFile(ExtractFilePath(dbname)+PathDelim+'fpdev_'+inttostr(n)+'.db');
end;
procedure TDBFDBConnector.DropFieldDataset;
begin
DeleteFile(ExtractFilePath(dbname)+PathDelim+'fpdev_field.db');
end;
function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
begin
Result := TDbf.Create(nil);
with (result as TDbf) do
begin
@ -63,11 +114,17 @@ begin
end;
end;
procedure TDBFDBConnector.FreeNDataset(var ds: TDataset);
function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
begin
if ds.Active then ds.close;
FreeAndNil(ds);
Result := TDbf.Create(nil);
with (result as TDbf) do
begin
FilePath := dbname;
TableName := 'fpdev_field.db';
end;
end;
initialization
RegisterClass(TDBFDBConnector);
end.

116
fcl/dbtests/memdstoolsunit.pas Normal file
View File

@ -0,0 +1,116 @@
unit MemDSToolsUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, toolsunit,
db,
Memds;
type
{ TMemDSConnector }
TMemDSDBConnector = class(TDBConnector)
protected
procedure CreateNDatasets; override;
procedure CreateFieldDataset; override;
procedure DropNDatasets; override;
procedure DropFieldDataset; override;
Function InternalGetNDataset(n : integer) : TDataset; override;
Function InternalGetFieldDataset : TDataSet; override;
end;
implementation
{ TMemDSDBConnector }
procedure TMemDSDBConnector.CreateNDatasets;
begin
// All datasets only exist in memory, so nothing has to be done
end;
procedure TMemDSDBConnector.CreateFieldDataset;
begin
// All datasets only exist in memory, so nothing has to be done
end;
procedure TMemDSDBConnector.DropNDatasets;
begin
// All datasets only exist in memory, so nothing has to be done
end;
procedure TMemDSDBConnector.DropFieldDataset;
begin
// All datasets only exist in memory, so nothing has to be done
end;
function TMemDSDBConnector.InternalGetNDataset(n: integer): TDataset;
var MemDS : TMemDataset;
i : integer;
begin
MemDs := TMemDataset.Create(nil);
MemDS.FieldDefs.Add('ID',ftInteger);
MemDS.FieldDefs.Add('NAME',ftString,50);
MemDS.CreateTable;
MemDS.Open;
for i := 1 to n do
begin
memds.Append;
memds.FieldByName('ID').AsInteger := i;
memds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
MemDS.Post;
end;
MemDS.Close;
Result := MemDS;
end;
function TMemDSDBConnector.InternalGetFieldDataset : TDataSet;
var MemDS : TMemDataset;
i : integer;
begin
MemDs := TMemDataset.Create(nil);
with MemDS do
begin
FieldDefs.Add('ID',ftInteger);
FieldDefs.Add('FSTRING',ftString,10);
FieldDefs.Add('FSMALLINT',ftSmallint);
FieldDefs.Add('FINTEGER',ftInteger);
// FieldDefs.Add('FWORD',ftWord);
FieldDefs.Add('FBOOLEAN',ftBoolean);
FieldDefs.Add('FFLOAT',ftFloat);
// FieldDefs.Add('FCURRENCY',ftCurrency);
// FieldDefs.Add('FBCD',ftBCD);
FieldDefs.Add('FDATE',ftDate);
FieldDefs.Add('FTIME',ftTime);
FieldDefs.Add('FDATETIME',ftDateTime);
FieldDefs.Add('FLARGEINT',ftLargeint);
CreateTable;
Open;
for i := 0 to testValuesCount-1 do
begin
Append;
FieldByName('ID').AsInteger := i;
FieldByName('FSTRING').AsString := testStringValues[i];
FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
FieldByName('FINTEGER').AsInteger := testIntValues[i];
FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
FieldByName('FFLOAT').AsFloat := testFloatValues[i];
ShortDateFormat := 'yyyy-mm-dd';
FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i]);
FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
Post;
end;
Close;
end;
Result := MemDS;
end;
initialization
RegisterClass(TMemDSDBConnector);
end.

6
fcl/dbtests/settings.inc
View File

@ -1,6 +0,0 @@
{$IFDEF fpc}
{$define SQLDB_AVAILABLE}
{$define DBF_AVAILABLE}
{$ELSE}
{$DEFINE DBF_AVAILABLE}
{$ENDIF}

210
fcl/dbtests/sqldbtoolsunit.pas
View File

@ -9,44 +9,56 @@ uses
db,
sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection;
const SQLDBdbTypes = [mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle];
MySQLdbTypes = [mysql40,mysql41,mysql50];
type TSQLDBTypes = (mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle);
const MySQLdbTypes = [mysql40,mysql41,mysql50];
DBTypesNames : Array [TSQLDBTypes] of String[19] =
('MYSQL40','MYSQL41','MYSQL50','POSTGRESQL','INTERBASE','ODBC','ORACLE');
type
{ TSQLDBConnector }
TSQLDBConnector = class(TDBConnector)
FConnection : TSQLConnection;
FTransaction : TSQLTransaction;
FQuery : TSQLQuery;
private
procedure CreateFConnection;
procedure CreateFTransaction;
Function CreateQuery : TSQLQuery;
protected
procedure CreateNDatasets; override;
procedure CreateFieldDataset; override;
procedure DropNDatasets; override;
procedure DropFieldDataset; override;
Function InternalGetNDataset(n : integer) : TDataset; override;
Function InternalGetFieldDataset : TDataSet; override;
public
destructor Destroy; override;
constructor Create; override;
property Connection : TSQLConnection read FConnection;
property Transaction : TSQLTransaction read FTransaction;
property Query : TSQLQuery read FQuery;
end;
TSQLDBConnector = class(TDBConnector)
FConnection : TSQLConnection;
FTransaction : TSQLTransaction;
FQuery : TSQLQuery;
private
procedure CreateFConnection;
procedure CreateFTransaction;
Function CreateQuery : TSQLQuery;
protected
Procedure FreeNDataset(var ds : TDataset); override;
Function CreateNDataset(n : integer) : TDataset; override;
public
destructor Destroy; override;
constructor Create;
property Connection : TSQLConnection read FConnection;
property Transaction : TSQLTransaction read FTransaction;
property Query : TSQLQuery read FQuery;
end;
var SQLDbType : TSQLDBTypes;
implementation
procedure TSQLDBConnector.CreateFConnection;
{ TSQLDBConnector }
procedure TSQLDBConnector.CreateFConnection;
var i : TSQLDBTypes;
begin
if dbtype = mysql40 then Fconnection := tMySQL40Connection.Create(nil);
if dbtype = mysql41 then Fconnection := tMySQL41Connection.Create(nil);
if dbtype = mysql50 then Fconnection := tMySQL50Connection.Create(nil);
if dbtype = postgresql then Fconnection := tpqConnection.Create(nil);
if dbtype = interbase then Fconnection := tIBConnection.Create(nil);
if dbtype = odbc then Fconnection := tODBCConnection.Create(nil);
if dbtype = oracle then Fconnection := TOracleConnection.Create(nil);
for i := low(DBTypesNames) to high(DBTypesNames) do
if UpperCase(dbconnectorparams) = DBTypesNames[i] then sqldbtype := i;
if SQLDbType = MYSQL40 then Fconnection := tMySQL40Connection.Create(nil);
if SQLDbType = MYSQL41 then Fconnection := tMySQL41Connection.Create(nil);
if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
if SQLDbType = POSTGRESQL then Fconnection := tpqConnection.Create(nil);
if SQLDbType = INTERBASE then Fconnection := tIBConnection.Create(nil);
if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
if not assigned(Fconnection) then writeln('Invalid database-type, check if a valid database-type was provided in the file ''database.ini''');
@ -60,8 +72,6 @@ begin
end;
end;
{ TSQLDBConnector }
procedure TSQLDBConnector.CreateFTransaction;
begin
@ -81,51 +91,20 @@ begin
end;
end;
destructor TSQLDBConnector.Destroy;
procedure TSQLDBConnector.CreateNDatasets;
var CountID : Integer;
begin
try
if Ftransaction.Active then Ftransaction.Rollback;
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('DROP TABLE FPDEV');
Ftransaction.Commit;
Except
if Ftransaction.Active then Ftransaction.Rollback
end;
try
if Ftransaction.Active then Ftransaction.Rollback;
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('DROP TABLE FPDEV2');
Ftransaction.Commit;
Except
if Ftransaction.Active then Ftransaction.Rollback
end;
FreeAndNil(FQuery);
FreeAndNil(FTransaction);
FreeAndNil(FConnection);
inherited Destroy;
end;
constructor TSQLDBConnector.Create;
var countID : integer;
begin
CreateFConnection;
CreateFTransaction;
FQuery := CreateQuery;
FConnection.Transaction := FTransaction;
try
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('create table FPDEV ( ' +
' ID INT NOT NULL, ' +
' NAME VARCHAR(50) ' +
' NAME VARCHAR(50), ' +
' PRIMARY KEY (ID) ' +
') ');
FTransaction.CommitRetaining;
for countID := 1 to 35 do
for countID := 1 to MaxDataSet do
Fconnection.ExecuteDirect('insert into FPDEV (ID,NAME)' +
'values ('+inttostr(countID)+',''TestName'+inttostr(countID)+''')');
@ -135,21 +114,104 @@ begin
end;
end;
function TSQLDBConnector.CreateNDataset(n: integer): TDataset;
procedure TSQLDBConnector.CreateFieldDataset;
var CountID : Integer;
begin
result := CreateQuery;
with result as TSQLQuery do
try
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('create table FPDEV_FIELD ( ' +
' ID INT NOT NULL, ' +
' FSTRING VARCHAR(10), ' +
' FINTEGER INT, ' +
' FDATE DATE, ' +
' FDATETIME TIMESTAMP, ' +
' PRIMARY KEY (ID) ' +
') ');
FTransaction.CommitRetaining;
for countID := 0 to testValuesCount-1 do
Fconnection.ExecuteDirect('insert into FPDEV_FIELD (ID,FSTRING,FINTEGER,FDATE,FDATETIME)' +
'values ('+inttostr(countID)+','''+testStringValues[CountID]+''','''+inttostr(testIntValues[CountID])+''','''+testDateValues[CountID]+''','''+testDateValues[CountID]+''')');
Ftransaction.Commit;
except
if Ftransaction.Active then Ftransaction.Rollback
end;
end;
procedure TSQLDBConnector.DropNDatasets;
begin
try
if Ftransaction.Active then Ftransaction.Rollback;
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('DROP TABLE FPDEV');
Ftransaction.Commit;
Except
if Ftransaction.Active then Ftransaction.Rollback
end;
end;
procedure TSQLDBConnector.DropFieldDataset;
begin
try
if Ftransaction.Active then Ftransaction.Rollback;
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('DROP TABLE FPDEV_FIELD');
Ftransaction.Commit;
Except
if Ftransaction.Active then Ftransaction.Rollback
end;
end;
function TSQLDBConnector.InternalGetNDataset(n: integer): TDataset;
begin
Result := CreateQuery;
with (Result as TSQLQuery) do
begin
sql.clear;
sql.add('SELECT ID,NAME FROM FPDEV WHERE ID<'+inttostr(n+1));
sql.add('SELECT * FROM FPDEV WHERE ID < '+inttostr(n+1));
end;
end;
procedure TSQLDBConnector.FreeNDataset(var ds: TDataset);
function TSQLDBConnector.InternalGetFieldDataset: TDataSet;
begin
if ds.active then ds.Close;
FreeAndNil(ds);
Result := CreateQuery;
with (Result as TSQLQuery) do
begin
sql.clear;
sql.add('SELECT * FROM FPDEV_FIELD');
end;
end;
destructor TSQLDBConnector.Destroy;
begin
try
if Ftransaction.Active then Ftransaction.Rollback;
Ftransaction.StartTransaction;
Fconnection.ExecuteDirect('DROP TABLE FPDEV2');
Ftransaction.Commit;
Except
if Ftransaction.Active then Ftransaction.Rollback
end;
inherited Destroy;
FreeAndNil(FQuery);
FreeAndNil(FTransaction);
FreeAndNil(FConnection);
end;
constructor TSQLDBConnector.Create;
begin
FConnection := nil;
CreateFConnection;
CreateFTransaction;
FQuery := CreateQuery;
FConnection.Transaction := FTransaction;
Inherited;
end;
initialization
RegisterClass(TSQLDBConnector);
end.

398
fcl/dbtests/testdbbasics.pas
View File

@ -1,28 +1,40 @@
unit TestDBBasics;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$mode Delphi}{$H+}
{$ENDIF}
interface
uses
fpcunit, testutils, testregistry, testdecorator,
Classes, SysUtils;
Classes, SysUtils, db;
type
{ TTestSQLMechanism }
{ TTestDBBasics }
TTestDBBasics = class(TTestCase)
private
procedure TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestSupportIntegerFields;
procedure TestSupportSmallIntFields;
procedure TestSupportStringFields;
procedure TestSupportBooleanFields;
procedure TestSupportFloatFields;
procedure TestSupportLargeIntFields;
procedure TestSupportDateFields;
procedure TestIsEmpty;
procedure TestAppendOnEmptyDataset;
procedure TestInsertOnEmptyDataset;
procedure TestBufDatasetCancelUpdates; //bug 6938
procedure TestEofAfterFirst; //bug 7211
procedure TestBufDatasetCancelUpdates1;
procedure TestDoubleClose;
procedure TestAssignFieldftString;
@ -44,14 +56,65 @@ type
TDBBasicsTestSetup = class(TTestSetup)
protected
procedure OneTimeSetup; override;
procedure OneTimeTearDown; override;
end;
implementation
uses db, toolsunit;
uses toolsunit, bufdataset;
procedure TTestDBBasics.TestIsEmpty;
begin
if not (DBConnector.GetNDataset(5) is TBufDataset) then
Ignore('This test only applies to TBufDataset and descendents.');
with tbufdataset(DBConnector.GetNDataset(True,1)) do
begin
open;
delete;
refresh;
applyupdates;
AssertTrue(IsEmpty);
end;
end;
procedure TTestDBBasics.TestAppendOnEmptyDataset;
begin
with DBConnector.GetNDataset(0) do
begin
open;
AssertTrue(CanModify);
AssertTrue(eof);
AssertTrue(bof);
append;
AssertFalse(Bof);
AssertTrue(Eof);
post;
AssertFalse(eof);
AssertFalse(bof);
end;
end;
procedure TTestDBBasics.TestInsertOnEmptyDataset;
begin
with DBConnector.GetNDataset(0) do
begin
open;
AssertTrue(CanModify);
AssertTrue(eof);
AssertTrue(bof);
AssertTrue(IsEmpty);
insert;
AssertTrue(Bof);
AssertTrue(Eof);
AssertFalse(IsEmpty);
post;
AssertFalse(IsEmpty);
AssertFalse(eof);
AssertFalse(bof);
end;
end;
procedure TTestDBBasics.TestSelectQueryBasics;
var b : TFieldType;
@ -66,11 +129,11 @@ begin
AssertEquals(2,FieldCount);
AssertTrue(CompareText('ID',fields[0].FieldName)=0);
AssertTrue(CompareText('ID',fields[0].DisplayName)=0); // uitzoeken verschil displaylabel
AssertTrue(CompareText('ID',fields[0].DisplayName)=0);
AssertTrue('The datatype of the field ''ID'' is incorrect, it should be ftInteger',ftInteger=fields[0].DataType);
AssertTrue(CompareText('NAME',fields[1].FieldName)=0);
AssertTrue(CompareText('NAME',fields[1].DisplayName)=0); // uitzoeken verschil displaylabel
AssertTrue(CompareText('NAME',fields[1].DisplayName)=0);
AssertTrue(ftString=fields[1].DataType);
AssertEquals(1,fields[0].Value);
@ -85,11 +148,7 @@ begin
with DBConnector.GetNDataset(1) do
begin
open;
{$IFDEF FPC}
AssertException('Post was called in a non-edit state',EDatabaseError,@Post);
{$ELSE}
AssertException('Post was called in a non-edit state',EDatabaseError,Post);
{$ENDIF}
end;
end;
@ -106,30 +165,33 @@ begin
ABufferCount := 11;
aDatalink.BufferCount := ABufferCount;
DataEvents := '';
for count := 0 to 32 do with DBConnector.GetNDataset(count) do
for count := 0 to 32 do
begin
aDatasource.DataSet := DBConnector.GetNDataset(count);
i := 1;
Open;
AssertEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
while not EOF do
with aDatasource.Dataset do
begin
AssertEquals(i,fields[0].AsInteger);
AssertEquals('TestName'+inttostr(i),fields[1].AsString);
inc(i);
i := 1;
Open;
AssertEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
while not EOF do
begin
AssertEquals(i,fields[0].AsInteger);
AssertEquals('TestName'+inttostr(i),fields[1].AsString);
inc(i);
Next;
if (i > ABufferCount) and not EOF then
AssertEquals('deCheckBrowseMode:0;deDataSetScroll:-1;',DataEvents)
else
AssertEquals('deCheckBrowseMode:0;deDataSetScroll:0;',DataEvents);
Next;
if (i > ABufferCount) and not EOF then
AssertEquals('deCheckBrowseMode:0;deDataSetScroll:-1;',DataEvents)
else
AssertEquals('deCheckBrowseMode:0;deDataSetScroll:0;',DataEvents);
DataEvents := '';
end;
AssertEquals(count,i-1);
close;
AssertEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
end;
AssertEquals(count,i-1);
close;
AssertEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
end;
end;
@ -138,14 +200,16 @@ procedure TTestDBBasics.TestdeFieldListChange;
var i,count : integer;
aDatasource : TDataSource;
aDatalink : TDataLink;
ds : TDataset;
begin
aDatasource := TDataSource.Create(nil);
aDatalink := TTestDataLink.Create;
aDatalink.DataSource := aDatasource;
with DBConnector.GetNDataset(1) do
ds := DBConnector.GetNDataset(1);
with ds do
begin
aDatasource.DataSet := DBConnector.GetNDataset(1);
aDatasource.DataSet := ds;
DataEvents := '';
open;
Fields.add(tfield.Create(DBConnector.GetNDataset(1)));
@ -163,9 +227,7 @@ procedure TTestDBBasics.TestActiveBufferWhenClosed;
begin
with DBConnector.GetNDataset(0) do
begin
{$IFDEF fpc}
AssertNull(ActiveBuffer);
{$ENDIF}
open;
AssertFalse('Activebuffer of an empty dataset shouldn''t be nil',ActiveBuffer = nil);
end;
@ -195,12 +257,11 @@ begin
aDatalink := TTestDataLink.Create;
aDatalink.DataSource := aDatasource;
ds := DBConnector.GetNDataset(6);
ds.BeforeScroll := @DBConnector.DataEvent;
ds.BeforeScroll := DBConnector.DataEvent;
with ds do
begin
aDatasource.DataSet := ds;
open;
// first;
DataEvents := '';
Resync([rmExact]);
AssertEquals('deDataSetChange:0;',DataEvents);
@ -213,8 +274,6 @@ begin
aDatalink.Free;
end;
procedure TTestDBBasics.TestLastAppendCancel;
var count : integer;
@ -234,15 +293,39 @@ begin
Close;
end;
end;
procedure TTestDBBasics.TestRecNo;
var i : longint;
passed : boolean;
begin
with DBConnector.GetNDataset(0) do
begin
AssertEquals('Failed to get the RecNo from a closed dataset',0,RecNo);
AssertEquals(0,RecordCount);
// Accessing RecNo on a closed dataset should raise an EDatabaseError or should
// return 0
passed := false;
try
i := recno;
except on E: Exception do
begin
passed := E.classname = EDatabaseError.className
end;
end;
if not passed then
AssertEquals('Failed to get the RecNo from a closed dataset',0,RecNo);
// Accessing Recordcount on a closed dataset should raise an EDatabaseError or should
// return 0
passed := false;
try
i := recordcount;
except on E: Exception do
begin
passed := E.classname = EDatabaseError.className
end;
end;
if not passed then
AssertEquals('Failed to get the Recordcount from a closed dataset',0,RecNo);
Open;
@ -332,13 +415,160 @@ end;
procedure TTestDBBasics.SetUp;
begin
DBConnector.InitialiseDatasets;
DBConnector.StartTest;
end;
procedure TTestDBBasics.TearDown;
var count : integer;
begin
DBConnector.FreeDatasets;
DBConnector.StopTest;
end;
procedure TTestDBBasics.TestEofAfterFirst;
begin
with DBConnector.GetNDataset(0) do
begin
open;
AssertTrue(eof);
AssertTrue(BOF);
first;
AssertTrue(eof);
AssertTrue(BOF);
end;
end;
procedure TTestDBBasics.TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
var i : byte;
begin
ADS := DBConnector.GetFieldDataset;
ADS.Open;
AFld := ADS.FindField('F'+FieldTypeNames[AfieldType]);
AssertNotNull('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset',AFld);
AssertTrue(Afld.DataType = AFieldType);
AssertEquals(ADatasize,Afld.DataSize );
end;
procedure TTestDBBasics.TestSupportIntegerFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftInteger,4,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testIntValues[i],Fld.AsInteger);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportSmallIntFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftSmallint,2,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testSmallIntValues[i],Fld.AsInteger);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportStringFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftString,11,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testStringValues[i],Fld.AsString);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportBooleanFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftBoolean,2,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testBooleanValues[i],Fld.AsBoolean);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportFloatFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftFloat,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testFloatValues[i],Fld.AsFloat);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportLargeIntFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftLargeint,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testLargeIntValues[i],Fld.AsLargeInt);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportDateFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftDate,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',Fld.AsDateTime));
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestDoubleClose;
@ -363,9 +593,8 @@ begin
begin
open;
AField := fieldbyname('name');
(AField as tstringfield).FixedChar := true;
AParam.AssignField(AField);
AssertTrue(ftFixedChar=AParam.DataType);
AssertTrue(ftString=AParam.DataType);
close;
end;
AParam.Free;
@ -391,7 +620,8 @@ end;
procedure TTestDBBasics.TestBufDatasetCancelUpdates;
var i : byte;
begin
AssertTrue(SIgnoreAssertion,DBConnector.GetNDataset(5) is TBufDataset);
if not (DBConnector.GetNDataset(5) is TBufDataset) then
Ignore('This test only applies to TBufDataset and descendents.');
with DBConnector.GetNDataset(5) as TBufDataset do
begin
open;
@ -420,54 +650,54 @@ end;
procedure TTestDBBasics.Testbug7007;
var
datalink1: tdatalink;
datasource1: tdatasource;
query1: TDataSet;
datalink1: tdatalink;
datasource1: tdatasource;
query1: TDataSet;
begin
query1:= DBConnector.GetNDataset(6);
datalink1:= TTestDataLink.create;
datasource1:= tdatasource.create(nil);
try
datalink1.datasource:= datasource1;
datasource1.dataset:= query1;
datalink1.datasource:= datasource1;
query1:= DBConnector.GetNDataset(6);
datalink1:= TTestDataLink.create;
datasource1:= tdatasource.create(nil);
try
datalink1.datasource:= datasource1;
datasource1.dataset:= query1;
datalink1.datasource:= datasource1;
DataEvents := '';
query1.open;
datalink1.buffercount:= query1.recordcount;
AssertEquals('deUpdateState:0;',DataEvents);
AssertEquals(0, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertEquals(1, query1.RecNo);
DataEvents := '';
query1.open;
datalink1.buffercount:= query1.recordcount;
AssertEquals('deUpdateState:0;',DataEvents);
AssertEquals(0, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertEquals(1, query1.RecNo);
DataEvents := '';
query1.append;
AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
AssertEquals(5, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertEquals(0, query1.RecNo);
DataEvents := '';
query1.append;
AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
AssertEquals(5, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertTrue(query1.RecNo in [0,7]);
DataEvents := '';
query1.cancel;
AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
AssertEquals(5, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertEquals(6, query1.RecNo);
DataEvents := '';
query1.cancel;
AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
AssertEquals(5, datalink1.ActiveRecord);
AssertEquals(6, datalink1.RecordCount);
AssertEquals(6, query1.RecordCount);
AssertEquals(6, query1.RecNo);
finally
datalink1.free;
datasource1.free;
end;
datalink1.free;
datasource1.free;
end;
end;
procedure TTestDBBasics.TestBufDatasetCancelUpdates1;
var i : byte;
begin
AssertTrue(SIgnoreAssertion,DBConnector.GetNDataset(5) is TBufDataset);
if not (DBConnector.GetNDataset(5) is TBufDataset) then
Ignore('This test only applies to TBufDataset and descendents.');
with DBConnector.GetNDataset(5) as TBufDataset do
begin
open;

372
fcl/dbtests/testsqlfieldtypes.pas
View File

@ -1,4 +1,4 @@
unit TestSQLFieldTypes;
unit TestSQLFieldTypes;
{$mode objfpc}{$H+}
@ -10,21 +10,38 @@ uses
type
TParamProc = procedure(AParam:TParam; i : integer);
TFieldProc = procedure(AField:TField; i : integer);
{ TTestFieldTypes }
TTestFieldTypes= class(TTestCase)
private
procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer);
protected
procedure SetUp; override;
procedure TearDown; override;
procedure RunTest; override;
published
procedure TestInt;
procedure TestScript;
procedure TestParametersAndDates;
procedure TestExceptionOnsecondClose;
procedure TestBlob;
procedure TestChangeBlob;
procedure TestLargeRecordSize;
procedure TestNumeric;
procedure TestFloat;
procedure TestDateTime; // bug 6925
procedure TestNumeric;
procedure TestString;
procedure TestUnlVarChar;
procedure TestDate;
@ -32,18 +49,89 @@ type
procedure TestNullValues;
procedure TestParamQuery;
procedure TestStringParamQuery;
procedure TestDateParamQuery;
procedure TestIntParamQuery;
procedure TestFloatParamQuery;
published
procedure TestAggregates;
end;
implementation
uses sqldbtoolsunit,toolsunit, variants;
procedure TTestFieldTypes.TestInt;
uses sqldbtoolsunit,toolsunit, variants, sqldb;
const
testValuesCount = 17;
testValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
testFloatValuesCount = 21;
testFloatValues : Array[0..testFloatValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
testIntValuesCount = 17;
testIntValues : Array[0..testIntValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
testStringValuesCount = 20;
testStringValues : Array[0..testStringValuesCount-1] of string = (
'',
'a',
'ab',
'abc',
'abcd',
'abcde',
'abcdef',
'abcdefg',
'abcdefgh',
'abcdefghi',
'abcdefghij',
'lMnOpQrStU',
'1234567890',
'_!@#$%^&*(',
' ''quotes'' ',
')-;:/?.<>',
'~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
' WRaP ',
'wRaP ',
' wRAP'
);
testDateValuesCount = 18;
testDateValues : Array[0..testDateValuesCount-1] of string = (
'2000-01-01',
'1999-12-31',
'2004-02-29',
'2004-03-01',
'1991-02-28',
'1991-03-01',
'2040-10-16',
'1977-09-29',
'1800-03-30',
'1650-05-10',
'1754-06-04',
'0904-04-12',
'0199-07-09',
'0001-01-01',
'1899-12-29',
'1899-12-30',
'1899-12-31',
'1900-01-01'
);
procedure TTestFieldTypes.TestScript;
var Ascript : TSQLScript;
begin
Ascript := tsqlscript.create(nil);
with Ascript do
begin
DataBase := TSQLDBConnector(DBConnector).Connection;
transaction := TSQLDBConnector(DBConnector).Transaction;
script.clear;
script.append('create table a (id int);');
script.append('create table b (id int);');
ExecuteScript;
end;
end;
procedure TTestFieldTypes.TestInt;
var
i : byte;
@ -52,21 +140,48 @@ begin
CreateTableWithFieldType(ftInteger,'INT');
TestFieldDeclaration(ftInteger,4);
for i := 0 to testValuesCount-1 do
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testValues[i]) + ')');
for i := 0 to testIntValuesCount-1 do
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
with TSQLDBConnector(DBConnector).Query do
begin
Open;
for i := 0 to testValuesCount-1 do
for i := 0 to testIntValuesCount-1 do
begin
AssertEquals(testValues[i],fields[0].AsInteger);
AssertEquals(testIntValues[i],fields[0].AsInteger);
Next;
end;
close;
end;
end;
procedure TTestFieldTypes.TestLargeRecordSize;
var
i : byte;
begin
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
if UpperCase(dbconnectorparams)='INTERBASE' then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
with TSQLDBConnector(DBConnector).Query do
begin
sql.clear;
sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVR￿INA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
ExecSQL;
sql.clear;
sql.append('select * from FPDEV2');
open;
AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
close;
end;
end;
procedure TTestFieldTypes.TestNumeric;
const
@ -137,7 +252,7 @@ begin
Open;
for i := 0 to testValuesCount-1 do
begin
if (dbtype in MySQLdbTypes) then
if (SQLDbType in MySQLdbTypes) then
AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL automatically trims strings
else
AssertEquals(testValues[i],fields[0].AsString);
@ -180,7 +295,7 @@ var
i : byte;
begin
AssertTrue(SIgnoreAssertion,dbtype = postgresql); // Only postgres accept this type-definition
// AssertTrue(SIgnoreAssertion,SQLDbType = postgresql); // Only postgres accept this type-definition
CreateTableWithFieldType(ftString,'VARCHAR');
TestFieldDeclaration(ftString,dsMaxStringSize+1);
@ -201,29 +316,6 @@ end;
procedure TTestFieldTypes.TestDate;
const
testValuesCount = 18;
testValues : Array[0..testValuesCount-1] of string = (
'2000-01-01',
'1999-12-31',
'2004-02-29',
'2004-03-01',
'1991-02-28',
'1991-03-01',
'2040-10-16',
'1977-09-29',
'1800-03-30',
'1650-05-10',
'1754-06-04',
'0904-04-12',
'0199-07-09',
'0001-01-01',
'1899-12-29',
'1899-12-30',
'1899-12-31',
'1900-01-01'
);
var
i : byte;
@ -231,20 +323,20 @@ begin
CreateTableWithFieldType(ftDate,'DATE');
TestFieldDeclaration(ftDate,8);
for i := 0 to testValuesCount-1 do
if dbtype=oracle then
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD''))')
for i := 0 to testDateValuesCount-1 do
if SQLDbType=oracle then
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testDateValues[i] + ''',''YYYY-MM-DD''))')
else
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testDateValues[i] + ''')');
// TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
with TSQLDBConnector(DBConnector).Query do
begin
Open;
for i := 0 to testValuesCount-1 do
for i := 0 to testDateValuesCount-1 do
begin
AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime));
AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime));
Next;
end;
close;
@ -252,6 +344,74 @@ begin
end;
procedure TTestFieldTypes.TestChangeBlob;
var s : string;
begin
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT blob)');
TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For interbase
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
with TSQLDBConnector(DBConnector).Query do
begin
sql.clear;
sql.add('select * from FPDEV2');
Open;
fields[1].ProviderFlags := [pfInUpdate]; // blob niet in de where
UpdateMode := upWhereAll;
AssertEquals('Test deze blob',fields[1].AsString);
edit;
// Dat werkt niet lekker, omdat de stream vernield wordt...
// fields[0].asstring := 'Deze blob is gewijzigd!';
With Createblobstream(fields[1],bmwrite) do
begin
s := 'Deze blob is gewijzigd!';
WriteBuffer(Pointer(s)^,Length(s));
post;
free;
end;
AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
ApplyUpdates(0);
TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
close;
open;
AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
close;
end;
end;
procedure TTestFieldTypes.TestBlob;
var
i : byte;
begin
// CreateTableWithFieldType(ftBlob,'BLOB');
CreateTableWithFieldType(ftBlob,'TEXT');
TestFieldDeclaration(ftBlob,0);
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
// TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
with TSQLDBConnector(DBConnector).Query do
begin
Open;
AssertEquals('Test deze blob',fields[0].AsString);
close;
end;
end;
procedure TTestFieldTypes.TestDateTime;
const
@ -297,11 +457,11 @@ begin
CreateTableWithFieldType(ftDateTime,'TIMESTAMP');
TestFieldDeclaration(ftDateTime,8);
if dbtype=mysql40 then corrTestValueCount := testValuesCount-21
if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
else corrTestValueCount := testValuesCount;
for i := 0 to corrTestValueCount-1 do
if dbtype=oracle then
if SQLDbType=oracle then
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
else
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
@ -444,50 +604,59 @@ begin
end;
procedure TTestFieldTypes.TestIntParamQuery;
begin
TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
end;
procedure TTestFieldTypes.TestFloatParamQuery;
begin
TestXXParamQuery(ftFloat,'FLOAT',testFloatValuesCount);
end;
procedure TTestFieldTypes.TestStringParamQuery;
const
testValuesCount = 20;
testValues : Array[0..testValuesCount-1] of string = (
'',
'a',
'ab',
'abc',
'abcd',
'abcde',
'abcdef',
'abcdefg',
'abcdefgh',
'abcdefghi',
'abcdefghij',
'lMnOpQrStU',
'1234567890',
'_!@#$%^&*(',
' ''quotes'' ',
')-;:/?.<>',
'~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
' WRaP ',
'wRaP ',
' wRAP'
);
begin
TestXXParamQuery(ftString,'VARCHAR(10)',testStringValuesCount);
end;
procedure TTestFieldTypes.TestDateParamQuery;
begin
TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
end;
procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer);
var i : integer;
begin
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 VARCHAR(10))');
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
with TSQLDBConnector(DBConnector).Query do
begin
sql.clear;
sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
ShortDateFormat := 'yyyy-mm-dd';
for i := 0 to testValuesCount -1 do
begin
Params.ParamByName('id').AsInteger := i;
Params.ParamByName('field1').AsString := testValues[i];
case ADataType of
ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
ftFloat : Params.ParamByName('field1').AsFloat := testFloatValues[i];
ftString : Params.ParamByName('field1').AsString := testStringValues[i];
ftDate : Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i]);
else
AssertTrue('no test for paramtype available',False);
end;
ExecSQL;
end;
TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
@ -499,7 +668,14 @@ begin
for i := 0 to testValuesCount -1 do
begin
AssertEquals(i,FieldByName('ID').AsInteger);
AssertEquals(testValues[i],FieldByName('FIELD1').AsString);
case ADataType of
ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
ftFloat : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
ftdate : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime));
else
AssertTrue('no test for paramtype available',False);
end;
Next;
end;
close;
@ -584,11 +760,57 @@ end;
procedure TTestFieldTypes.RunTest;
begin
if (dbtype in SQLDBdbTypes) then
// if (SQLDbType in TSQLDBTypes) then
inherited RunTest;
end;
procedure TTestFieldTypes.TestParametersAndDates;
begin
with TSQLDBConnector(DBConnector).Query do
begin
SQL.Clear;
sql.add('select now()::date as current_date where 1=1');
open;
first;
writeln(fields[0].asstring); // return the correct date
close;
sql.clear;
sql.add('select now()::date as current_date where cast(1 as integer) = :PARAM1');
params.parambyname('PARAM1').asinteger:= 1;
open;
first;
writeln(fields[0].asstring); // return invalid date
close;
end
end;
procedure TTestFieldTypes.TestExceptionOnsecondClose;
begin
with TSQLDBConnector(DBConnector).Query do
begin
SQL.Clear;
SQL.Add('select * from FPDEV');
Open;
close;
SQL.Clear;
SQL.Add('select blaise from FPDEV');
{$IFDEF FPC}
// AssertException(EIBDatabaseError,@Open);
{$ELSE}
// AssertException(EIBDatabaseError,Open);
{$ENDIF}
Open;
Close;
end;
end;
initialization
if dbtype in SQLDBdbTypes then RegisterTest(TTestFieldTypes);
if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
end.

251
fcl/dbtests/toolsunit.pas
View File

@ -4,8 +4,6 @@ unit ToolsUnit;
{$mode objfpc}{$H+}
{$ENDIF}
{$I settings.inc}
interface
uses
@ -16,18 +14,47 @@ Const MaxDataSet = 35;
type
{ TDBConnector }
TDBConnector = class(TObject)
TDBConnectorClass = class of TDBConnector;
TDBConnector = class(TPersistent)
private
FDatasets : array[0..MaxDataset] of TDataset;
FChangedDatasets : array[0..MaxDataSet] of boolean;
FUsedDatasets : TFPList;
FChangedFieldDataset : boolean;
protected
Procedure FreeNDataset(var ds : TDataset); virtual; abstract;
Function CreateNDataset(n : integer) : TDataset; virtual; abstract;
// These methods should be implemented by any descendents
// They are called eacht time a test need a TDataset descendent
Function InternalGetNDataset(n : integer) : TDataset; virtual; abstract;
Function InternalGetFieldDataset : TDataSet; virtual; abstract;
// These methods should be implemented by any descendents
// They are called only once in the constructor. They can be used
// to create the tables on disk, or on a DB-Server
procedure CreateNDatasets; virtual; abstract;
procedure CreateFieldDataset; virtual; abstract;
// These methods are called after each test in which a dataset is used
// by calling GetXXXDataset with Achange=true
// They should reset all data to their right/initial values.
procedure ResetNDatasets; virtual;
procedure ResetFieldDataset; virtual;
// These methods are called only once in the destructor.
// They should clean up all mess, like tables on disk or on a DB-server
procedure DropNDatasets; virtual; abstract;
procedure DropFieldDataset; virtual; abstract;
public
constructor create; virtual;
destructor destroy; override;
procedure DataEvent(dataset :TDataset);
Function GetNDataset(n : integer) : TDataset; virtual;
procedure InitialiseDatasets; virtual;
procedure FreeDatasets; virtual;
Function GetNDataset(n : integer) : TDataset; overload;
Function GetNDataset(AChange : Boolean; n : integer) : TDataset; overload;
Function GetFieldDataset : TDataSet; overload;
Function GetFieldDataset(AChange : Boolean) : TDataSet; overload;
procedure StartTest;
procedure StopTest;
end;
@ -42,81 +69,160 @@ type
{$ENDIF}
end;
type TDBTypes=(mysql40,mysql41,mysql50,interbase,postgresql,odbc,oracle,dbf);
const
DBTypesNames : Array [TDBTypes] of String[19] =
('mysql40','mysql41','mysql50','interbase','postgresql','odbc','oracle','dbf');
DataEventnames : Array [TDataEvent] of String[19] =
('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
'deLayoutChange', 'deUpdateRecord', 'deUpdateState', 'deCheckBrowseMode',
'dePropertyChange', 'deFieldListChange', 'deFocusControl' ,'deParentScroll'
{$IFNDEF VER2_0_2}, 'deConnectChange','deReconcileError','deDisabledStateChange'{$ENDIF}
);
'dePropertyChange', 'deFieldListChange', 'deFocusControl' ,'deParentScroll',
'deConnectChange', 'deReconcileError', 'deDisabledStateChange');
var dbtype : TDBTypes;
const
testValuesCount = 25;
testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
testLargeIntValues : Array[0..testValuesCount-1] of smallint = (-MaxSIntValue,MaxSIntValue+1,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,MaxSIntValue-1,MaxSIntValue,235253244);
testBooleanValues : Array[0..testValuesCount-1] of boolean = (true,false,false,true,true,false,false,true,false,true,true,true,false,false,false,false,true,true,true,true,false,true,true,false,false);
testStringValues : Array[0..testValuesCount-1] of string = (
'',
'a',
'ab',
'abc',
'abcd',
'abcde',
'abcdef',
'abcdefg',
'abcdefgh',
'abcdefghi',
'abcdefghij',
'lMnOpQrStU',
'1234567890',
'_!@#$%^&*(',
'_!@#$%^&*(',
// ' ''quotes'' ',
')-;:/?.<>',
'~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
' WRaP ',
'wRaP ',
' wRAP',
'this',
'is',
'fun',
'VB7^',
'vdfbst'
);
testDateValues : Array[0..testValuesCount-1] of string = (
'2000-01-01',
'1999-12-31',
'2004-02-29',
'2004-03-01',
'1991-02-28',
'1991-03-01',
'2040-10-16',
'1977-09-29',
'1800-03-30',
'1650-05-10',
'1754-06-04',
'0904-04-12',
'0199-07-09',
'0001-01-01',
'0031-11-02',
'1899-12-29',
'1899-12-30',
'1899-12-31',
'1977-09-29',
'1917-12-29',
'0079-11-29',
'1997-11-29',
'0001-01-01',
'1997-11-29',
'1900-01-01'
);
var dbtype,
dbconnectorname,
dbconnectorparams,
dbname,
dbuser,
dbhostname,
dbpassword : string;
DBConnector : TDBConnector;
dbpassword : string;
DataEvents : string;
DBConnector : TDBConnector;
DataEvents : string;
procedure InitialiseDBConnector;
resourcestring
SIgnoreAssertion = 'You can safely ignore this failure. This function is just not supported by the selected database';
implementation
uses
{$IFDEF SQLDB_AVAILABLE}
sqldbtoolsunit,
{$ENDIF}
{$IFDEF DBF_AVAILABLE}
dbftoolsunit,
{$ENDIF}
memdstoolsunit,
inifiles;
constructor TDBConnector.create;
begin
CreateFieldDataset;
CreateNDatasets;
FUsedDatasets := TFPList.Create;
end;
destructor TDBConnector.destroy;
begin
FUsedDatasets.Destroy;
DropNDatasets;
DropFieldDataset;
end;
procedure TDBConnector.ResetNDatasets;
begin
DropNDatasets;
CreateNDatasets;
end;
procedure TDBConnector.ResetFieldDataset;
begin
DropFieldDataset;
CreateFieldDataset;
end;
procedure TDBConnector.DataEvent(dataset : tdataset);
begin
DataEvents := DataEvents + 'DataEvent' + ';';
end;
function TDBConnector.GetNDataset(n: integer): TDataset;
begin
Result := GetNDataset(False,n);
end;
procedure ReadIniFile;
var IniFile : TIniFile;
s : string;
i : TDBTypes;
begin
IniFile := TIniFile.Create(getcurrentdir + PathDelim + 'database.ini');
s := IniFile.ReadString('Database','Type','');
for i := low(DBTypesNames) to high(DBTypesNames) do
if s = DBTypesNames[i] then dbtype := i;
dbtype := IniFile.ReadString('Database','Type','');
dbconnectorname := IniFile.ReadString(dbtype,'Connector','');
dbname := IniFile.ReadString(dbtype,'Name','');
dbuser := IniFile.ReadString(dbtype,'User','');
dbhostname := IniFile.ReadString(dbtype,'Hostname','');
dbpassword := IniFile.ReadString(dbtype,'Password','');
dbconnectorparams := IniFile.ReadString(dbtype,'ConnectorParams','');
dbname := IniFile.ReadString(s,'Name','');
dbuser := IniFile.ReadString(s,'User','');
dbhostname := IniFile.ReadString(s,'Hostname','');
dbpassword := IniFile.ReadString(s,'Password','');
IniFile.Free;
end;
procedure InitialiseDBConnector;
var DBConnectorClass : TPersistentClass;
begin
// ReadIniFile;
if (1 <> 1) then begin end
{$IFDEF SQLDB_AVAILABLE}
else if (dbtype in SQLDBdbTypes) then DBConnector := TSQLDBConnector.Create
{$ENDIF}
{$IFDEF DBF_AVAILABLE}
else if dbtype = dbf then DBConnector := TDBFDBConnector.Create
{$ENDIF}
else Raise Exception.Create('Invalid database-type specified');
if dbconnectorname = '' then raise Exception.Create('There is no db-connector specified');
DBConnectorClass := GetClass('T'+dbconnectorname+'DBConnector');
if assigned(DBConnectorClass) then
DBConnector := TDBConnectorClass(DBConnectorClass).create
else Raise Exception.Create('Unknown db-connector specified');
end;
{ TTestDataLink }
@ -133,23 +239,48 @@ end;
{ TDBConnector }
function TDBConnector.GetNDataset(n: integer): TDataset;
function TDBConnector.GetNDataset(AChange : Boolean; n: integer): TDataset;
begin
Result := FDatasets[n];
if AChange then FChangedDatasets[n] := True;
Result := InternalGetNDataset(n);
FUsedDatasets.Add(Result);
end;
procedure TDBConnector.InitialiseDatasets;
var count : integer;
function TDBConnector.GetFieldDataset: TDataSet;
begin
for count := 0 to MaxDataSet do
FDatasets[count] := CreateNDataset(count);
Result := GetFieldDataset(False);
end;
procedure TDBConnector.FreeDatasets;
var count : integer;
function TDBConnector.GetFieldDataset(AChange: Boolean): TDataSet;
begin
for count := 0 to MaxDataSet do if assigned(FDatasets[count]) then
FreeNDataset(FDatasets[count]);
if AChange then FChangedFieldDataset := True;
Result := InternalGetFieldDataset;
FUsedDatasets.Add(Result);
end;
procedure TDBConnector.StartTest;
begin
// Do nothing?
end;
procedure TDBConnector.StopTest;
var i : integer;
ds : TDataset;
begin
for i := 0 to FUsedDatasets.Count -1 do
begin
ds := tdataset(FUsedDatasets[i]);
if ds.active then ds.Close;
ds.Free;
end;
FUsedDatasets.Clear;
if FChangedFieldDataset then ResetFieldDataset;
for i := 0 to MaxDataSet do if FChangedDatasets[i] then
begin
ResetNDatasets;
fillchar(FChangedDatasets,sizeof(FChangedDatasets),ord(False));
break;
end;
end;
initialization