* Added TDataset.DataEvent tests

 * Initialise the connector manually in the console-application, for better error messages in case of connection problems

git-svn-id: trunk@10439 -

packages/fcl-db/tests/dbftoolsunit.pas

@@ -21,6 +21,18 @@ type
     procedure DropFieldDataset; override;
     Function InternalGetNDataset(n : integer) : TDataset; override;
     Function InternalGetFieldDataset : TDataSet; override;
+  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;
   end;
 
 implementation
@@ -128,6 +140,54 @@ begin
     end;
 end;
 
+function TDBFDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
+var ADS, AResDS : TDbf;
+begin
+  ADS := GetNDataset(AChange,15) as TDbf;
+  AResDS := TDbfTraceDataset.Create(nil);
+  AResDS.FilePath:=ADS.FilePath;
+  AResDs.TableName:=ADS.TableName;
+  Result:=AResDS;
+end;
+
+{ TDbfTraceDataset }
+
+procedure TDbfTraceDataset.SetCurrentRecord(Index: Longint);
+begin
+  DataEvents := DataEvents + 'SetCurrentRecord' + ';';
+  inherited SetCurrentRecord(Index);
+end;
+
+procedure TDbfTraceDataset.RefreshInternalCalcFields(Buffer: PChar);
+begin
+  DataEvents := DataEvents + 'RefreshInternalCalcFields' + ';';
+  inherited RefreshInternalCalcFields(Buffer);
+end;
+
+procedure TDbfTraceDataset.InternalInitFieldDefs;
+var i : integer;
+    IntCalcFieldName : String;
+begin
+  // To fake a internal calculated field, set it's 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;
+  inherited InternalInitFieldDefs;
+  if IntCalcFieldName<>'' then with FieldDefs.find(IntCalcFieldName) do
+    begin
+    InternalCalcField := True;
+    end;
+end;
+
+procedure TDbfTraceDataset.CalculateFields(Buffer: PChar);
+begin
+  DataEvents := DataEvents + 'CalculateFields' + ';';
+  inherited CalculateFields(Buffer);
+end;
+
 initialization
   RegisterClass(TDBFDBConnector);
 end.

packages/fcl-db/tests/toolsunit.pas

@@ -52,6 +52,8 @@ type
        Function GetNDataset(AChange : Boolean; n : integer) : TDataset;  overload;
        Function GetFieldDataset : TDataSet; overload;
        Function GetFieldDataset(AChange : Boolean) : TDataSet; overload;
+       
+       Function GetTraceDataset(AChange : Boolean) : TDataset; virtual;
 
        procedure StartTest;
        procedure StopTest;
@@ -255,7 +257,10 @@ procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
 procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Longint);
 {$ENDIF}
 begin
-  DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';';
+  if Event <> deFieldChange then
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';'
+  else
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + TField(info).FieldName + ';';
   inherited DataEvent(Event, Info);
 end;
 
@@ -280,6 +285,11 @@ begin
   FUsedDatasets.Add(Result);
 end;
 
+function TDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
+begin
+  result := GetNDataset(AChange,15);
+end;
+
 procedure TDBConnector.StartTest;
 begin
 // Do nothing?