* fcl-db/dbase: fix trace datasets for tests

git-svn-id: trunk@24141 -

packages/fcl-db/src/dbase/history.txt

@@ -32,9 +32,9 @@ BUGS & WARNINGS
 
 
 FreePascal trunk:
-- initial read support for (Visual) FoxPro files
-- annotated constants/file structure
-- factored out get version/get codepage subprocedure for readability
+- initial read support for (Visual) FoxPro files (r24139)
+- annotated constants/file structure (r24139)
+- factored out get version/get codepage subprocedure for readability (r24139)
 - split out existing support for Visual FoxPro and Foxpro (r24109) 
   so future Visual FoxPro only features can be implemented
 - implemented FindFirst,FindNext,FindPrior,FindLast (r24107)

packages/fcl-db/tests/dbftoolsunit.pas

@@ -27,23 +27,16 @@ type
     procedure CreateFieldDataset; override;
     procedure DropNDatasets; override;
     procedure DropFieldDataset; override;
+    // InternalGetNDataset reroutes to ReallyInternalGetNDataset
     function InternalGetNDataset(n: integer): TDataset; override;
     function InternalGetFieldDataset: TDataSet; override;
+    // GetNDataset allowing trace dataset if required;
+    // if trace is on, use a TDbfTraceDataset instead of TDBFAutoClean
+    function ReallyInternalGetNDataset(n: integer; Trace: boolean): TDataset;
   public
     function GetTraceDataset(AChange: boolean): TDataset; override;
   end;
 
-  { TDbfTraceDataset }
-
-  TDbfTraceDataset = class(Tdbf)
-  protected
-    procedure SetCurrentRecord(Index: longint); override;
-    procedure RefreshInternalCalcFields(Buffer: PChar); override;
-    procedure InternalInitFieldDefs; override;
-    procedure CalculateFields(Buffer: PChar); override;
-    procedure ClearCalcFields(Buffer: PChar); override;
-  end;
-
   { TDBFAutoClean }
   // DBF descendant that saves to a temp file and removes file when closed
   TDBFAutoClean = class(TDBF)
@@ -59,6 +52,17 @@ type
     function UserRequestedTableLevel: integer;
   end;
 
+  { TDbfTraceDataset }
+  TDbfTraceDataset = class(TdbfAutoClean)
+  protected
+    procedure SetCurrentRecord(Index: longint); override;
+    procedure RefreshInternalCalcFields(Buffer: PChar); override;
+    procedure InternalInitFieldDefs; override;
+    procedure CalculateFields(Buffer: PChar); override;
+    procedure ClearCalcFields(Buffer: PChar); override;
+  end;
+
+
 implementation
 
 uses
@@ -102,8 +106,10 @@ begin
 end;
 
 destructor TDBFAutoClean.Destroy;
+{$IFDEF KEEPDBFFILES}
 var
   FileName: string;
+{$ENDIF}
 begin
   {$IFDEF KEEPDBFFILES}
   Close;
@@ -137,32 +143,8 @@ begin
 end;
 
 function TDBFDBConnector.InternalGetNDataset(n: integer): TDataset;
-var
-  countID: integer;
 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;
-    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;
+  result:=ReallyInternalGetNDataset(n,false);
 end;
 
 function TDBFDBConnector.InternalGetFieldDataset: TDataSet;
@@ -212,15 +194,46 @@ begin
   end;
 end;
 
+function TDBFDBConnector.ReallyInternalGetNDataset(n: integer; Trace: boolean): TDataset;
+var
+  countID: integer;
+begin
+  if Trace then
+    Result := (TDbfTraceDataset.Create(nil) as TDataSet)
+  else
+    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;
+    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.GetTraceDataset(AChange: boolean): TDataset;
 var
-  ADS, AResDS: TDbf;
+  ADS: TDataSet;
 begin
-  ADS := GetNDataset(AChange, 15) as TDbf;
-  AResDS := TDbfTraceDataset.Create(nil);
-  AResDS.FilePath := ADS.FilePath;
-  AResDs.TableName := ADS.TableName;
-  Result := AResDS;
+  // Mimic TDBConnector.GetNDataset
+  if AChange then FChangedDatasets[NForTraceDataset] := True;
+  Result := ReallyInternalGetNDataset(NForTraceDataset,true);
+  FUsedDatasets.Add(Result);
 end;
 
 { TDbfTraceDataset }

packages/fcl-db/tests/toolsunit.pas

@@ -9,9 +9,12 @@ interface
 uses
   Classes, SysUtils, DB, testdecorator;
 
-// Number of "N" test datasets (as opposed to FieldDatasets) that will be created
-// The connectors should have these records prepared in their Create*Dataset procedures.
-Const MaxDataSet = 35;
+Const
+  // Number of "N" test datasets (as opposed to FieldDatasets) that will be created
+  // The connectors should have these records prepared in their Create*Dataset procedures.
+  MaxDataSet = 35;
+  // Number of records in a trace dataset:
+  NForTraceDataset = 15;
   
 type
 
@@ -19,11 +22,11 @@ type
   TDBConnectorClass = class of TDBConnector;
   TDBConnector = class(TPersistent)
      private
-       FChangedDatasets : array[0..MaxDataSet] of boolean;
        FFormatSettings: TFormatSettings;
-       FUsedDatasets : TFPList;
        FChangedFieldDataset : boolean;
      protected
+       FChangedDatasets : array[0..MaxDataSet] of boolean;
+       FUsedDatasets : TFPList;
        procedure SetTestUniDirectional(const AValue: boolean); virtual;
        function GetTestUniDirectional: boolean; virtual;
        // These methods should be implemented by all descendents
@@ -446,7 +449,7 @@ end;
 
 function TDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
 begin
-  result := GetNDataset(AChange,15);
+  result := GetNDataset(AChange,NForTraceDataset);
 end;
 
 procedure TDBConnector.StartTest;