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

* fcl-db/dbase tests: cosmetic/formatting

Browse Source 
git-svn-id: trunk@24121 -
This commit is contained in:
reiniero 2013-04-02 02:48:10 +00:00
parent 43b6139b66
commit 19e5ddcbbf
2 changed files with 108 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,10 +13,10 @@ interface
uses
Classes, SysUtils, toolsunit,
db, Dbf, dbf_common;
DB, Dbf, dbf_common;
type
{ TDBFDBConnector }
{ TDBFDBConnector }
TDBFDBConnector = class(TDBConnector)
protected
@ -24,17 +24,17 @@ type
procedure CreateFieldDataset; override;
procedure DropNDatasets; override;
procedure DropFieldDataset; override;
Function InternalGetNDataset(n : integer) : TDataset; override;
Function InternalGetFieldDataset : TDataSet; override;
function InternalGetNDataset(n: integer): TDataset; override;
function InternalGetFieldDataset: TDataSet; override;
public
function GetTraceDataset(AChange : Boolean) : TDataset; override;
function GetTraceDataset(AChange: boolean): TDataset; override;
end;
{ TDbfTraceDataset }
TDbfTraceDataset = class(Tdbf)
protected
procedure SetCurrentRecord(Index: Longint); override;
procedure SetCurrentRecord(Index: longint); override;
procedure RefreshInternalCalcFields(Buffer: PChar); override;
procedure InternalInitFieldDefs; override;
procedure CalculateFields(Buffer: PChar); override;
@ -43,7 +43,9 @@ type
{ TDBFAutoClean }
// DBF descendant that saves to a temp file and removes file when closed
TDBFAutoClean=class(TDBF)
TDBFAutoClean = class(TDBF)
private
function GetUserRequestedTableLevel: integer;
public
constructor Create;
constructor Create(AOwner: TComponent); override;
@ -56,23 +58,33 @@ implementation
{ TDBFAutoClean }
function TDBFAutoClean.GetUserRequestedTableLevel: integer;
// User can specify table level as a connector param, e.g.:
// connectorparams=4
// If none given, default to DBase IV
var
TableLevelProvided: integer;
begin
TableLevelProvided := StrToIntDef(dbconnectorparams, 4);
if not (TableLevelProvided in [3, 4, 5, 7, TDBF_TABLELEVEL_FOXPRO,
TDBF_TABLELEVEL_VISUALFOXPRO]) then
begin
Result := -1; // hope this crashes the tests so user is alerted.
//Invalid tablelevel specified in connectorparams= field. Aborting
exit;
end;
Result := TableLevelProvided;
end;
constructor TDBFAutoClean.Create;
var
DBFFileName: string;
TableLevelProvided: integer;
begin
DBFFileName:=GetTempFileName;
FilePathFull:=ExtractFilePath(DBFFileName);
DBFFileName := GetTempFileName;
FilePathFull := ExtractFilePath(DBFFileName);
TableName := ExtractFileName(DBFFileName);
// User can specify table level as a connector param, e.g.:
// connectorparams=4
// If none given, default to DBase IV
TableLevelProvided:=StrToIntDef(dbconnectorparams,4);
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;
end;
TableLevelProvided := GetUserRequestedTableLevel;
TableLevel := TableLevelProvided;
CreateTable; //write out header to disk
end;
@ -87,7 +99,7 @@ destructor TDBFAutoClean.Destroy;
var
FileName: string;
begin
FileName:=AbsolutePath+TableName;
FileName := AbsolutePath + TableName;
inherited Destroy;
deletefile(FileName);
end;
@ -117,56 +129,57 @@ function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
var
countID: integer;
begin
result:=(TDBFAutoClean.Create(nil) as TDataSet);
with (result as TDBFAutoclean) do
begin
FieldDefs.Add('ID',ftInteger);
FieldDefs.Add('NAME',ftString,50);
Result := (TDBFAutoClean.Create(nil) as TDataSet);
with (Result as TDBFAutoclean) do
begin
FieldDefs.Add('ID', ftInteger);
FieldDefs.Add('NAME', ftString, 50);
CreateTable;
Open;
if n > 0 then for countId := 1 to n do
if n > 0 then
for countId := 1 to n do
begin
Append;
FieldByName('ID').AsInteger := countID;
FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
// Explicitly call .post, since there could be a bug which disturbs
// the automatic call to post. (example: when TDataset.DataEvent doesn't
// work properly)
Post;
Append;
FieldByName('ID').AsInteger := countID;
FieldByName('NAME').AsString := 'TestName' + IntToStr(countID);
// Explicitly call .post, since there could be a bug which disturbs
// the automatic call to post. (example: when TDataset.DataEvent doesn't
// work properly)
Post;
end;
if state = dsinsert then
Post;
Close;
end;
end;
end;
function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
var
i : integer;
i: integer;
begin
result:=(TDbfAutoClean.Create(nil) as TDataSet);
with (result as TDBFAutoClean) 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);
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);
Result := (TDbfAutoClean.Create(nil) as TDataSet);
with (Result as TDBFAutoClean) 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);
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
begin
for i := 0 to testValuesCount - 1 do
begin
Append;
FieldByName('ID').AsInteger := i;
FieldByName('FSTRING').AsString := testStringValues[i];
@ -177,24 +190,25 @@ begin
FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
Post;
end;
Close;
end;
Close;
end;
end;
function TDBFDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
var ADS, AResDS : TDbf;
function TDBFDBConnector.GetTraceDataset(AChange: boolean): TDataset;
var
ADS, AResDS: TDbf;
begin
ADS := GetNDataset(AChange,15) as TDbf;
ADS := GetNDataset(AChange, 15) as TDbf;
AResDS := TDbfTraceDataset.Create(nil);
AResDS.FilePath:=ADS.FilePath;
AResDs.TableName:=ADS.TableName;
Result:=AResDS;
AResDS.FilePath := ADS.FilePath;
AResDs.TableName := ADS.TableName;
Result := AResDS;
end;
{ TDbfTraceDataset }
procedure TDbfTraceDataset.SetCurrentRecord(Index: Longint);
procedure TDbfTraceDataset.SetCurrentRecord(Index: longint);
begin
DataEvents := DataEvents + 'SetCurrentRecord' + ';';
inherited SetCurrentRecord(Index);
@ -207,20 +221,23 @@ begin
end;
procedure TDbfTraceDataset.InternalInitFieldDefs;
var i : integer;
IntCalcFieldName : String;
var
i: integer;
IntCalcFieldName: string;
begin
// To fake an internal calculated field, set its fielddef InternalCalcField
// property to true, before the dataset is opened.
// This procedure takes care of setting the automatically created fielddef's
// InternalCalcField property to true. (works for only one field)
IntCalcFieldName:='';
for i := 0 to FieldDefs.Count -1 do
if fielddefs[i].InternalCalcField then IntCalcFieldName := FieldDefs[i].Name;
IntCalcFieldName := '';
for i := 0 to FieldDefs.Count - 1 do
if fielddefs[i].InternalCalcField then
IntCalcFieldName := FieldDefs[i].Name;
inherited InternalInitFieldDefs;
if IntCalcFieldName<>'' then with FieldDefs.find(IntCalcFieldName) do
if IntCalcFieldName <> '' then
with FieldDefs.find(IntCalcFieldName) do
begin
InternalCalcField := True;
InternalCalcField := True;
end;
end;
@ -239,4 +256,3 @@ end;
initialization
RegisterClass(TDBFDBConnector);
end.

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

