trunk/testsuite/Test15.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 Test15;

{$mode objfpc}{$H+}

{ Test 15: IBStored Proc with packages}

{
This demonstrates the use of TIBStoredProc with the Firebird 3 packages example
provided with the Firebird 3 source code. A database is created in a temporary
location when the application is first run. Once this completes, IBStoredProc2 calls
the global stored procedure "test", which populates the temporary table FB$OUT.

IBStoredProc1 then calls the GET_LINES procedure in the FB$OUT package. It returns
a text blob which is then printed out.

}


interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBStoredProc,
  IBDatabase;

const
  aTestID    = '15';
  aTestTitle = 'IBStored Proc with packages';

type

{ TTest15 }

  TTest15 = class(TIBXTestBase)
  private
    FIBStoredProc1: TIBStoredProc;
    FIBStoredProc2: TIBStoredProc;
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
    procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
    function SkipTest: boolean; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest15 }

procedure TTest15.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  IBQuery.SQL.Text := 'Select A.LINE_NUM, A.CONTENT From FB$OUT_TABLE A';
  FIBStoredProc1 := TIBStoredProc.Create(Application);
  FIBStoredProc1.Database := IBDatabase;
  FIBStoredProc2 := TIBStoredProc.Create(Application);
  FIBStoredProc2.Database := IBDatabase;
end;

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

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

procedure TTest15.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  FIBStoredProc1.PackageName := 'FB$OUT';
  FIBStoredProc1.StoredProcName := 'GET_LINES';
  FIBStoredProc2.StoredProcName := 'TEST';
  ReadWriteTransaction;
end;

procedure TTest15.InitialiseDatabase(aDatabase: TIBDatabase);
begin
  if aDatabase.attachment.GetODSMajorVersion < 12 then
  begin
    aDatabase.DropDatabase;
    raise ESkipException.Create('This test requires Firebird 3');
  end;
  RunScript(aDatabase,'resources/fbout-header.sql');
  RunScript(aDatabase,'resources/fbout-body.sql');
  RunScript(aDatabase,'resources/fbout-test.sql');
  IBTransaction.Commit;
end;

function TTest15.SkipTest: boolean;
begin
  Result := FirebirdAPI.GetClientMajor < 3;
end;

procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    writeln(Outfile,'-------------------------------------------------------');
    writeln(Outfile,'Exec TEST proc');
    FIBStoredProc2.ExecProc;
    IBTransaction.Commit;
    IBTransaction.Active := true;
    writeln(Outfile,'Show FB$OUT_TABLE');
    IBQuery.Active := true;
    PrintDataSet(IBQuery);
    FIBStoredProc1.ExecProc;
    writeln(OutFile,FIBStoredProc1.ParamByName('LINES').AsString);
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest15);

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:	4219 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 Test15;
28
29			{$mode objfpc}{$H+}
30
31			{ Test 15: IBStored Proc with packages}
32
33			{
34			This demonstrates the use of TIBStoredProc with the Firebird 3 packages example
35			provided with the Firebird 3 source code. A database is created in a temporary
36			location when the application is first run. Once this completes, IBStoredProc2 calls
37			the global stored procedure "test", which populates the temporary table FB$OUT.
38
39			IBStoredProc1 then calls the GET_LINES procedure in the FB$OUT package. It returns
40			a text blob which is then printed out.
41
42			}
43
44
45			interface
46
47			uses
48			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBStoredProc,
49			IBDatabase;
50
51			const
52			aTestID = '15';
53			aTestTitle = 'IBStored Proc with packages';
54
55			type
56
57			{ TTest15 }
58
59			TTest15 = class(TIBXTestBase)
60			private
61			FIBStoredProc1: TIBStoredProc;
62			FIBStoredProc2: TIBStoredProc;
63			protected
64			procedure CreateObjects(Application: TTestApplication); override;
65			function GetTestID: AnsiString; override;
66			function GetTestTitle: AnsiString; override;
67			procedure InitTest; override;
68			procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
69			function SkipTest: boolean; override;
70			public
71			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
72			end;
73
74
75			implementation
76
77			{ TTest15 }
78
79			procedure TTest15.CreateObjects(Application: TTestApplication);
80			begin
81			inherited CreateObjects(Application);
82			IBQuery.SQL.Text := 'Select A.LINE_NUM, A.CONTENT From FB$OUT_TABLE A';
83			FIBStoredProc1 := TIBStoredProc.Create(Application);
84			FIBStoredProc1.Database := IBDatabase;
85			FIBStoredProc2 := TIBStoredProc.Create(Application);
86			FIBStoredProc2.Database := IBDatabase;
87			end;
88
89			function TTest15.GetTestID: AnsiString;
90			begin
91			Result := aTestID;
92			end;
93
94			function TTest15.GetTestTitle: AnsiString;
95			begin
96			Result := aTestTitle;
97			end;
98
99			procedure TTest15.InitTest;
100			begin
101			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
102			IBDatabase.CreateIfNotExists := true;
103			FIBStoredProc1.PackageName := 'FB$OUT';
104			FIBStoredProc1.StoredProcName := 'GET_LINES';
105			FIBStoredProc2.StoredProcName := 'TEST';
106			ReadWriteTransaction;
107			end;
108
109			procedure TTest15.InitialiseDatabase(aDatabase: TIBDatabase);
110			begin
111			if aDatabase.attachment.GetODSMajorVersion < 12 then
112			begin
113			aDatabase.DropDatabase;
114			raise ESkipException.Create('This test requires Firebird 3');
115			end;
116			RunScript(aDatabase,'resources/fbout-header.sql');
117			RunScript(aDatabase,'resources/fbout-body.sql');
118			RunScript(aDatabase,'resources/fbout-test.sql');
119			IBTransaction.Commit;
120			end;
121
122			function TTest15.SkipTest: boolean;
123			begin
124			Result := FirebirdAPI.GetClientMajor < 3;
125			end;
126
127			procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
128			begin
129			IBDatabase.Connected := true;
130			try
131			IBTransaction.Active := true;
132			writeln(Outfile,'-------------------------------------------------------');
133			writeln(Outfile,'Exec TEST proc');
134			FIBStoredProc2.ExecProc;
135			IBTransaction.Commit;
136			IBTransaction.Active := true;
137			writeln(Outfile,'Show FB$OUT_TABLE');
138			IBQuery.Active := true;
139			PrintDataSet(IBQuery);
140			FIBStoredProc1.ExecProc;
141			writeln(OutFile,FIBStoredProc1.ParamByName('LINES').AsString);
142			finally
143			IBDatabase.DropDatabase;
144			end;
145			end;
146
147			initialization
148			RegisterTest(TTest15);
149
150			end.
151