sqldb/tests improvements:

* fix memory leak in gui runner
sqldb/tests for dbf/tdbf/dbase/foxpro unit:
* added dbf specific tests
* specify desired tablelevel by connectorparams=<tablelevel> (e.g. 4 for DBase IV)
* dbftoolsunit set up similar to bufdataset tools unit including autocleaning files
- dbname= field in database.ini no longer used for dbf files; always write to temp directory
To do: go through other tests and add ignores if necessary for non-relevant tests

git-svn-id: trunk@24104 -

.gitattributes

@@ -2151,6 +2151,7 @@ packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
 packages/fcl-db/tests/testspecifictbufdataset.pas svneol=native#text/plain
+packages/fcl-db/tests/testspecifictdbf.pas svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain

packages/fcl-db/tests/database.ini.txt

@@ -160,9 +160,12 @@ hostname=127.0.0.1
 ; TDBf: DBase/FoxPro database:
 [dbf]
 connector=dbf
-
-; The path where the *.dbf file can be generated:
-name=/tmp
+; Connectorparams specifies table level/compatibility level:
+; 3=DBase III
+; 4=DBase IV
+; 7=Visual DBase 7 for Windows
+; 25=FoxPro/Visual FoxPro
+connectorparams=4
 
 ; MemDS in memory dataset:
 [memds]

packages/fcl-db/tests/dbftoolsunit.pas

@@ -41,49 +41,112 @@ type
     procedure ClearCalcFields(Buffer: PChar); override;
   end;
 
+  { TDBFAutoClean }
+  // DBF descendant that saves to a temp file and removes file when closed
+  TDBFAutoClean=class(TDBF)
+  public
+    constructor Create;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
 implementation
 
-const
-  FieldDatasetTableName='fpdev_field.db';
+
+
+{ TDBFAutoClean }
+
+constructor TDBFAutoClean.Create;
+var
+  DBFFileName: string;
+  TableLevelProvided: integer;
+begin
+  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 = 3) or (TableLevelProvided = 4) or (TableLevelProvided = 7) or (TableLevelProvided = 25)) then
+  begin
+    writeln('Invalid tablelevel specified in connectorparams= field. Aborting');
+    exit;
+  end;
+  TableLevel := TableLevelProvided;
+  CreateTable; //write out header to disk
+end;
+
+constructor TDBFAutoClean.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Self.Create;
+end;
+
+destructor TDBFAutoClean.Destroy;
+var
+  FileName: string;
+begin
+  FileName:=AbsolutePath+TableName;
+  inherited Destroy;
+  deletefile(FileName);
+end;
+
 
 procedure TDBFDBConnector.CreateNDatasets;
-var countID,n : integer;
 begin
-  for n := 0 to MaxDataSet do
-    begin
-    with TDbf.Create(nil) do
-      begin
-      FilePath := dbname; //specified in database.ini name= field
-      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);
-        // 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;
-      Free;
-      end;
-    end;
+  // All datasets are created in InternalGet*Dataset
 end;
 
 procedure TDBFDBConnector.CreateFieldDataset;
-var i : integer;
 begin
-  with TDbf.Create(nil) do
+  // All datasets are created in InternalGet*Dataset
+end;
+
+procedure TDBFDBConnector.DropNDatasets;
+begin
+  // Nothing to be done here; the dataset is cleaned up in TDBFAutoClean.Destroy
+end;
+
+procedure TDBFDBConnector.DropFieldDataset;
+begin
+  // Nothing to be done here; the dataset is cleaned up in TDBFAutoClean.Destroy
+end;
+
+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);
+    CreateTable;
+    Open;
+    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;
+      end;
+    if state = dsinsert then
+      Post;
+    Close;
+    end;
+end;
+
+function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
+var
+  i : integer;
+begin
+  result:=(TDbfAutoClean.Create(nil) as TDataSet);
+  with (result as TDBFAutoClean) do
     begin
-    FilePath := dbname; //specified in database.ini name=
-    TableName := FieldDatasetTableName;
     FieldDefs.Add('ID',ftInteger);
     FieldDefs.Add('FSTRING',ftString,10);
     FieldDefs.Add('FSMALLINT',ftSmallint);
