ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test3.pas
Revision: 70
Committed: Thu Oct 26 12:59:51 2017 UTC (7 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 4815 byte(s)
Log Message:
FBAttachment: Avoid string reference count error when processing an Ansistring
    parameter in an array of const passed to IAttachment.OpenCursor, etc.

FBAttachment: Allow for WideString and UnicodeString parameters in an array
    of const passed to IAttachment.OpenCursor, etc.

File Contents

# User Rev Content
1 tony 45 unit Test3;
2 tony 56 {$IFDEF MSWINDOWS}
3     {$DEFINE WINDOWS}
4     {$ENDIF}
5 tony 45
6 tony 56 {$IFDEF FPC}
7     {$mode delphi}
8 tony 45 {$codepage utf8}
9 tony 56 {$ENDIF}
10 tony 45
11     { Test 3: ad hoc queries}
12    
13     { This test opens the employee example databases with the supplied user name/password
14     and runs several queries:
15    
16     1. The convenience function OpenCursorAtStart is used to return a count of the
17     records in the employee database. This creates its own read only transaction.
18    
19     2. A parameterised query is used to delete a record. The record count is repeated
20     using the same transaction as the deletion. The transaction is rolled back.
21    
22     3. Rollback is demonstrated by returning a record count. This time creating the
23     transaction in place.
24    
25     4. The above two steps are repeated but with a named parameter ad an implicit end to the transaction.
26    
27     5. Note implicit disconnect on end
28     }
29    
30     interface
31    
32     uses
33     Classes, SysUtils, TestManager, IB;
34    
35     type
36     { TTest3 }
37    
38     TTest3 = class(TTestBase)
39     private
40     procedure DoQuery(Attachment: IAttachment);
41     public
42 tony 56 function TestTitle: AnsiString; override;
43     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
44 tony 45 end;
45    
46    
47     implementation
48    
49     { TTest3 }
50    
51     procedure TTest3.DoQuery(Attachment: IAttachment);
52     var Transaction: ITransaction;
53     ResultSet: IResultSet;
54     Statement: IStatement;
55     TPB: ITPB;
56 tony 70 us: UnicodeString;
57 tony 45 begin
58     writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE')[0].AsInteger);
59    
60     TPB := FirebirdAPI.AllocateTPB;
61     TPB.Add(isc_tpb_write);
62     TPB.Add(isc_tpb_nowait);
63     TPB.Add(isc_tpb_concurrency);
64     TPB.Add(isc_tpb_lock_read).AsString := 'EMPLOYEE';
65     TPB.Add(isc_tpb_protected);
66     Transaction := Attachment.StartTransaction(TPB,taRollback);
67     Attachment.ExecuteSQL(Transaction, 'Execute Procedure DELETE_EMPLOYEE ?', [8]);
68    
69     ResultSet := Attachment.OpenCursorAtStart(
70     Transaction,
71     'Select count(*) from EMPLOYEE',3);
72    
73     writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
74    
75     ResultSet := Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE');
76     writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
77    
78 tony 56 {$IFNDEF FPC}
79     Transaction.Rollback; {Delphi does not dispose of interfaces until the end of the function
80     so we need to explicitly rollback here. FPC will dispose of the
81     interface as soon as it is overwritten - hence this is not needed.}
82     {$ENDIF}
83 tony 45 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback);
84     Statement := Attachment.PrepareWithNamedParameters(Transaction,'Execute Procedure DELETE_EMPLOYEE :EMP_NO',3);
85     Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
86     Statement.Execute;
87    
88     ResultSet := Attachment.OpenCursorAtStart(
89     Transaction,
90     'Select count(*) from EMPLOYEE',3);
91    
92     writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
93    
94     Transaction := nil; {implicit rollback}
95    
96    
97     writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart(
98     Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
99     'Select count(*) As Counter from EMPLOYEE',3)[0].AsInteger);
100    
101     writeln(OutFile,'Constrained Employee Count = ',Attachment.OpenCursorAtStart(
102     Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
103     'Select count(*) As Counter from EMPLOYEE Where EMP_NO < ?',3,[8])[0].AsInteger);
104    
105 tony 70 writeln(OutFile,'"Johnson" Employee Count = ',Attachment.OpenCursorAtStart(
106     Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
107     'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,['Johnson'])[0].AsInteger);
108    
109     us := UTF8Decode('Yanowski'); {Test a UnicodeString as a parameter}
110    
111     writeln(OutFile,'"Yanowski" Employee Count = ',Attachment.OpenCursorAtStart(
112     Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
113     'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,[us])[0].AsInteger);
114    
115 tony 45 end;
116    
117 tony 56 function TTest3.TestTitle: AnsiString;
118 tony 45 begin
119     Result := 'Test 3: ad hoc queries';
120     end;
121    
122 tony 56 procedure TTest3.RunTest(CharSet: AnsiString; SQLDialect: integer);
123 tony 45 var Attachment: IAttachment;
124     DPB: IDPB;
125     begin
126     DPB := FirebirdAPI.AllocateDPB;
127     DPB.Add(isc_dpb_user_name).AsString := Owner.GetUserName;
128     DPB.Add(isc_dpb_password).AsString := Owner.GetPassword;
129     DPB.Add(isc_dpb_lc_ctype).AsString := CharSet;
130     DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect;
131    
132     writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
133     Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
134     writeln(OutFile,'Database Open');
135     DoQuery(Attachment);
136     end;
137    
138     initialization
139     RegisterTest(TTest3);
140    
141     end.
142