paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 02:07:19 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Added TDataset.DataEvent tests

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

git-svn-id: trunk@10439 -
This commit is contained in:
joost 2008-03-03 22:00:37 +00:00
parent 3a8284b524
commit d36d7a7e01
2 changed files with 71 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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.

12
packages/fcl-db/tests/toolsunit.pas
View File

@ -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?