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 (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	8007 byte(s)
Log Message:	IBX Release 2.5.0
#	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	tony	402	procedure QueueAsyncCall(const AMethod: TIBDataEvent; Data: PtrInt);
105	tony	315	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	tony	402	procedure TDummyGUIInterface.QueueAsyncCall(const AMethod: TIBDataEvent;
140			Data: PtrInt);
141			begin
142			raise Exception.Create('Unsupported Dummy interface call');
143			end;
144
145	tony	315	{ 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