@@ -116,38 +179,6 @@ begin
     end;
 end;
 
-procedure TDBFDBConnector.DropNDatasets;
-var n : integer;
-begin
-  for n := 0 to MaxDataSet do
-    DeleteFile(ExtractFilePath(dbname)+'fpdev_'+inttostr(n)+'.db');
-end;
-
-procedure TDBFDBConnector.DropFieldDataset;
-begin
-  DeleteFile(ExtractFilePath(dbname)+FieldDatasetTableName);
-end;
-
-function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
-begin
-  Result := TDbf.Create(nil);
-  with (result as TDbf) do
-    begin
-    FilePath := dbname; //specified in database.ini name= field
-    TableName := 'fpdev_'+inttostr(n)+'.db';
-    end;
-end;
-
-function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
-begin
-  Result := TDbf.Create(nil);
-  with (result as TDbf) do
-    begin
-    FilePath := dbname; //specified in database.ini name= field
-    TableName := FieldDatasetTableName;
-    end;
-end;
-
 function TDBFDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
 var ADS, AResDS : TDbf;
 begin

packages/fcl-db/tests/dbtestframework.pas

@@ -25,6 +25,7 @@ uses
   TestDBBasics,
   TestBufDatasetStreams,
   TestSpecificTBufDataset,
+  TestSpecificTDBF,
   TestDBExport,
   consoletestrunner;
 

packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -83,7 +83,7 @@
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="4">
+    <Exceptions Count="7">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -96,6 +96,15 @@
       <Item4>
         <Name Value="EIBDatabaseError"/>
       </Item4>
+      <Item5>
+        <Name Value="EDatabaseError"/>
+      </Item5>
+      <Item6>
+        <Name Value="EAssertionFailedError"/>
+      </Item6>
+      <Item7>
+        <Name Value="EIgnoredTest"/>
+      </Item7>
     </Exceptions>
   </Debugging>
 </CONFIG>

packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -29,6 +29,7 @@ uses
   TestDatasources,
   TestBufDatasetStreams,
   TestSpecificTBufDataset,
+  TestSpecificTDBF,
   TestDBExport;
 
 {$R *.res}
@@ -51,7 +52,11 @@ begin
   // Manually run this form because autocreation could have loaded an old
   // database.ini file (if the user changed it using DBSelectForm)
   TestRunForm:=TGUITestRunner.Create(nil);
-  TestRunForm.Show;
-  Application.Run;
+  try
+    TestRunForm.Show;
+    Application.Run;
+  finally
+    TestRunForm.Free;
+  end;
 end.
 

packages/fcl-db/tests/testspecifictdbf.pas

