123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020 |
- unit TestSQLDB;
- {
- Unit tests which are specific to the sqlDB components like TSQLQuery, TSQLConnection.
- }
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, sqldb, SysUtils, fpcunit, testregistry,
- sqldbtoolsunit,toolsunit, db;
- type
- { TSQLDBTestCase }
- TSQLDBTestCase = class(TTestCase)
- private
- function GetSQLDBConnector: TSQLDBConnector;
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Property SQLDBConnector : TSQLDBConnector Read GetSQLDBConnector;
- end;
- { TTestTSQLQuery }
- TTestTSQLQuery = class(TSQLDBTestCase)
- private
- FMyQ: TSQLQuery;
- procedure DoAfterPost(DataSet: TDataSet);
- Procedure DoApplyUpdates;
- Procedure TrySetQueryOptions;
- Procedure TrySetPacketRecords;
- Protected
- Procedure Setup; override;
- published
- procedure TestMasterDetail;
- procedure TestUpdateServerIndexDefs;
- Procedure TestKeepOpenOnCommit;
- Procedure TestKeepOpenOnCommitPacketRecords;
- Procedure TestCheckSettingsOnlyWhenInactive;
- Procedure TestAutoApplyUpdatesPost;
- Procedure TestAutoApplyUpdatesDelete;
- Procedure TestCheckRowsAffected;
- Procedure TestAutoCommit;
- Procedure TestGeneratedRefreshSQL;
- Procedure TestGeneratedRefreshSQL1Field;
- Procedure TestGeneratedRefreshSQLNoKey;
- Procedure TestRefreshSQL;
- Procedure TestRefreshSQLMultipleRecords;
- Procedure TestRefreshSQLNoRecords;
- Procedure TestFetchAutoInc;
- procedure TestSequence;
- procedure TestReturningInsert;
- procedure TestReturningUpdate;
- end;
- { TTestTSQLConnection }
- TTestTSQLConnection = class(TSQLDBTestCase)
- private
- procedure SetImplicit;
- procedure TestImplicitTransaction;
- procedure TestImplicitTransaction2;
- procedure TestImplicitTransactionNotAssignable;
- procedure TestImplicitTransactionOK;
- procedure TryOpen;
- published
- procedure TestUseImplicitTransaction;
- procedure TestUseExplicitTransaction;
- procedure TestExplicitConnect;
- procedure TestGetStatementInfo;
- end;
- { TTestTSQLScript }
- TTestTSQLScript = class(TSQLDBTestCase)
- published
- procedure TestExecuteScript;
- procedure TestScriptColon; //bug 25334
- procedure TestUseCommit; //E.g. Firebird cannot use COMMIT RETAIN if mixing DDL and DML in a script
- end;
- implementation
- { TTestTSQLQuery }
- procedure TTestTSQLQuery.Setup;
- begin
- inherited Setup;
- SQLDBConnector.Connection.Options:=[];
- end;
- procedure TTestTSQLQuery.TestMasterDetail;
- var MasterQuery, DetailQuery: TSQLQuery;
- MasterSource: TDataSource;
- begin
- with SQLDBConnector 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);
- MasterQuery.Close;
- CheckTrue(DetailQuery.Active, 'Detail dataset should remain intact, when master dataset is closed');
- 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 SQLDBConnector 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 := SQLDBConnector.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 SQLDBConnector do
- begin
- ExecuteDirect('DROP TABLE '+name1);
- ExecuteDirect('DROP TABLE '+name2);
- ExecuteDirect('DROP TABLE '+name3);
- CommitDDL;
- end;
- end;
- end;
- procedure TTestTSQLQuery.TestKeepOpenOnCommit;
- var Q: TSQLQuery;
- I: Integer;
- begin
- // Test that for a SQL query with Options=sqoKeepOpenOnCommit, calling commit does not close the dataset.
- // Test also that an edit still works.
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- Transaction.Commit;
- for I:=1 to 20 do
- ExecuteDirect(Format('INSERT INTO FPDEV2 values (%d,''%.6d'')',[i,i]));
- Transaction.Commit;
- Q := SQLDBConnector.Query;
- Q.SQL.Text:='select * from FPDEV2';
- Q.Options:=[sqoKeepOpenOnCommit,sqoRefreshUsingSelect];
- AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
- Q.Open;
- AssertEquals('Got all records',20,Q.RecordCount);
- Q.SQLTransaction.Commit;
- AssertTrue('Still open after transaction',Q.Active);
- // Now check editing
- Q.Locate('id',20,[]);
- Q.Edit;
- Q.FieldByName('a').AsString:='abc';
- Q.Post;
- AssertTrue('Have updates pending',Q.UpdateStatus=usModified);
- Q.ApplyUpdates;
- AssertTrue('Have no more updates pending',Q.UpdateStatus=usUnmodified);
- Q.Close;
- Q.SQL.Text:='select * from FPDEV2 where (id=20) and (a=''abc'')';
- Q.Open;
- AssertTrue('Have modified data record in database', not (Q.EOF AND Q.BOF));
- end;
- end;
- procedure TTestTSQLQuery.TrySetPacketRecords;
- begin
- FMyQ.PacketRecords:=10;
- end;
- procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
- begin
- with SQLDBConnector do
- begin
- FMyQ := SQLDBConnector.Query;
- FMyQ.Options:=[sqoKeepOpenOnCommit];
- AssertException('Cannot set PacketRecords when sqoKeepOpenOnCommit is active',EDatabaseError,@TrySetPacketRecords);
- end;
- end;
- procedure TTestTSQLQuery.TrySetQueryOptions;
- begin
- FMyQ.Options:=[sqoKeepOpenOnCommit];
- end;
- procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
- begin
- // Check that we can only set QueryOptions when the query is inactive.
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- Transaction.Commit;
- ExecuteDirect(Format('INSERT INTO FPDEV2 values (%d,''%.6d'')',[1,1]));
- Transaction.Commit;
- FMyQ := SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- FMyQ := SQLDBConnector.Query;
- FMyQ.Open;
- AssertException('Cannot set Options when query is active',EDatabaseError,@TrySetQueryOptions);
- end;
- end;
- procedure TTestTSQLQuery.DoAfterPost(DataSet: TDataSet);
- begin
- AssertTrue('Have modifications in after post',FMyq.UpdateStatus=usModified)
- end;
- procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
- var Q: TSQLQuery;
- I: Integer;
- begin
- // Test that if sqoAutoApplyUpdates is in QueryOptions, then POST automatically does an ApplyUpdates
- // Test also that POST afterpost event is backwards compatible.
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- Transaction.COmmit;
- for I:=1 to 2 do
- ExecuteDirect(Format('INSERT INTO FPDEV2 values (%d,''%.6d'')',[i,i]));
- Transaction.COmmit;
- Q := SQLDBConnector.Query;
- FMyQ:=Q; // so th event handler can reach it.
- Q.SQL.Text:='select * from FPDEV2';
- Q.Options:=[sqoAutoApplyUpdates];
- // We must test that in AfterPost, the modification is still there, for backwards compatibilty
- Q.AfterPost:=@DoAfterPost;
- Q.Open;
- AssertEquals('Got all records',2,Q.RecordCount);
- // Now check editing
- Q.Locate('id',2,[]);
- Q.Edit;
- Q.FieldByName('a').AsString:='abc';
- Q.Post;
- AssertTrue('Have no more updates pending',Q.UpdateStatus=usUnmodified);
- Q.Close;
- Q.SQL.Text:='select * from FPDEV2 where (id=2) and (a=''abc'')';
- Q.Open;
- AssertTrue('Have modified data record in database',not (Q.EOF AND Q.BOF));
- end;
- end;
- procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
- var Q: TSQLQuery;
- I: Integer;
- begin
- // Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- Transaction.COmmit;
- for I:=1 to 2 do
- ExecuteDirect(Format('INSERT INTO FPDEV2 values (%d,''%.6d'')',[i,i]));
- Transaction.COmmit;
- Q := SQLDBConnector.Query;
- FMyQ:=Q; // so th event handler can reach it.
- Q.SQL.Text:='select * from FPDEV2';
- Q.Options:=[sqoAutoApplyUpdates];
- // We must test that in AfterPost, the modification is still there, for backwards compatibilty
- Q.AfterPost:=@DoAfterPost;
- Q.Open;
- AssertEquals('Got all records',2,Q.RecordCount);
- // Now check editing
- Q.Locate('id',2,[]);
- Q.Delete;
- AssertTrue('Have no more updates pending',Q.UpdateStatus=usUnmodified);
- Q.Close;
- Q.SQL.Text:='select * from FPDEV2 where (id=2)';
- Q.Open;
- AssertTrue('Data record is deleted in database', (Q.EOF AND Q.BOF));
- end;
- end;
- procedure TTestTSQLQuery.DoApplyUpdates;
- begin
- FMyQ.ApplyUpdates();
- end;
- procedure TTestTSQLQuery.TestCheckRowsAffected;
- var Q: TSQLQuery;
- I: Integer;
- begin
- // Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- Transaction.COmmit;
- for I:=1 to 2 do
- ExecuteDirect(Format('INSERT INTO FPDEV2 values (%d,''%.6d'')',[i,i]));
- Transaction.COmmit;
- SQLDBConnector.Connection.Options:=[scoApplyUpdatesChecksRowsAffected];
- Q := SQLDBConnector.Query;
- Q.SQL.Text:='select * from FPDEV2';
- Q.DeleteSQL.Text:='delete from FPDEV2';
- Q.Open;
- AssertEquals('Got all records',2,Q.RecordCount);
- // Now check editing
- Q.Delete;
- FMyQ:=Q;
- AssertException('RowsAffected > 1 raises exception',EUpdateError,@DoApplyUpdates);
- end;
- end;
- procedure TTestTSQLQuery.TestAutoCommit;
- var
- I : Integer;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- Query.Options:=[sqoAutoCommit];
- for I:=1 to 2 do
- begin
- Query.SQL.Text:=Format('INSERT INTO FPDEV2 values (%d,''%.6d'');',[i,i]);
- Query.Prepare;
- Query.ExecSQL;
- // We do not commit anything explicitly.
- end;
- AssertFalse('Transaction is still active after expected auto commit', Transaction.Active);
- Connection.Close;
- Connection.Open;
- Query.SQL.Text:='SELECT COUNT(*) from FPDEV2';
- Query.Open;
- AssertEquals('Records haven''t been committed to database', 2, Query.Fields[0].AsInteger);
- end;
- end;
- procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
- var
- Q: TSQLQuery;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- end;
- Q:=SQLDBConnector.Query;
- Q.SQL.Text:='select * from FPDEV2';
- Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- Q.Options:=Q.Options+[sqoRefreshUsingSelect];
- Q.Open;
- With Q.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With Q.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- With Q.FieldByName('b') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- Q.Insert;
- Q.FieldByName('id').AsInteger:=1;
- Q.Post;
- AssertTrue('Field value has not been fetched after post',Q.FieldByName('a').IsNull);
- Q.ApplyUpdates(0);
- AssertEquals('Still on correct field',1,Q.FieldByName('id').AsInteger);
- AssertEquals('Field value has been fetched from the database ','abcde',Q.FieldByName('a').AsString);
- AssertEquals('Field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString);
- end;
- procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
- var
- Q: TSQLQuery;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- end;
- Q:=SQLDBConnector.Query;
- Q.SQL.Text:='select * from FPDEV2';
- Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- Q.Options:=Q.Options+[sqoRefreshUsingSelect];
- Q.Open;
- With Q.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With Q.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- Q.Insert;
- Q.FieldByName('id').AsInteger:=1;
- Q.Post;
- AssertTrue('Field value has not been fetched after post',Q.FieldByName('a').IsNull);
- Q.ApplyUpdates(0);
- AssertEquals('Still on correct field',1,Q.FieldByName('id').AsInteger);
- AssertEquals('Field value a has been fetched from the database ','abcde',Q.FieldByName('a').AsString);
- AssertEquals('Field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString);
- end;
- procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- end;
- FMyQ:=SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- FMyQ.Options:=FMyQ.Options+[sqoRefreshUsingSelect];
- FMyQ.Open;
- With FMyQ.FieldByName('id') do
- ProviderFlags:=ProviderFlags-[pfInKey];
- With FMyQ.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- FMyQ.Insert;
- FMyQ.FieldByName('id').AsInteger:=1;
- FMyQ.Post;
- AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
- end;
- procedure TTestTSQLQuery.TestRefreshSQL;
- var
- Q: TSQLQuery;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null primary key, a varchar(5) default ''abcde'', b integer default 1)');
- if Transaction.Active then
- Transaction.Commit;
- end;
- Q:=SQLDBConnector.Query;
- Q.SQL.Text:='select * from FPDEV2';
- Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
- Q.Open;
- Q.Insert; // #1 record
- Q.FieldByName('id').AsInteger:=1;
- Q.Post;
- Q.Append; // #2 record
- Q.FieldByName('id').AsInteger:=2;
- Q.Post;
- AssertTrue('Field value has not been fetched after Post', Q.FieldByName('a').IsNull);
- Q.ApplyUpdates(0);
- // #2 record:
- AssertEquals('Still on correct field', 2, Q.FieldByName('id').AsInteger);
- AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
- AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
- Q.Prior;
- // #1 record:
- AssertEquals('Still on correct field', 1, Q.FieldByName('id').AsInteger);
- AssertEquals('Field value has been fetched from the database', 'abcde', Q.FieldByName('a').AsString);
- AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
- end;
- procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- ExecuteDirect('insert into FPDEV2 (id) values (123)');
- if Transaction.Active then
- Transaction.Commit;
- end;
- FMyQ:=SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- FMyQ.RefreshSQL.Text:='select * from FPDEV2';
- FMyQ.Open;
- With FMyQ.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With FMyQ.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- FMyQ.Insert;
- FMyQ.FieldByName('id').AsInteger:=1;
- FMyQ.Post;
- AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
- end;
- procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- ExecuteDirect('insert into FPDEV2 (id) values (123)');
- if Transaction.Active then
- Transaction.Commit;
- end;
- FMyQ:=SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- FMyQ.RefreshSQL.Text:='select * from FPDEV2 where 1=2';
- FMyQ.Open;
- With FMyQ.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With FMyQ.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate];
- FMyQ.Insert;
- FMyQ.FieldByName('id').AsInteger:=1;
- FMyQ.Post;
- AssertException('No records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
- end;
- procedure TTestTSQLQuery.TestFetchAutoInc;
- var datatype: string;
- id: largeint;
- begin
- with SQLDBConnector do
- begin
- case SQLServerType of
- ssMySQL:
- datatype := 'integer auto_increment';
- ssMSSQL, ssSybase:
- datatype := 'integer identity';
- ssSQLite:
- datatype := 'integer';
- else
- Ignore(STestNotApplicable);
- end;
- ExecuteDirect('create table FPDEV2 (id '+datatype+' primary key, f varchar(5))');
- CommitDDL;
- end;
- with SQLDBConnector.Query do
- begin
- SQL.Text:='select * from FPDEV2';
- Open;
- Insert;
- FieldByName('f').AsString:='a';
- Post; // #1 record
- Append;
- FieldByName('f').AsString:='b';
- Post; // #2 record
- AssertTrue('ID field is not null after Post', FieldByName('id').IsNull);
- First; // #1 record
- ApplyUpdates(0);
- AssertTrue('ID field is still null after ApplyUpdates', Not FieldByName('id').IsNull);
- // Should be 1 after the table was created, but this is not guaranteed... So we just test positive values.
- id := FieldByName('id').AsLargeInt;
- AssertTrue('ID field has not positive value', id>0);
- Next; // #2 record
- AssertTrue('Next ID value is not greater than previous', FieldByName('id').AsLargeInt>id);
- end;
- end;
- procedure TTestTSQLQuery.TestSequence;
- var SequenceNames : TStringList;
- begin
- case SQLServerType of
- ssFirebird:
- SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1');
- ssMSSQL, ssOracle, ssPostgreSQL:
- SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1 MINVALUE 1');
- else
- Ignore(STestNotApplicable);
- end;
- SQLDBConnector.ExecuteDirect('create table FPDEV2 (id integer)');
- SQLDBConnector.CommitDDL;
- with SQLDBConnector.Query do
- begin
- SQL.Text := 'select * from FPDEV2';
- Sequence.FieldName:='id';
- Sequence.SequenceName:='FPDEV_SEQ1';
- Open;
- // default is get next value on new record
- Append;
- AssertEquals(1, FieldByName('id').AsInteger);
- Sequence.ApplyEvent:=saeOnPost;
- Append;
- AssertTrue('Field ID must be null after Append', FieldByName('id').IsNull);
- Post;
- AssertEquals(2, FieldByName('id').AsInteger);
- end;
- // test GetSequenceNames
- SequenceNames := TStringList.Create;
- try
- SQLDBConnector.Connection.GetSequenceNames(SequenceNames);
- AssertTrue(SequenceNames.IndexOf('FPDEV_SEQ1') >= 0);
- finally
- SequenceNames.Free;
- end;
- SQLDBConnector.ExecuteDirect('drop sequence FPDEV_SEQ1');
- SQLDBConnector.CommitDDL;
- end;
- procedure TTestTSQLQuery.TestReturningInsert;
- begin
- with SQLDBConnector do
- begin
- if not (sqSupportReturning in Connection.ConnOptions) then
- Ignore(STestNotApplicable);
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- ExecuteDirect('insert into FPDEV2 (id) values (123)');
- if Transaction.Active then
- Transaction.Commit;
- end;
- FMyQ:=SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- // FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
- FMyQ.Open;
- With FMyQ.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With FMyQ.FieldByName('a') do
- ProviderFlags:=ProviderFlags+[pfRefreshOnInsert];
- With FMyQ.FieldByName('b') do
- ProviderFlags:=[];
- FMyQ.Insert;
- FMyQ.FieldByName('id').AsInteger:=1;
- FMyQ.Post;
- FMyQ.ApplyUpdates;
- AssertEquals('a updated','abcde',FMyQ.FieldByName('a').AsString);
- AssertEquals('b not updated','',FMyQ.FieldByName('b').AsString);
- end;
- procedure TTestTSQLQuery.TestReturningUpdate;
- begin
- with SQLDBConnector do
- begin
- if not (sqSupportReturning in Connection.ConnOptions) then
- Ignore(STestNotApplicable);
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
- CommitDDL;
- ExecuteDirect('insert into FPDEV2 (id) values (1)');
- ExecuteDirect('insert into FPDEV2 (id) values (2)');
- end;
- FMyQ:=SQLDBConnector.Query;
- FMyQ.SQL.Text:='select * from FPDEV2';
- FMyQ.Open;
- With FMyQ.FieldByName('id') do
- ProviderFlags:=ProviderFlags+[pfInKey];
- With FMyQ.FieldByName('b') do
- ProviderFlags:=[pfRefreshOnUpdate]; // Do not update, just fetch new value
- SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''b1'' where id=1');
- SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''b2'' where id=2');
- FMyQ.Edit;
- FMyQ.FieldByName('a').AsString:='a1';
- FMyQ.Post; // #1 record
- FMyQ.Next;
- FMyQ.Edit;
- FMyQ.FieldByName('a').AsString:='a2';
- FMyQ.Post; // #2 record
- FMyQ.ApplyUpdates;
- FMyQ.First;
- AssertEquals('#1.a updated', 'a1', FMyQ.FieldByName('a').AsString);
- AssertEquals('#1.b updated', 'b1', FMyQ.FieldByName('b').AsString);
- FMyQ.Next;
- AssertEquals('#2.a updated', 'a2', FMyQ.FieldByName('a').AsString);
- AssertEquals('#2.b updated', 'b2', FMyQ.FieldByName('b').AsString);
- end;
- { TTestTSQLConnection }
- procedure TTestTSQLConnection.TestImplicitTransaction;
- Var
- T : TSQLTransaction;
- begin
- T:=TSQLTransaction.Create(Nil);
- try
- T.Options:=[stoUseImplicit];
- T.DataBase:=SQLDBConnector.Connection;
- finally
- T.Free;
- end;
- end;
- procedure TTestTSQLConnection.TestImplicitTransaction2;
- Var
- T : TSQLTransaction;
- begin
- T:=TSQLTransaction.Create(Nil);
- try
- T.Options:=[stoUseImplicit];
- SQLDBConnector.Connection.Transaction:=T;
- finally
- T.Free;
- end;
- end;
- procedure TTestTSQLConnection.SetImplicit;
- begin
- SQLDBConnector.Transaction.Options:=[stoUseImplicit];
- end;
- procedure TTestTSQLConnection.TestImplicitTransactionNotAssignable;
- begin
- AssertException('Cannot set toUseImplicit option if database does not allow it',EDatabaseError,@SetImplicit);
- AssertException('Cannot assign database to transaction with toUseImplicit, if database does not allow it',EDatabaseError,@TestImplicitTransaction);
- AssertException('Cannot assign transaction with toUseImplicit to database, if database does not allow it',EDatabaseError,@TestImplicitTransaction2);
- end;
- procedure TTestTSQLConnection.TestImplicitTransactionOK;
- var
- Q : TSQLQuery;
- T : TSQLTransaction;
- I : Integer;
- begin
- with SQLDBConnector do
- begin
- ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10), constraint PK_FPDEV2 primary key(id))');
- if Transaction.Active then
- Transaction.Commit;
- end;
- SetImplicit;
- Q:=SQLDBConnector.Query;
- for I:=1 to 2 do
- begin
- Q.SQL.Text:=Format('INSERT INTO FPDEV2 values (%d,''%.6d'');',[i,i]);
- Q.Prepare;
- Q.ExecSQL;
- // We do not commit anything explicitly.
- end;
- Q:=Nil;
- T:=Nil;
- try
- T:=TSQLTransaction.Create(Nil);
- Q:=TSQLQuery.Create(Nil);
- Q.Transaction:=T;
- Q.Database:=SQLDBConnector.Connection;
- T.Database:=SQLDBConnector.Connection;
- Q.SQL.text:='SELECT COUNT(*) from FPDEV2';
- Q.Open;
- AssertEquals('Records have been committed to database',2,Q.Fields[0].AsInteger);
- finally
- Q.Free;
- T.Free;
- end;
- end;
- procedure TTestTSQLConnection.TestUseImplicitTransaction;
- begin
- if (sqImplicitTransaction in SQLDBConnector.Connection.ConnOptions) then
- TestImplicitTransactionOK
- else
- TestImplicitTransactionNotAssignable;
- end;
- procedure TTestTSQLConnection.TryOpen;
- begin
- SQLDBConnector.Query.Open;
- end;
- procedure TTestTSQLConnection.TestUseExplicitTransaction;
- begin
- SQLDBConnector.Transaction.Active:=False;
- SQLDBConnector.Transaction.Options:=[stoExplicitStart];
- SQLDBConnector.Query.SQL.Text:='select * from FPDEV';
- AssertException('toExplicitStart raises exception on implicit start',EDatabaseError,@TryOpen)
- end;
- procedure TTestTSQLConnection.TestExplicitConnect;
- begin
- SQLDBConnector.Transaction.Active:=False;
- SQLDBConnector.Connection.Options:=[scoExplicitConnect];
- SQLDBConnector.Connection.Connected:=False;
- SQLDBConnector.Query.SQL.Text:='select * from FPDEV';
- AssertException('toExplicitStart raises exception on implicit start',EDatabaseError,@TryOpen)
- end;
- procedure TTestTSQLConnection.TestGetStatementInfo;
- var StmtInfo: TSQLStatementInfo;
- begin
- // single table
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM tab1');
- AssertEquals('StatementType', ord(stSELECT), ord(StmtInfo.StatementType));
- AssertEquals('TableName', 'tab1', StmtInfo.TableName);
- AssertEquals('Updateable', True, StmtInfo.Updateable);
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM tab2 WHERE col1=1');
- AssertEquals('TableName', 'tab2', StmtInfo.TableName);
- AssertEquals('Updateable', True, StmtInfo.Updateable);
- // single table with schema
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM dbo.tab2 WHERE col1=1');
- AssertEquals('TableName', 'dbo.tab2', StmtInfo.TableName);
- AssertEquals('Updateable', True, StmtInfo.Updateable);
- // single table with quoted schema
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM "dbo".tab2 WHERE col1=1');
- AssertEquals('TableName', '"dbo".tab2', StmtInfo.TableName);
- AssertEquals('Updateable', True, StmtInfo.Updateable);
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM "dbo"."tab2" WHERE col1=1');
- AssertEquals('TableName', '"dbo"."tab2"', StmtInfo.TableName);
- AssertEquals('Updateable', True, StmtInfo.Updateable);
- // multiple tables
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM tab3,tab4 WHERE col1=1');
- AssertEquals('TableName', '', StmtInfo.TableName);
- AssertEquals('Updateable', False, StmtInfo.Updateable);
- // function
- StmtInfo := SQLDBConnector.Connection.GetStatementInfo('SELECT * FROM dbo.fn1(1)');
- AssertEquals('TableName', '', StmtInfo.TableName);
- AssertEquals('Updateable', False, StmtInfo.Updateable);
- end;
- { TTestTSQLScript }
- procedure TTestTSQLScript.TestExecuteScript;
- var Ascript : TSQLScript;
- begin
- Ascript := TSQLScript.Create(nil);
- try
- with Ascript do
- begin
- DataBase := SQLDBConnector.Connection;
- Transaction := SQLDBConnector.Transaction;
- Script.Clear;
- Script.Append('create table FPDEV_A (id int);');
- Script.Append('create table FPDEV_B (id int);');
- ExecuteScript;
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- SQLDBConnector.CommitDDL;
- end;
- finally
- AScript.Free;
- SQLDBConnector.ExecuteDirect('drop table FPDEV_A');
- SQLDBConnector.ExecuteDirect('drop table FPDEV_B');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- SQLDBConnector.CommitDDL;
- end;
- end;
- procedure TTestTSQLScript.TestScriptColon;
- // Bug 25334: TSQLScript incorrectly treats : in scripts as sqldb query parameter markers
- // Firebird-only test; can be extended for other dbs that use : in SQL
- var
- Ascript : TSQLScript;
- begin
- if not(SQLConnType in [interbase]) then Ignore(STestNotApplicable);
- Ascript := TSQLScript.Create(nil);
- try
- with Ascript do
- begin
- DataBase := SQLDBConnector.Connection;
- Transaction := SQLDBConnector.Transaction;
- Script.Clear;
- UseSetTerm := true;
- // Example procedure that selects table names
- Script.Append(
- 'SET TERM ^ ; '+LineEnding+
- 'CREATE PROCEDURE FPDEV_TESTCOLON '+LineEnding+
- 'RETURNS (tblname VARCHAR(31)) '+LineEnding+
- 'AS '+LineEnding+
- 'begin '+LineEnding+
- '/* Show tables. Note statement uses colon */ '+LineEnding+
- 'FOR '+LineEnding+
- ' SELECT RDB$RELATION_NAME '+LineEnding+
- ' FROM RDB$RELATIONS '+LineEnding+
- ' ORDER BY RDB$RELATION_NAME '+LineEnding+
- ' INTO :tblname '+LineEnding+
- 'DO '+LineEnding+
- ' SUSPEND; '+LineEnding+
- 'end^ '+LineEnding+
- 'SET TERM ; ^'
- );
- ExecuteScript;
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- SQLDBConnector.CommitDDL;
- end;
- finally
- AScript.Free;
- SQLDBConnector.ExecuteDirect('DROP PROCEDURE FPDEV_TESTCOLON');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- SQLDBConnector.CommitDDL;
- end;
- end;
- procedure TTestTSQLScript.TestUseCommit;
- // E.g. Firebird needs explicit COMMIT sometimes, e.g. if mixing DDL and DML
- // statements in a script.
- // Probably same as bug 17829 Error executing SQL script
- const
- TestValue='Some text';
- var
- Ascript : TSQLScript;
- CheckQuery : TSQLQuery;
- begin
- Ascript := TSQLScript.Create(nil);
- try
- with Ascript do
- begin
- DataBase := SQLDBConnector.Connection;
- Transaction := SQLDBConnector.Transaction;
- Script.Clear;
- UseCommit:=true;
- // Example procedure that selects table names
- Script.Append('CREATE TABLE fpdev_scriptusecommit (logmessage VARCHAR(255));');
- Script.Append('COMMIT;'); //needed for table to show up
- Script.Append('INSERT INTO fpdev_scriptusecommit (logmessage) VALUES('''+TestValue+''');');
- Script.Append('COMMIT;');
- ExecuteScript;
- // This line should not run, as the commit above should have taken care of it:
- //SQLDBConnector.CommitDDL;
- // Test whether second line of script executed, just to be sure
- CheckQuery:=SQLDBConnector.Query;
- CheckQuery.SQL.Text:='SELECT logmessage FROM fpdev_scriptusecommit ';
- CheckQuery.Open;
- CheckEquals(TestValue, CheckQuery.Fields[0].AsString, 'Insert script line should have inserted '+TestValue);
- CheckQuery.Close;
- end;
- finally
- AScript.Free;
- SQLDBConnector.ExecuteDirect('DROP TABLE fpdev_scriptusecommit');
- SQLDBConnector.Transaction.Commit;
- end;
- end;
- { TSQLDBTestCase }
- function TSQLDBTestCase.GetSQLDBConnector: TSQLDBConnector;
- begin
- Result := DBConnector as TSQLDBConnector;
- end;
- procedure TSQLDBTestCase.SetUp;
- begin
- inherited SetUp;
- InitialiseDBConnector;
- DBConnector.StartTest(TestName);
- end;
- procedure TSQLDBTestCase.TearDown;
- begin
- DBConnector.StopTest(TestName);
- if assigned(DBConnector) then
- with SQLDBConnector do
- if Assigned(Transaction) and Transaction.Active and not (stoUseImplicit in Transaction.Options) then
- Transaction.Rollback;
- FreeDBConnector;
- inherited TearDown;
- end;
- initialization
- if uppercase(dbconnectorname)='SQL' then
- begin
- RegisterTest(TTestTSQLQuery);
- RegisterTest(TTestTSQLConnection);
- RegisterTest(TTestTSQLScript);
- end;
- end.
|