fbintf/testsuite/Test14.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide 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) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test14;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$ENDIF}

{Test 14: Non select procedures}

{ this test creates a new database with a table and two stored procedures.

  1. The first stored procedure is run to populate the table

  2. The second returns data from the table, which is written out.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type
    { TTest14 }

  TTest14 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

{ TTest14 }

const
  SQLInsert = 'Execute Procedure InsertData';

procedure TTest14.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.Prepare(Transaction,sqlInsert);
  Statement.Execute;
end;

const
  sqlCallQueryProc = 'Execute Procedure ShowData';

procedure TTest14.QueryDatabase(Attachment: IAttachment);
var Transaction, Transaction2: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,sqlCallQueryProc);
  PrintMetaData(Statement.MetaData);
  ReportResult(Statement.Execute);
  writeln(OutFile);
  writeln(OutFile,'Repeat with a different execute transaction');
  writeln(OutFile);
  Transaction2 := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  ReportResult(Statement.Execute(Transaction2));
  writeln(OutFile);
  writeln(OutFile,'Repeat with a original transaction');
  writeln(OutFile);
  ReportResult(Statement.Execute);
end;

function TTest14.TestTitle: AnsiString;
begin
  Result := 'Test 14: Non select procedures';
end;

const
  sqlCreateTable =
    'Create Table TestData( '+
    'RowID Integer not null,'+
    'Title VarChar(32),'+
    'Primary Key(RowID)'+
    ')';

  sqlCreateProc1 =
    'Create Procedure InsertData As '+
    'Begin ' +
    'Insert into TestData(RowID,Title) VALUES (1,''Testing''); '+
    'End';

  sqlCreateProc2 =
    'Create Procedure ShowData Returns (RowID Integer, Title VarChar(32)) '+
    'As Begin '+
    'Select First 1 RowID,Title From TestData Into :RowID,:Title; '+
    'End';


procedure TTest14.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  writeln(OutFile,'Default Character set Name = ',Trim(Attachment.OpenCursorAtStart('Select RDB$CHARACTER_SET_NAME From RDB$Database')[0].AsString));
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc1);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc2);

  UpdateDatabase(Attachment);
  QueryDatabase(Attachment);
  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest14);
end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	4574 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	(*
2			* Firebird Interface (fbintf) Test suite. This program is used to
3			* test the Firebird Pascal Interface and provide a semi-automated
4			* pass/fail check for each test.
5			*
6			* The contents of this file are subject to the Initial Developer's
7			* Public License Version 1.0 (the "License"); you may not use this
8			* file except in compliance with the License. You may obtain a copy
9			* of the License here:
10			*
11			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12			*
13			* Software distributed under the License is distributed on an "AS
14			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15			* implied. See the License for the specific language governing rights
16			* and limitations under the License.
17			*
18			* The Initial Developer of the Original Code is Tony Whyman.
19			*
20			* The Original Code is (C) 2016 Tony Whyman, MWA Software
21			* (http://www.mwasoftware.co.uk).
22			*
23			* All Rights Reserved.
24			*
25			* Contributor(s): ______________________________________.
26			*
27			*)
28
29	tony	45	unit Test14;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage UTF8}
37	tony	56	{$ENDIF}
38	tony	45
39			{Test 14: Non select procedures}
40
41			{ this test creates a new database with a table and two stored procedures.
42
43			1. The first stored procedure is run to populate the table
44
45			2. The second returns data from the table, which is written out.
46			}
47
48			interface
49
50			uses
51	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
52	tony	45
53			type
54			{ TTest14 }
55
56	tony	315	TTest14 = class(TFBTestBase)
57	tony	45	private
58			procedure UpdateDatabase(Attachment: IAttachment);
59			procedure QueryDatabase(Attachment: IAttachment);
60			public
61	tony	56	function TestTitle: AnsiString; override;
62			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
63	tony	45	end;
64
65			implementation
66
67			{ TTest14 }
68
69			const
70			SQLInsert = 'Execute Procedure InsertData';
71
72			procedure TTest14.UpdateDatabase(Attachment: IAttachment);
73			var Transaction: ITransaction;
74			Statement: IStatement;
75			begin
76			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
77
78			Statement := Attachment.Prepare(Transaction,sqlInsert);
79			Statement.Execute;
80			end;
81
82			const
83			sqlCallQueryProc = 'Execute Procedure ShowData';
84
85			procedure TTest14.QueryDatabase(Attachment: IAttachment);
86			var Transaction, Transaction2: ITransaction;
87			Statement: IStatement;
88			begin
89			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
90			Statement := Attachment.Prepare(Transaction,sqlCallQueryProc);
91			PrintMetaData(Statement.MetaData);
92			ReportResult(Statement.Execute);
93			writeln(OutFile);
94			writeln(OutFile,'Repeat with a different execute transaction');
95			writeln(OutFile);
96			Transaction2 := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
97			ReportResult(Statement.Execute(Transaction2));
98			writeln(OutFile);
99			writeln(OutFile,'Repeat with a original transaction');
100			writeln(OutFile);
101			ReportResult(Statement.Execute);
102			end;
103
104	tony	56	function TTest14.TestTitle: AnsiString;
105	tony	45	begin
106			Result := 'Test 14: Non select procedures';
107			end;
108
109			const
110			sqlCreateTable =
111			'Create Table TestData( '+
112			'RowID Integer not null,'+
113			'Title VarChar(32),'+
114			'Primary Key(RowID)'+
115			')';
116
117			sqlCreateProc1 =
118			'Create Procedure InsertData As '+
119			'Begin ' +
120			'Insert into TestData(RowID,Title) VALUES (1,''Testing''); '+
121			'End';
122
123			sqlCreateProc2 =
124			'Create Procedure ShowData Returns (RowID Integer, Title VarChar(32)) '+
125			'As Begin '+
126			'Select First 1 RowID,Title From TestData Into :RowID,:Title; '+
127			'End';
128
129
130
131	tony	56	procedure TTest14.RunTest(CharSet: AnsiString; SQLDialect: integer);
132	tony	45	var DPB: IDPB;
133			Attachment: IAttachment;
134			begin
135			DPB := FirebirdAPI.AllocateDPB;
136			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
137			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
138			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
139			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
140			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
141	tony	308	writeln(OutFile,'Default Character set Name = ',Trim(Attachment.OpenCursorAtStart('Select RDB$CHARACTER_SET_NAME From RDB$Database')[0].AsString));
142	tony	45	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
143			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc1);
144			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc2);
145
146			UpdateDatabase(Attachment);
147			QueryDatabase(Attachment);
148			Attachment.DropDatabase;
149			end;
150
151			initialization
152			RegisterTest(TTest14);
153			end.
154