ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test14.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 3599 byte(s)
Log Message:
Committing updates for Trunk

File Contents

# Content
1 unit Test14;
2 {$IFDEF MSWINDOWS}
3 {$DEFINE WINDOWS}
4 {$ENDIF}
5
6 {$IFDEF FPC}
7 {$mode delphi}
8 {$codepage UTF8}
9 {$ENDIF}
10
11 {Test 14: Non select procedures}
12
13 { this test creates a new database with a table and two stored procedures.
14
15 1. The first stored procedure is run to populate the table
16
17 2. The second returns data from the table, which is written out.
18 }
19
20 interface
21
22 uses
23 Classes, SysUtils, TestManager, IB;
24
25 type
26 { TTest14 }
27
28 TTest14 = class(TTestBase)
29 private
30 procedure UpdateDatabase(Attachment: IAttachment);
31 procedure QueryDatabase(Attachment: IAttachment);
32 public
33 function TestTitle: AnsiString; override;
34 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
35 end;
36
37 implementation
38
39 { TTest14 }
40
41 const
42 SQLInsert = 'Execute Procedure InsertData';
43
44 procedure TTest14.UpdateDatabase(Attachment: IAttachment);
45 var Transaction: ITransaction;
46 Statement: IStatement;
47 begin
48 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
49
50 Statement := Attachment.Prepare(Transaction,sqlInsert);
51 Statement.Execute;
52 end;
53
54 const
55 sqlCallQueryProc = 'Execute Procedure ShowData';
56
57 procedure TTest14.QueryDatabase(Attachment: IAttachment);
58 var Transaction, Transaction2: ITransaction;
59 Statement: IStatement;
60 ResultSet: IResultSet;
61 begin
62 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
63 Statement := Attachment.Prepare(Transaction,sqlCallQueryProc);
64 PrintMetaData(Statement.MetaData);
65 ReportResult(Statement.Execute);
66 writeln(OutFile);
67 writeln(OutFile,'Repeat with a different execute transaction');
68 writeln(OutFile);
69 Transaction2 := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
70 ReportResult(Statement.Execute(Transaction2));
71 writeln(OutFile);
72 writeln(OutFile,'Repeat with a original transaction');
73 writeln(OutFile);
74 ReportResult(Statement.Execute);
75 end;
76
77 function TTest14.TestTitle: AnsiString;
78 begin
79 Result := 'Test 14: Non select procedures';
80 end;
81
82 const
83 sqlCreateTable =
84 'Create Table TestData( '+
85 'RowID Integer not null,'+
86 'Title VarChar(32),'+
87 'Primary Key(RowID)'+
88 ')';
89
90 sqlCreateProc1 =
91 'Create Procedure InsertData As '+
92 'Begin ' +
93 'Insert into TestData(RowID,Title) VALUES (1,''Testing''); '+
94 'End';
95
96 sqlCreateProc2 =
97 'Create Procedure ShowData Returns (RowID Integer, Title VarChar(32)) '+
98 'As Begin '+
99 'Select First 1 RowID,Title From TestData Into :RowID,:Title; '+
100 'End';
101
102
103
104 procedure TTest14.RunTest(CharSet: AnsiString; SQLDialect: integer);
105 var DPB: IDPB;
106 Attachment: IAttachment;
107 begin
108 DPB := FirebirdAPI.AllocateDPB;
109 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
110 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
111 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
112 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
113 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
114 writeln(OutFile,'Default Character set Name = ',Attachment.OpenCursorAtStart('Select RDB$CHARACTER_SET_NAME From RDB$Database')[0].AsString);
115 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
116 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc1);
117 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc2);
118
119 UpdateDatabase(Attachment);
120 QueryDatabase(Attachment);
121 Attachment.DropDatabase;
122 end;
123
124 initialization
125 RegisterTest(TTest14);
126 end.
127