1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
unit TestSQLDB;
{
Unit tests which are specific to the sqlDB components like TSQLQuery, TSQLConnection.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry,
db;
type
{ TSQLDBTestCase }
TSQLDBTestCase = class(TTestCase)
protected
procedure SetUp; override;
procedure TearDown; override;
end;
{ TTestTSQLQuery }
TTestTSQLQuery = class(TSQLDBTestCase)
private
published
procedure TestMasterDetail;
procedure TestUpdateServerIndexDefs;
end;
{ TTestTSQLConnection }
TTestTSQLConnection = class(TSQLDBTestCase)
private
published
procedure ReplaceMe;
end;
{ TTestTSQLScript }
TTestTSQLScript = class(TSQLDBTestCase)
published
procedure TestExecuteScript;
end;
implementation
uses sqldbtoolsunit, toolsunit, sqldb;
{ TTestTSQLQuery }
procedure TTestTSQLQuery.TestMasterDetail;
var MasterQuery, DetailQuery: TSQLQuery;
MasterSource: TDataSource;
begin
with TSQLDBConnector(DBConnector) do
try
MasterQuery := GetNDataset(10) as TSQLQuery;
MasterSource := TDatasource.Create(nil);
MasterSource.DataSet := MasterQuery;
DetailQuery := Query;
DetailQuery.SQL.Text := 'select NAME from FPDEV where ID=:ID';
DetailQuery.DataSource := MasterSource;
MasterQuery.Open;
DetailQuery.Open;
CheckEquals('TestName1', DetailQuery.Fields[0].AsString);
MasterQuery.MoveBy(3);
CheckEquals('TestName4', DetailQuery.Fields[0].AsString);
finally
MasterSource.Free;
end;
end;
procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
var Q: TSQLQuery;
name1, name2, name3: string;
begin
// Test retrieval of information about indexes on unquoted and quoted table names
// (tests also case-sensitivity for DB's that support case-sensitivity of quoted identifiers)
// For ODBC Firebird/Interbase we must define primary key as named constraint and
// in ODBC driver must be set: "quoted identifiers" and "sensitive identifier"
// See also: TTestFieldTypes.TestUpdateIndexDefs
with TSQLDBConnector(DBConnector) do
begin
// SQLite ignores case-sensitivity of quoted table names
// MS SQL Server case-sensitivity of identifiers depends on the case-sensitivity of default collation of the database
// MySQL case-sensitivity depends on case-sensitivity of server's file system
if SQLServerType in [ssMSSQL,ssSQLite{$IFDEF WINDOWS},ssMySQL{$ENDIF}] then
name1 := Connection.FieldNameQuoteChars[0]+'fpdev 2'+Connection.FieldNameQuoteChars[1]
else
name1 := 'FPDEV2';
ExecuteDirect('create table '+name1+' (id integer not null, constraint PK_FPDEV21 primary key(id))');
// same but quoted table name
name2 := Connection.FieldNameQuoteChars[0]+'FPdev2'+Connection.FieldNameQuoteChars[1];
ExecuteDirect('create table '+name2+' (ID2 integer not null, constraint PK_FPDEV22 primary key(ID2))');
// embedded quote in table name
if SQLServerType in [ssMySQL] then
name3 := '`FPdev``2`'
else
name3 := Connection.FieldNameQuoteChars[0]+'FPdev""2'+Connection.FieldNameQuoteChars[1];
ExecuteDirect('create table '+name3+' (Id3 integer not null, constraint PK_FPDEV23 primary key(Id3))');
CommitDDL;
end;
try
Q := TSQLDBConnector(DBConnector).Query;
Q.SQL.Text:='select * from '+name1;
Q.Prepare;
Q.ServerIndexDefs.Update;
CheckEquals(1, Q.ServerIndexDefs.Count);
Q.SQL.Text:='select * from '+name2;
Q.Prepare;
Q.ServerIndexDefs.Update;
CheckEquals(1, Q.ServerIndexDefs.Count, '2.1');
CheckTrue(CompareText('ID2', Q.ServerIndexDefs[0].Fields)=0, '2.2'+Q.ServerIndexDefs[0].Fields);
CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '2.3');
Q.SQL.Text:='select * from '+name3;
Q.Prepare;
Q.ServerIndexDefs.Update;
CheckEquals(1, Q.ServerIndexDefs.Count, '3.1');
CheckTrue(CompareText('ID3', Q.ServerIndexDefs[0].Fields)=0, '3.2');
CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '3.3');
finally
Q.UnPrepare;
with TSQLDBConnector(DBConnector) do
begin
ExecuteDirect('DROP TABLE '+name1);
ExecuteDirect('DROP TABLE '+name2);
ExecuteDirect('DROP TABLE '+name3);
CommitDDL;
end;
end;
end;
{ TTestTSQLConnection }
procedure TTestTSQLConnection.ReplaceMe;
begin
// replace this procedure with any test for TSQLConnection
end;
{ TTestTSQLScript }
procedure TTestTSQLScript.TestExecuteScript;
var Ascript : TSQLScript;
begin
Ascript := TSQLScript.Create(nil);
try
with Ascript do
begin
DataBase := TSQLDBConnector(DBConnector).Connection;
Transaction := TSQLDBConnector(DBConnector).Transaction;
Script.Clear;
Script.Append('create table a (id int);');
Script.Append('create table b (id int);');
ExecuteScript;
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
TSQLDBConnector(DBConnector).CommitDDL;
end;
finally
AScript.Free;
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
TSQLDBConnector(DBConnector).CommitDDL;
end;
end;
{ TSQLDBTestCase }
procedure TSQLDBTestCase.SetUp;
begin
inherited SetUp;
InitialiseDBConnector;
DBConnector.StartTest;
end;
procedure TSQLDBTestCase.TearDown;
begin
DBConnector.StopTest;
if assigned(DBConnector) then
with TSQLDBConnector(DBConnector) do
Transaction.Rollback;
FreeDBConnector;
inherited TearDown;
end;
initialization
if uppercase(dbconnectorname)='SQL' then
begin
RegisterTest(TTestTSQLQuery);
RegisterTest(TTestTSQLConnection);
RegisterTest(TTestTSQLScript);
end;
end.
|
