trunk/testsuite/Test19.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
unit Test19;

{$mode objfpc}{$H+}

{Test 19: Master/Detail Queries}

{ Description
  Two IBQueries are opened in a master detail relationship. The master is scrolled
  and the secondary shown to follow suite.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBQuery,
  fpTimer, IBInternals;

const
  aTestID    = '19';
  aTestTitle = 'TIBDataset Master/Detail Queries';

type

{ TTest19 }

  TTest19 = class(TIBXTestBase)
  private
    FDetailQuery: TIBQuery;
    FMasterSource: TDataSource;
    procedure InitDetailQuery(Application: TTestApplication);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

  { TNonGUITimer }

  TNonGUITimer = class(TInterfacedObject,IIBTimerInf)
  private
    FTimer: TFPTimer;
  public
    constructor Create;
    destructor Destroy; override;
  public
    function GetEnabled: boolean;
    procedure SetEnabled(Value: Boolean);
    function GetInterval: Cardinal;
    procedure SetInterval(Value: Cardinal);
    function GetOnTimer: TNotifyEvent;
    procedure SetOnTimer(Value: TNotifyEvent);
    function GetOnStartTimer: TNotifyEvent;
    procedure SetOnStartTimer(Value: TNotifyEvent);
    function GetOnStopTimer: TNotifyEvent;
    procedure SetOnStopTimer(Value: TNotifyEvent);
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Interval: Cardinal read GetInterval write SetInterval;
    property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
    property OnStartTimer: TNotifyEvent read GetOnStartTimer write SetOnStartTimer;
    property OnStopTimer: TNotifyEvent read GetOnStopTimer write SetOnStopTimer;
  end;

  { TDummyGUIInterface }

  TDummyGUIInterface = class(TInterfacedObject,IIBGUIInterface)
  public
    function ServerLoginDialog(var AServerName: string;
                               var AUserName, APassword: string): Boolean;
    function LoginDialogEx(var ADatabaseName: string;
                               var AUserName, APassword: string;
                               NameReadOnly: Boolean): Boolean;
    procedure SetCursor;
    procedure RestoreCursor;
    function CreateTimer: IIBTimerInf;
  end;


implementation

{ TDummyGUIInterface }

function TDummyGUIInterface.ServerLoginDialog(var AServerName: string;
  var AUserName, APassword: string): Boolean;
begin
  Result := false;
end;

function TDummyGUIInterface.LoginDialogEx(var ADatabaseName: string;
  var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
begin
  Result := false;
end;

procedure TDummyGUIInterface.SetCursor;
begin

end;

procedure TDummyGUIInterface.RestoreCursor;
begin

end;

function TDummyGUIInterface.CreateTimer: IIBTimerInf;
begin
  Result := TNonGUITimer.Create;
end;

{ TNonGUITimer }

constructor TNonGUITimer.Create;
begin
  inherited Create;
  FTimer := TFPTimer.Create(nil);
end;

destructor TNonGUITimer.Destroy;
begin
  if FTimer <> nil then FTimer.Free;
  inherited Destroy;
end;

function TNonGUITimer.GetEnabled: boolean;
begin
  Result := FTimer.Enabled;
end;

procedure TNonGUITimer.SetEnabled(Value: Boolean);
begin
  FTimer.Enabled := Value;
end;

function TNonGUITimer.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TNonGUITimer.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

function TNonGUITimer.GetOnTimer: TNotifyEvent;
begin
  Result := FTimer.OnTimer;
end;

procedure TNonGUITimer.SetOnTimer(Value: TNotifyEvent);
begin
  FTimer.OnTimer := Value;
end;

function TNonGUITimer.GetOnStartTimer: TNotifyEvent;
begin
  Result := FTimer.OnStartTimer;
end;

procedure TNonGUITimer.SetOnStartTimer(Value: TNotifyEvent);
begin
  FTimer.OnStartTimer := Value;
end;

function TNonGUITimer.GetOnStopTimer: TNotifyEvent;
begin
  Result := FTimer.OnStopTimer;
end;

procedure TNonGUITimer.SetOnStopTimer(Value: TNotifyEvent);
begin
  FTimer.OnStopTimer := Value;
end;

{ TTest19 }

procedure TTest19.InitDetailQuery(Application: TTestApplication);
begin
  FDetailQuery := TIBQuery.Create(Application);
  FDetailQuery.Database := IBDatabase;
  FDetailQuery.Transaction := IBTransaction;
  FDetailQuery.SQL.Text := 'Select * From EMPLOYEE Where DEPT_NO = :DEPT_NO';
  FDetailQuery.DataSource := FMasterSource;
end;

procedure TTest19.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  IBQuery.SQL.Text := 'Select * From DEPARTMENT';
  FMasterSource := TDataSource.Create(Application);
  FMasterSource.DataSet := IBQuery;
  InitDetailQuery(Application);
end;

function TTest19.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest19.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest19.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadOnlyTransaction;
end;

procedure TTest19.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    IBQuery.Active := true;
    FDetailQuery.Active := true;
    writeln(Outfile,'Department Record:');
    PrintDataSetRow(IBQuery);
    writeln(Outfile);
    writeln(Outfile,'Employee Records:');
    PrintDataSet(FDetailQuery);
    writeln(Outfile);
    writeln(OutFile,'Advance to next department');
    IBQuery.Next;
    writeln(Outfile,'Department Record:');
    PrintDataSetRow(IBQuery);
    writeln(Outfile);
    writeln(Outfile,'Employee Records:');
    PrintDataSet(FDetailQuery);
    FDetailQuery.Active := false;
    IBQuery.Active := false;

    FreeAndNil(FDetailQuery);
    IBGUIInterface := TDummyGUIInterface.Create;
    try
      InitDetailQuery(Owner);
      FDetailQuery.MasterDetailDelay := 500;
      writeln(Outfile,'Repeat test with an active master/detail timer');
      IBQuery.Active := true;
      FDetailQuery.Active := true;
      writeln(Outfile,'Department Record:');
      PrintDataSetRow(IBQuery);
      writeln(Outfile);
      writeln(Outfile,'Employee Records:');
      PrintDataSet(FDetailQuery);
      writeln(Outfile);
      writeln(OutFile,'Advance to next department');
      IBQuery.Next;
      writeln(Outfile,'Department Record:');
      PrintDataSetRow(IBQuery);
      writeln(Outfile);
      writeln(Outfile,'Employee Records:');
      writeln(Outfile,'Result - before checksynchronise');
      PrintDataSet(FDetailQuery);
      CheckSynchronize(5000);
      writeln(Outfile,'Result - after checksynchronise');
      PrintDataSet(FDetailQuery);
    finally
      IBGUIInterface := nil;
    end;
  finally
    IBDatabase.Connected := false;
  end;
end;

initialization
  RegisterTest(TTest19);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	7769 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
2			* IBX Test suite. This program is used to test the IBX non-visual
3			* components and provides a semi-automated pass/fail check for each test.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2021 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27	tony	315	unit Test19;
28
29			{$mode objfpc}{$H+}
30
31			{Test 19: Master/Detail Queries}
32
33			{ Description
34			Two IBQueries are opened in a master detail relationship. The master is scrolled
35			and the secondary shown to follow suite.
36			}
37
38			interface
39
40			uses
41			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBQuery,
42			fpTimer, IBInternals;
43
44			const
45			aTestID = '19';
46			aTestTitle = 'TIBDataset Master/Detail Queries';
47
48			type
49
50			{ TTest19 }
51
52			TTest19 = class(TIBXTestBase)
53			private
54			FDetailQuery: TIBQuery;
55			FMasterSource: TDataSource;
56			procedure InitDetailQuery(Application: TTestApplication);
57			protected
58			procedure CreateObjects(Application: TTestApplication); override;
59			function GetTestID: AnsiString; override;
60			function GetTestTitle: AnsiString; override;
61			procedure InitTest; override;
62			public
63			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64			end;
65
66			{ TNonGUITimer }
67
68			TNonGUITimer = class(TInterfacedObject,IIBTimerInf)
69			private
70			FTimer: TFPTimer;
71			public
72			constructor Create;
73			destructor Destroy; override;
74			public
75			function GetEnabled: boolean;
76			procedure SetEnabled(Value: Boolean);
77			function GetInterval: Cardinal;
78			procedure SetInterval(Value: Cardinal);
79			function GetOnTimer: TNotifyEvent;
80			procedure SetOnTimer(Value: TNotifyEvent);
81			function GetOnStartTimer: TNotifyEvent;
82			procedure SetOnStartTimer(Value: TNotifyEvent);
83			function GetOnStopTimer: TNotifyEvent;
84			procedure SetOnStopTimer(Value: TNotifyEvent);
85			property Enabled: Boolean read GetEnabled write SetEnabled;
86			property Interval: Cardinal read GetInterval write SetInterval;
87			property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
88			property OnStartTimer: TNotifyEvent read GetOnStartTimer write SetOnStartTimer;
89			property OnStopTimer: TNotifyEvent read GetOnStopTimer write SetOnStopTimer;
90			end;
91
92			{ TDummyGUIInterface }
93
94			TDummyGUIInterface = class(TInterfacedObject,IIBGUIInterface)
95			public
96			function ServerLoginDialog(var AServerName: string;
97			var AUserName, APassword: string): Boolean;
98			function LoginDialogEx(var ADatabaseName: string;
99			var AUserName, APassword: string;
100			NameReadOnly: Boolean): Boolean;
101			procedure SetCursor;
102			procedure RestoreCursor;
103			function CreateTimer: IIBTimerInf;
104			end;
105
106
107			implementation
108
109			{ TDummyGUIInterface }
110
111			function TDummyGUIInterface.ServerLoginDialog(var AServerName: string;
112			var AUserName, APassword: string): Boolean;
113			begin
114			Result := false;
115			end;
116
117			function TDummyGUIInterface.LoginDialogEx(var ADatabaseName: string;
118			var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
119			begin
120			Result := false;
121			end;
122
123			procedure TDummyGUIInterface.SetCursor;
124			begin
125
126			end;
127
128			procedure TDummyGUIInterface.RestoreCursor;
129			begin
130
131			end;
132
133			function TDummyGUIInterface.CreateTimer: IIBTimerInf;
134			begin
135			Result := TNonGUITimer.Create;
136			end;
137
138			{ TNonGUITimer }
139
140			constructor TNonGUITimer.Create;
141			begin
142			inherited Create;
143			FTimer := TFPTimer.Create(nil);
144			end;
145
146			destructor TNonGUITimer.Destroy;
147			begin
148			if FTimer <> nil then FTimer.Free;
149			inherited Destroy;
150			end;
151
152			function TNonGUITimer.GetEnabled: boolean;
153			begin
154			Result := FTimer.Enabled;
155			end;
156
157			procedure TNonGUITimer.SetEnabled(Value: Boolean);
158			begin
159			FTimer.Enabled := Value;
160			end;
161
162			function TNonGUITimer.GetInterval: Cardinal;
163			begin
164			Result := FTimer.Interval;
165			end;
166
167			procedure TNonGUITimer.SetInterval(Value: Cardinal);
168			begin
169			FTimer.Interval := Value;
170			end;
171
172			function TNonGUITimer.GetOnTimer: TNotifyEvent;
173			begin
174			Result := FTimer.OnTimer;
175			end;
176
177			procedure TNonGUITimer.SetOnTimer(Value: TNotifyEvent);
178			begin
179			FTimer.OnTimer := Value;
180			end;
181
182			function TNonGUITimer.GetOnStartTimer: TNotifyEvent;
183			begin
184			Result := FTimer.OnStartTimer;
185			end;
186
187			procedure TNonGUITimer.SetOnStartTimer(Value: TNotifyEvent);
188			begin
189			FTimer.OnStartTimer := Value;
190			end;
191
192			function TNonGUITimer.GetOnStopTimer: TNotifyEvent;
193			begin
194			Result := FTimer.OnStopTimer;
195			end;
196
197			procedure TNonGUITimer.SetOnStopTimer(Value: TNotifyEvent);
198			begin
199			FTimer.OnStopTimer := Value;
200			end;
201
202			{ TTest19 }
203
204			procedure TTest19.InitDetailQuery(Application: TTestApplication);
205			begin
206			FDetailQuery := TIBQuery.Create(Application);
207			FDetailQuery.Database := IBDatabase;
208			FDetailQuery.Transaction := IBTransaction;
209			FDetailQuery.SQL.Text := 'Select * From EMPLOYEE Where DEPT_NO = :DEPT_NO';
210			FDetailQuery.DataSource := FMasterSource;
211			end;
212
213			procedure TTest19.CreateObjects(Application: TTestApplication);
214			begin
215			inherited CreateObjects(Application);
216			IBQuery.SQL.Text := 'Select * From DEPARTMENT';
217			FMasterSource := TDataSource.Create(Application);
218			FMasterSource.DataSet := IBQuery;
219			InitDetailQuery(Application);
220			end;
221
222			function TTest19.GetTestID: AnsiString;
223			begin
224			Result := aTestID;
225			end;
226
227			function TTest19.GetTestTitle: AnsiString;
228			begin
229			Result := aTestTitle;
230			end;
231
232			procedure TTest19.InitTest;
233			begin
234			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
235			ReadOnlyTransaction;
236			end;
237
238			procedure TTest19.RunTest(CharSet: AnsiString; SQLDialect: integer);
239			begin
240			IBDatabase.Connected := true;
241			try
242			IBTransaction.Active := true;
243			IBQuery.Active := true;
244			FDetailQuery.Active := true;
245			writeln(Outfile,'Department Record:');
246			PrintDataSetRow(IBQuery);
247			writeln(Outfile);
248			writeln(Outfile,'Employee Records:');
249			PrintDataSet(FDetailQuery);
250			writeln(Outfile);
251			writeln(OutFile,'Advance to next department');
252			IBQuery.Next;
253			writeln(Outfile,'Department Record:');
254			PrintDataSetRow(IBQuery);
255			writeln(Outfile);
256			writeln(Outfile,'Employee Records:');
257			PrintDataSet(FDetailQuery);
258			FDetailQuery.Active := false;
259			IBQuery.Active := false;
260
261			FreeAndNil(FDetailQuery);
262			IBGUIInterface := TDummyGUIInterface.Create;
263			try
264			InitDetailQuery(Owner);
265			FDetailQuery.MasterDetailDelay := 500;
266			writeln(Outfile,'Repeat test with an active master/detail timer');
267			IBQuery.Active := true;
268			FDetailQuery.Active := true;
269			writeln(Outfile,'Department Record:');
270			PrintDataSetRow(IBQuery);
271			writeln(Outfile);
272			writeln(Outfile,'Employee Records:');
273			PrintDataSet(FDetailQuery);
274			writeln(Outfile);
275			writeln(OutFile,'Advance to next department');
276			IBQuery.Next;
277			writeln(Outfile,'Department Record:');
278			PrintDataSetRow(IBQuery);
279			writeln(Outfile);
280			writeln(Outfile,'Employee Records:');
281			writeln(Outfile,'Result - before checksynchronise');
282			PrintDataSet(FDetailQuery);
283			CheckSynchronize(5000);
284			writeln(Outfile,'Result - after checksynchronise');
285			PrintDataSet(FDetailQuery);
286			finally
287			IBGUIInterface := nil;
288			end;
289			finally
290			IBDatabase.Connected := false;
291			end;
292			end;
293
294			initialization
295			RegisterTest(TTest19);
296
297			end.
298