@@ -0,0 +1,238 @@
+unit testspecifictdbf;
+
+{
+  Unit tests which are specific to the tdbf dbase units.
+}
+
+{$IFDEF FPC}
+{$mode Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+{$IFDEF FPC}
+  fpcunit, testutils, testregistry, testdecorator,
+{$ELSE FPC}
+  TestFramework,
+{$ENDIF FPC}
+  Classes, SysUtils,
+  db, dbf, dbf_common, ToolsUnit, DBFToolsUnit;
+
+type
+
+  { TTestSpecificTDBF }
+
+  TTestSpecificTDBF = class(TTestCase)
+  private
+    function GetTableLevel: integer;
+    procedure WriteReadbackTest(ADBFDataset: TDbf; AutoInc: boolean = false);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    // Create fields the old fashioned way:
+    procedure CreateDatasetFromFielddefs;
+    // Specifying fields from field objects
+    procedure CreateDatasetFromFields;
+    // Tries to open a dbf that has not been activated, which should fail:
+    procedure OpenNonExistingDataset_Fails;
+    procedure TestCreationDatasetWithCalcFields;
+    procedure TestAutoIncField;
+  end;
+
+
+implementation
+
+uses
+  variants,
+  FmtBCD;
+
+{ 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
+  i  : integer;
+begin
+  for i := 1 to 10 do
+    begin
+    ADBFDataset.Append;
+    if not AutoInc then
+      ADBFDataset.FieldByName('ID').AsInteger := i;
+    ADBFDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    ADBFDataset.Post;
+    end;
+  ADBFDataset.first;
+  for i := 1 to 10 do
+    begin
+    CheckEquals(i,ADBFDataset.fieldbyname('ID').asinteger);
+    CheckEquals('TestName' + inttostr(i),ADBFDataset.fieldbyname('NAME').AsString);
+    ADBFDataset.next;
+    end;
+  CheckTrue(ADBFDataset.EOF);
+end;
+
+
+procedure TTestSpecificTDBF.SetUp;
+begin
+  DBConnector.StartTest;
+end;
+
+procedure TTestSpecificTDBF.TearDown;
+begin
+  DBConnector.StopTest;
+end;
+
+procedure TTestSpecificTDBF.CreateDatasetFromFielddefs;
+var
+  ds : TDBF;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.FieldDefs.Add('NAME',ftString,50);
+  DS.CreateTable;
+  DS.Open;
+  WriteReadbackTest(ds);
+  DS.Close;
+  ds.free;
+end;
+
+procedure TTestSpecificTDBF.CreateDatasetFromFields;
+var
+  ds : TDBF;
+  f: TField;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  F := TIntegerField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+  DS.CreateTable;
+  DS.Open;
+  ds.free;
+end;
+
+procedure TTestSpecificTDBF.OpenNonExistingDataset_Fails;
+var
+  ds : TDBF;
+  f: TField;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  F := TIntegerField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+
+  CheckException(ds.Open,EDbfError);
+  ds.Free;
+
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+
+  CheckException(ds.Open,EDbfError);
+  ds.Free;
+end;
+
+procedure TTestSpecificTDBF.TestCreationDatasetWithCalcFields;
+var
+  ds : TDBF;
+  f: TField;
+  i: integer;
+begin
+  //todo: find out which tablelevels support calculated/lookup fields
+  ds := TDBFAutoClean.Create(nil);
+  try
+    F := TIntegerField.Create(ds);
+    F.FieldName:='ID';
+    F.DataSet:=ds;
+
+    F := TStringField.Create(ds);
+    F.FieldName:='NAME';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    F := TStringField.Create(ds);
+    F.FieldKind:=fkCalculated;
+    F.FieldName:='NAME_CALC';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    F := TStringField.Create(ds);
+    F.FieldKind:=fkLookup;
+    F.FieldName:='NAME_LKP';
+    F.LookupDataSet:=DBConnector.GetNDataset(5);
+    F.KeyFields:='ID';
+    F.LookupKeyFields:='ID';
+    F.LookupResultField:='NAME';
+    F.DataSet:=ds;
+    F.Size:=50;
+
+    DS.CreateTable;
+    DS.Open;
+    WriteReadbackTest(ds);
+
+    for i := 0 to ds.FieldDefs.Count-1 do
+      begin
+      CheckNotEquals(ds.FieldDefs[i].Name,'NAME_CALC');
+      CheckNotEquals(ds.FieldDefs[i].Name,'NAME_LKP');
+      end;
+    DS.Close;
+  finally
+    ds.Free;
+  end;
+end;
+
+procedure TTestSpecificTDBF.TestAutoIncField;
+var
+  ds : TDbf;
+  f: TField;
+begin
+  ds := TDbfAutoClean.Create(nil);
+  if ds.TableLevel<7 then
+  begin
+    Ignore('Autoinc fields are only supported in tablelevel 7 and higher');
+  end;
+  F := TAutoIncField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+
+  DS.CreateTable;
+  DS.Open;
+
+  WriteReadbackTest(ds,True);
+  DS.Close;
+  ds.Free;
+end;
+
+
+
+initialization
+{$ifdef fpc}
+
+  if uppercase(dbconnectorname)='DBF' then
+    begin
+    RegisterTestDecorator(TDBBasicsTestSetup, TTestSpecificTDBF);
+    end;
+{$endif fpc}
+end.