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;
    procedure QueueAsyncCall(const AMethod: TIBDataEvent;  Data: PtrInt);
  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;

procedure TDummyGUIInterface.QueueAsyncCall(const AMethod: TIBDataEvent;
  Data: PtrInt);
begin
  raise Exception.Create('Unsupported Dummy interface call');
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:	402
Committed:	Mon Aug 1 10:07:24 2022 UTC (20 months, 4 weeks ago) by tony
Content type:	text/x-pascal
File size:	8007 byte(s)
Log Message:	IBX Release 2.5.0
#	Content
1	(*
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	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	procedure QueueAsyncCall(const AMethod: TIBDataEvent; Data: PtrInt);
105	end;
106
107
108	implementation
109
110	{ TDummyGUIInterface }
111
112	function TDummyGUIInterface.ServerLoginDialog(var AServerName: string;
113	var AUserName, APassword: string): Boolean;
114	begin
115	Result := false;
116	end;
117
118	function TDummyGUIInterface.LoginDialogEx(var ADatabaseName: string;
119	var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
120	begin
121	Result := false;
122	end;
123
124	procedure TDummyGUIInterface.SetCursor;
125	begin
126
127	end;
128
129	procedure TDummyGUIInterface.RestoreCursor;
130	begin
131
132	end;
133
134	function TDummyGUIInterface.CreateTimer: IIBTimerInf;
135	begin
136	Result := TNonGUITimer.Create;
137	end;
138
139	procedure TDummyGUIInterface.QueueAsyncCall(const AMethod: TIBDataEvent;
140	Data: PtrInt);
141	begin
142	raise Exception.Create('Unsupported Dummy interface call');
143	end;
144
145	{ TNonGUITimer }
146
147	constructor TNonGUITimer.Create;
148	begin
149	inherited Create;
150	FTimer := TFPTimer.Create(nil);
151	end;
152
153	destructor TNonGUITimer.Destroy;
154	begin
155	if FTimer <> nil then FTimer.Free;
156	inherited Destroy;
157	end;
158
159	function TNonGUITimer.GetEnabled: boolean;
160	begin
161	Result := FTimer.Enabled;
162	end;
163
164	procedure TNonGUITimer.SetEnabled(Value: Boolean);
165	begin
166	FTimer.Enabled := Value;
167	end;
168
169	function TNonGUITimer.GetInterval: Cardinal;
170	begin
171	Result := FTimer.Interval;
172	end;
173
174	procedure TNonGUITimer.SetInterval(Value: Cardinal);
175	begin
176	FTimer.Interval := Value;
177	end;
178
179	function TNonGUITimer.GetOnTimer: TNotifyEvent;
180	begin
181	Result := FTimer.OnTimer;
182	end;
183
184	procedure TNonGUITimer.SetOnTimer(Value: TNotifyEvent);
185	begin
186	FTimer.OnTimer := Value;
187	end;
188
189	function TNonGUITimer.GetOnStartTimer: TNotifyEvent;
190	begin
191	Result := FTimer.OnStartTimer;
192	end;
193
194	procedure TNonGUITimer.SetOnStartTimer(Value: TNotifyEvent);
195	begin
196	FTimer.OnStartTimer := Value;
197	end;
198
199	function TNonGUITimer.GetOnStopTimer: TNotifyEvent;
200	begin
201	Result := FTimer.OnStopTimer;
202	end;
203
204	procedure TNonGUITimer.SetOnStopTimer(Value: TNotifyEvent);
205	begin
206	FTimer.OnStopTimer := Value;
207	end;
208
209	{ TTest19 }
210
211	procedure TTest19.InitDetailQuery(Application: TTestApplication);
212	begin
213	FDetailQuery := TIBQuery.Create(Application);
214	FDetailQuery.Database := IBDatabase;
215	FDetailQuery.Transaction := IBTransaction;
216	FDetailQuery.SQL.Text := 'Select * From EMPLOYEE Where DEPT_NO = :DEPT_NO';
217	FDetailQuery.DataSource := FMasterSource;
218	end;
219
220	procedure TTest19.CreateObjects(Application: TTestApplication);
221	begin
222	inherited CreateObjects(Application);
223	IBQuery.SQL.Text := 'Select * From DEPARTMENT';
224	FMasterSource := TDataSource.Create(Application);
225	FMasterSource.DataSet := IBQuery;
226	InitDetailQuery(Application);
227	end;
228
229	function TTest19.GetTestID: AnsiString;
230	begin
231	Result := aTestID;
232	end;
233
234	function TTest19.GetTestTitle: AnsiString;
235	begin
236	Result := aTestTitle;
237	end;
238
239	procedure TTest19.InitTest;
240	begin
241	IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
242	ReadOnlyTransaction;
243	end;
244
245	procedure TTest19.RunTest(CharSet: AnsiString; SQLDialect: integer);
246	begin
247	IBDatabase.Connected := true;
248	try
249	IBTransaction.Active := true;
250	IBQuery.Active := true;
251	FDetailQuery.Active := true;
252	writeln(Outfile,'Department Record:');
253	PrintDataSetRow(IBQuery);
254	writeln(Outfile);
255	writeln(Outfile,'Employee Records:');
256	PrintDataSet(FDetailQuery);
257	writeln(Outfile);
258	writeln(OutFile,'Advance to next department');
259	IBQuery.Next;
260	writeln(Outfile,'Department Record:');
261	PrintDataSetRow(IBQuery);
262	writeln(Outfile);
263	writeln(Outfile,'Employee Records:');
264	PrintDataSet(FDetailQuery);
265	FDetailQuery.Active := false;
266	IBQuery.Active := false;
267
268	FreeAndNil(FDetailQuery);
269	IBGUIInterface := TDummyGUIInterface.Create;
270	try
271	InitDetailQuery(Owner);
272	FDetailQuery.MasterDetailDelay := 500;
273	writeln(Outfile,'Repeat test with an active master/detail timer');
274	IBQuery.Active := true;
275	FDetailQuery.Active := true;
276	writeln(Outfile,'Department Record:');
277	PrintDataSetRow(IBQuery);
278	writeln(Outfile);
279	writeln(Outfile,'Employee Records:');
280	PrintDataSet(FDetailQuery);
281	writeln(Outfile);
282	writeln(OutFile,'Advance to next department');
283	IBQuery.Next;
284	writeln(Outfile,'Department Record:');
285	PrintDataSetRow(IBQuery);
286	writeln(Outfile);
287	writeln(Outfile,'Employee Records:');
288	writeln(Outfile,'Result - before checksynchronise');
289	PrintDataSet(FDetailQuery);
290	CheckSynchronize(5000);
291	writeln(Outfile,'Result - after checksynchronise');
292	PrintDataSet(FDetailQuery);
293	finally
294	IBGUIInterface := nil;
295	end;
296	finally
297	IBDatabase.Connected := false;
298	end;
299	end;
300
301	initialization
302	RegisterTest(TTest19);
303
304	end.
305