* fcl-db/tests: add dbf tablelevel test, option to retain dbfs after tests

git-svn-id: trunk@24124 -

packages/fcl-db/tests/dbftoolsunit.pas

@@ -9,6 +9,9 @@ Because of this, we use file-backed dbfs instead of memory backed dbfs
   {$mode objfpc}{$H+}
 {$ENDIF}
 
+// If defined, do not delete the dbf files when done but print out location to stdout:
+{.$DEFINE KEEPDBFFILES}
+
 interface
 
 uses
@@ -45,20 +48,24 @@ type
   // DBF descendant that saves to a temp file and removes file when closed
   TDBFAutoClean = class(TDBF)
   private
-    function GetUserRequestedTableLevel: integer;
+    FCreatedBy: string;
   public
+    // Keeps track of which function created the dataset, useful for troubleshooting
+    property CreatedBy: string read FCreatedBy write FCreatedBy;
     constructor Create;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    function UserRequestedTableLevel: integer;
   end;
 
 implementation
 
-
+uses
+  FmtBCD;
 
 { TDBFAutoClean }
 
-function TDBFAutoClean.GetUserRequestedTableLevel: integer;
+function TDBFAutoClean.UserRequestedTableLevel: integer;
   // User can specify table level as a connector param, e.g.:
   // connectorparams=4
   // If none given, default to DBase IV
@@ -66,8 +73,8 @@ var
   TableLevelProvided: integer;
 begin
   TableLevelProvided := StrToIntDef(dbconnectorparams, 4);
-  if not (TableLevelProvided in [3, 4, 5, 7, TDBF_TABLELEVEL_FOXPRO,
-    TDBF_TABLELEVEL_VISUALFOXPRO]) then
+  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
@@ -84,7 +91,7 @@ begin
   DBFFileName := GetTempFileName;
   FilePathFull := ExtractFilePath(DBFFileName);
   TableName := ExtractFileName(DBFFileName);
-  TableLevelProvided := GetUserRequestedTableLevel;
+  TableLevelProvided := UserRequestedTableLevel;
   TableLevel := TableLevelProvided;
   CreateTable; //write out header to disk
 end;
@@ -101,7 +108,11 @@ var
 begin
   FileName := AbsolutePath + TableName;
   inherited Destroy;
+  {$IFDEF KEEPDBFFILES}
+  writeln('TDBFAutoClean: file created by ',CreatedBy,' left file: ',FileName);
+  {$ELSE}
   deletefile(FileName);
+  {$ENDIF}
 end;
 
 
@@ -132,6 +143,7 @@ begin
   Result := (TDBFAutoClean.Create(nil) as TDataSet);
   with (Result as TDBFAutoclean) do
   begin
+    CreatedBy:='InternalGetNDataset('+inttostr(n)+')';
     FieldDefs.Add('ID', ftInteger);
     FieldDefs.Add('NAME', ftString, 50);
     CreateTable;
@@ -160,6 +172,7 @@ begin
   Result := (TDbfAutoClean.Create(nil) as TDataSet);
   with (Result as TDBFAutoClean) do
   begin
+    CreatedBy:='InternalGetFieldDataset';
     FieldDefs.Add('ID', ftInteger);
     FieldDefs.Add('FSTRING', ftString, 10);
     FieldDefs.Add('FSMALLINT', ftSmallint);
@@ -187,6 +200,10 @@ begin
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
+      if (Result as TDBF).TableLevel >= 25 then
+        FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
+      if (Result as TDBF).TableLevel >= 25 then
+        FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings);
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       Post;

packages/fcl-db/tests/testspecifictdbf.pas

@@ -17,7 +17,7 @@ uses
   TestFramework,
 {$ENDIF FPC}
   Classes, SysUtils,
-  db, dbf, dbf_common, ToolsUnit, DBFToolsUnit;
+  ToolsUnit, dbf;
 
 type
 
@@ -30,6 +30,8 @@ type
     procedure SetUp; override;
     procedure TearDown; override;
   published
+    // Verifies that requested tablelevel is delivered:
+    procedure TestTableLevel;
     // Create fields using indexdefs:
     procedure TestCreateDatasetFromFielddefs;
     // Specifying fields from field objects
@@ -54,7 +56,8 @@ implementation
 
 uses
   variants,
-  FmtBCD;
+  FmtBCD,
+  db, dbf_common, DBFToolsUnit;
 
 { TTestSpecificTDBF }
 
@@ -63,6 +66,7 @@ procedure TTestSpecificTDBF.WriteReadbackTest(ADBFDataset: TDbf;
 var
   i  : integer;
 begin
+  // Add sample data
   for i := 1 to 10 do
     begin
     ADBFDataset.Append;
@@ -92,6 +96,19 @@ begin
   DBConnector.StopTest;
 end;
 
+procedure TTestSpecificTDBF.TestTableLevel;
+var
+  ds : TDBF;
+begin
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.CreateTable;
+  DS.Open;
+  CheckEquals((DS as TDBFAutoClean).UserRequestedTableLevel,DS.TableLevel,'User specified tablelevel should match dbf tablelevel.');
+  DS.Close;
+  ds.free;
+end;
+
 procedure TTestSpecificTDBF.TestCreateDatasetFromFielddefs;
 var
   ds : TDBF;
@@ -112,6 +129,7 @@ var
   f: TField;
 begin
   ds := TDBFAutoClean.Create(nil);
+  DS.CreateTable;
   F := TIntegerField.Create(ds);
   F.FieldName:='ID';
   F.DataSet:=ds;
@@ -119,7 +137,7 @@ begin
   F.FieldName:='NAME';
   F.DataSet:=ds;
   F.Size:=50;
-  DS.CreateTable;
+
   DS.Open;
   ds.free;
 end;
@@ -153,20 +171,20 @@ 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;
+    ds.FieldDefs.Add('ID',ftInteger);
+    ds.FieldDefs.Add('NAME',ftString,50);
+    ds.CreateTable;
+    for i:=0 to ds.FieldDefs.Count-1 do
+    begin
+      ds.FieldDefs[i].CreateField(ds); // make fields persistent
+    end;
 
     F := TStringField.Create(ds);
     F.FieldKind:=fkCalculated;
     F.FieldName:='NAME_CALC';
     F.DataSet:=ds;
     F.Size:=50;
+    F.ProviderFlags:=[];
 
     F := TStringField.Create(ds);
     F.FieldKind:=fkLookup;
@@ -178,7 +196,6 @@ begin
     F.DataSet:=ds;
     F.Size:=50;
 
-    DS.CreateTable;
     DS.Open;
     WriteReadbackTest(ds);