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, 2 months ago) by tony
Content type:	text/x-pascal
File size:	7769 byte(s)
Log Message:	Fixed Merged
#	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	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