ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test14.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 4574 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
1 (*
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 unit Test14;
30 {$IFDEF MSWINDOWS}
31 {$DEFINE WINDOWS}
32 {$ENDIF}
33
34 {$IFDEF FPC}
35 {$mode delphi}
36 {$codepage UTF8}
37 {$ENDIF}
38
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 Classes, SysUtils, TestApplication, FBTestApp, IB;
52
53 type
54 { TTest14 }
55
56 TTest14 = class(TFBTestBase)
57 private
58 procedure UpdateDatabase(Attachment: IAttachment);
59 procedure QueryDatabase(Attachment: IAttachment);
60 public
61 function TestTitle: AnsiString; override;
62 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
63 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 function TTest14.TestTitle: AnsiString;
105 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 procedure TTest14.RunTest(CharSet: AnsiString; SQLDialect: integer);
132 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 writeln(OutFile,'Default Character set Name = ',Trim(Attachment.OpenCursorAtStart('Select RDB$CHARACTER_SET_NAME From RDB$Database')[0].AsString));
142 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