123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145 |
- 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 TestUpdateServerIndexDefs;
- end;
- { TTestTSQLConnection }
- TTestTSQLConnection = class(TSQLDBTestCase)
- private
- published
- procedure ReplaceMe;
- end;
- implementation
- uses sqldbtoolsunit, toolsunit, sqldb;
- { TTestTSQLQuery }
- 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;
- { 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);
- end;
- end.
|