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; 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; { 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.