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

fcl-db/dbase: tests for findfirst etc, and visual foxpro

Browse Source 
git-svn-id: trunk@24111 -
This commit is contained in:
reiniero 2013-04-01 16:52:23 +00:00
parent 9aae445b12
commit 6fc43628da
3 changed files with 70 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-db/tests/database.ini.txt
View File

@ -164,7 +164,8 @@ connector=dbf
; 3=DBase III
; 4=DBase IV
; 7=Visual DBase 7 for Windows
; 25=FoxPro/Visual FoxPro
; 25=FoxPro
; 30=Visual FoxPro
connectorparams=4
; MemDS in memory dataset:

13
packages/fcl-db/tests/dbftoolsunit.pas
View File

@ -13,7 +13,7 @@ interface
uses
Classes, SysUtils, toolsunit,
db, Dbf;
db, Dbf, dbf_common;
type
{ TDBFDBConnector }
@ -68,7 +68,7 @@ begin
// connectorparams=4
// If none given, default to DBase IV
TableLevelProvided:=StrToIntDef(dbconnectorparams,4);
if not ((TableLevelProvided = 3) or (TableLevelProvided = 4) or (TableLevelProvided = 7) or (TableLevelProvided = 25)) then
if not (TableLevelProvided in [3,4,5,7,TDBF_TABLELEVEL_FOXPRO,TDBF_TABLELEVEL_VISUALFOXPRO]) then
begin
writeln('Invalid tablelevel specified in connectorparams= field. Aborting');
exit;
@ -151,15 +151,18 @@ begin
FieldDefs.Add('FSTRING',ftString,10);
FieldDefs.Add('FSMALLINT',ftSmallint);
FieldDefs.Add('FINTEGER',ftInteger);
// FieldDefs.Add('FWORD',ftWord);
FieldDefs.Add('FWORD',ftWord);
FieldDefs.Add('FBOOLEAN',ftBoolean);
FieldDefs.Add('FFLOAT',ftFloat);
// FieldDefs.Add('FCURRENCY',ftCurrency);
// FieldDefs.Add('FBCD',ftBCD);
if (result as TDBF).TableLevel>=25 then
FieldDefs.Add('FCURRENCY',ftCurrency);
if (result as TDBF).TableLevel>=25 then
FieldDefs.Add('FBCD',ftBCD);
FieldDefs.Add('FDATE',ftDate);
// FieldDefs.Add('FTIME',ftTime);
FieldDefs.Add('FDATETIME',ftDateTime);
FieldDefs.Add('FLARGEINT',ftLargeint);
FieldDefs.Add('FMEMO',ftMemo);
CreateTable;
Open;
for i := 0 to testValuesCount-1 do

75
packages/fcl-db/tests/testspecifictdbf.pas
View File

@ -25,7 +25,6 @@ type
TTestSpecificTDBF = class(TTestCase)
private
function GetTableLevel: integer;
procedure WriteReadbackTest(ADBFDataset: TDbf; AutoInc: boolean = false);
protected
procedure SetUp; override;
@ -39,6 +38,14 @@ type
procedure OpenNonExistingDataset_Fails;
procedure TestCreationDatasetWithCalcFields;
procedure TestAutoIncField;
// Tests findfirst
procedure FindFirst;
// Tests findlast
procedure FindLast;
// Tests findnext
procedure FindNext;
// Tests findprior
procedure FindPrior;
end;
@ -50,19 +57,6 @@ uses
{ TTestSpecificTDBF }
function TTestSpecificTDBF.GetTableLevel: integer;
var
TableLevelProvided: integer;
begin
TableLevelProvided:=StrToIntDef(dbconnectorparams,4);
if not ((TableLevelProvided = 3) or (TableLevelProvided = 4) or (TableLevelProvided = 7) or (TableLevelProvided = 25)) then
begin
writeln('Invalid tablelevel specified in connectorparams= field. Aborting');
exit;
end;
result := TableLevelProvided;
end;
procedure TTestSpecificTDBF.WriteReadbackTest(ADBFDataset: TDbf;
AutoInc: boolean);
var
@ -225,11 +219,62 @@ begin
ds.Free;
end;
procedure TTestSpecificTDBF.FindFirst;
const
NumRecs=8;
var
DS: TDataSet;
begin
DS:=DBConnector.GetNDataset(NumRecs);
DS.Open;
DS.Last;
CheckEquals(true,DS.FindFirst,'Findfirst should return true');
CheckEquals(1,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindLast;
const
NumRecs=8;
var
DS: TDataSet;
begin
DS:=DBConnector.GetNDataset(NumRecs);
DS.Open;
DS.First;
CheckEquals(true,DS.FindLast,'Findlast should return true');
CheckEquals(NumRecs,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindNext;
const
NumRecs=8;
var
DS: TDataSet;
begin
DS:=DBConnector.GetNDataset(NumRecs);
DS.Open;
DS.First;
CheckEquals(true,DS.FindNext,'FindNext should return true');
CheckEquals(2,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindPrior;
const
NumRecs=8;
var
DS: TDataSet;
begin
DS:=DBConnector.GetNDataset(NumRecs);
DS.Open;
DS.Last;
CheckEquals(true,DS.FindPrior,'FindPrior should return true');
CheckEquals(NumRecs-1,DS.fieldbyname('ID').asinteger);
end;
initialization
{$ifdef fpc}
if uppercase(dbconnectorname)='DBF' then
begin
RegisterTestDecorator(TDBBasicsTestSetup, TTestSpecificTDBF);