@ -30,22 +30,23 @@ type
procedure SetUp; override;
procedure TearDown; override;
published
// Create fields the old fashioned way:
procedure CreateDatasetFromFielddefs;
// Create fields using indexdefs:
procedure TestCreateDatasetFromFielddefs;
// Specifying fields from field objects
procedure CreateDatasetFromFields;
procedure TestCreateDatasetFromFields;
// Tries to open a dbf that has not been activated, which should fail:
procedure OpenNonExistingDataset_Fails;
procedure TestOpenNonExistingDataset_Fails;
// Tests creating a new database with calculated/lookup fields
procedure TestCreationDatasetWithCalcFields;
procedure TestAutoIncField;
// Tests findfirst
procedure FindFirst;
// Tests findlast
procedure FindLast;
// Tests findnext
procedure FindNext;
// Tests findfirst moves to first record
procedure TestFindFirst;
// Tests findlast moves to last record
procedure TestFindLast;
// Tests findnext moves to next record
procedure TestFindNext;
// Tests findprior
procedure FindPrior;
procedure TestFindPrior;
end;
@ -91,7 +92,7 @@ begin
DBConnector.StopTest;
end;
procedure TTestSpecificTDBF.CreateDatasetFromFielddefs;
procedure TTestSpecificTDBF.TestCreateDatasetFromFielddefs;
var
ds : TDBF;
begin
@ -105,7 +106,7 @@ begin
ds.free;
end;
procedure TTestSpecificTDBF.CreateDatasetFromFields;
procedure TTestSpecificTDBF.TestCreateDatasetFromFields;
var
ds : TDBF;
f: TField;
@ -123,7 +124,7 @@ begin
ds.free;
end;
procedure TTestSpecificTDBF.OpenNonExistingDataset_Fails;
procedure TTestSpecificTDBF.TestOpenNonExistingDataset_Fails;
var
ds : TDBF;
f: TField;
@ -202,6 +203,7 @@ begin
begin
Ignore('Autoinc fields are only supported in tablelevel 7 and higher');
end;
F := TAutoIncField.Create(ds);
F.FieldName:='ID';
F.DataSet:=ds;
@ -219,7 +221,7 @@ begin
ds.Free;
end;
procedure TTestSpecificTDBF.FindFirst;
procedure TTestSpecificTDBF.TestFindFirst;
const
NumRecs=8;
var
@ -232,7 +234,7 @@ begin
CheckEquals(1,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindLast;
procedure TTestSpecificTDBF.TestFindLast;
const
NumRecs=8;
var
@ -245,7 +247,7 @@ begin
CheckEquals(NumRecs,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindNext;
procedure TTestSpecificTDBF.TestFindNext;
const
NumRecs=8;
var
@ -258,7 +260,7 @@ begin
CheckEquals(2,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.FindPrior;
procedure TTestSpecificTDBF.TestFindPrior;
const
NumRecs=8;
var