From 6b32a6e0e599ed8d7efdfb6cfee43dde0d1d60a9 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sat, 22 Nov 2014 16:28:09 +0000
Subject: [PATCH] * Transaction options and connection options
git-svn-id: trunk@29109 -
---
packages/fcl-db/src/base/dbconst.pas | 18 +-
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc | 2 +-
.../fcl-db/src/sqldb/postgres/pqconnection.pp | 61 +++--
packages/fcl-db/src/sqldb/sqldb.pp | 103 +++++++--
packages/fcl-db/tests/dbtestframework.pas | 2 +
packages/fcl-db/tests/sqldbtoolsunit.pas | 43 ++--
packages/fcl-db/tests/testsqldb.pas | 212 ++++++++++++++----
7 files changed, 350 insertions(+), 91 deletions(-)
diff --git a/packages/fcl-db/src/base/dbconst.pas b/packages/fcl-db/src/base/dbconst.pas
index ad57b90f39..62c778164d 100644
--- a/packages/fcl-db/src/base/dbconst.pas
+++ b/packages/fcl-db/src/base/dbconst.pas
@@ -105,14 +105,18 @@ Resourcestring
SStreamNotRecognised = 'The data-stream format is not recognized';
SNoReaderClassRegistered = 'There is no TDatapacketReaderClass registered for this kind of data-stream';
SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';
- SCommitting = 'Committing transaction';
- SRollingBack = 'Rolling back transaction';
- SCommitRetaining = 'Commit and retaining transaction';
- SRollBackRetaining = 'Rollback and retaining transaction';
- SErrNoFieldsDefined = 'Can not create a dataset when there are no fielddefinitions or fields defined';
- SErrApplyUpdBeforeRefresh= 'Must apply updates before refreshing data';
- SErrNoDataset = 'Missing (compatible) underlying dataset, can not open';
+ SCommitting = 'Committing transaction';
+ SRollingBack = 'Rolling back transaction';
+ SCommitRetaining = 'Commit and retaining transaction';
+ SRollBackRetaining = 'Rollback and retaining transaction';
+ SErrNoFieldsDefined = 'Can not create a dataset when there are no fielddefinitions or fields defined';
+ SErrApplyUpdBeforeRefresh = 'Must apply updates before refreshing data';
+ SErrNoDataset = 'Missing (compatible) underlying dataset, can not open';
SErrDisconnectedPacketRecords = 'For disconnected TSQLQuery instances, packetrecords must be -1';
+ SErrImplicitNoRollBack = 'Implicit use of transactions does not allow rollback.';
+ SErrNoImplicitTransaction = 'Connection %s does not allow implicit transactions.';
+ SErrImplictTransactionStart = 'Error: attempt to implicitly start a transaction on Connection "%s", transaction "%s".';
+ SErrImplicitConnect = 'Error: attempt to implicitly activate connection "%s".';
Implementation
diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
index a054287146..646569b061 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
+++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
@@ -1122,7 +1122,7 @@ constructor TConnectionName.Create(AOwner: TComponent);
const SingleBackQoutes: TQuoteChars = ('`','`');
begin
inherited Create(AOwner);
- FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
+ FConnOptions := FConnOptions + [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction];
FieldNameQuoteChars:=SingleBackQoutes;
FMySQL := Nil;
end;
diff --git a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
index 48c24e8b58..d31ebbe238 100644
--- a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
+++ b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
@@ -116,6 +116,7 @@ type
function RollBack(trans : TSQLHandle) : boolean; override;
function Commit(trans : TSQLHandle) : boolean; override;
procedure CommitRetaining(trans : TSQLHandle); override;
+ function StartImplicitTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
procedure RollBackRetaining(trans : TSQLHandle); override;
procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
@@ -263,7 +264,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
begin
inherited;
- FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash];
+ FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction];
FieldNameQuoteChars:=DoubleQuotes;
VerboseErrors:=True;
FConnectionPool:=TThreadlist.Create;
@@ -322,7 +323,8 @@ begin
{$EndIf}
end;
-procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor; Bindings: TFieldBindings);
+Procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
+ Bindings: TFieldBindings);
Var
tt,tc,Tn,S : String;
@@ -376,7 +378,7 @@ begin
P.SQLDBData:=TPQCursor(C).GetFieldBinding(F.FieldDef);
end;
-function TPQConnection.ErrorOnUnknownType: Boolean;
+Function TPQConnection.ErrorOnUnknownType: Boolean;
begin
Result:=False;
end;
@@ -463,9 +465,8 @@ begin
result := true;
end;
-function TPQConnection.StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean;
+function TPQConnection.StartImplicitTransaction(trans : TSQLHandle; AParams : string) : boolean;
var
- res : PPGresult;
tr : TPQTrans;
i : Integer;
t : TPQTranConnection;
@@ -511,11 +512,6 @@ begin
if CharSet <> '' then
PQsetClientEncoding(tr.PGConn, pchar(CharSet));
end;
-
- res := PQexec(tr.PGConn, 'BEGIN');
- CheckResultError(res,tr.PGConn,sErrTransactionFailed);
-
- PQclear(res);
result := true;
end;
@@ -551,6 +547,24 @@ begin
PQclear(res);
end;
+function TPQConnection.StartDBTransaction(trans: TSQLHandle;
+ AParams: string): boolean;
+
+Var
+ res : PPGresult;
+ tr : TPQTrans;
+
+begin
+ Result:=StartImplicitTransaction(trans, AParams);
+ if Result then
+ begin
+ tr := trans as TPQTrans;
+ res := PQexec(tr.PGConn, 'BEGIN');
+ CheckResultError(res,tr.PGConn,sErrTransactionFailed);
+ PQclear(res);
+ end;
+end;
+
procedure TPQConnection.DoInternalConnect;
var
@@ -648,9 +662,21 @@ var
MESSAGE_DETAIL: string;
MESSAGE_HINT: string;
STATEMENT_POSITION: string;
+ P : Pchar;
+ haveError : Boolean;
+
begin
- if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+ HaveError:=False;
+ if (Res=Nil) then
begin
+ HaveError:=True;
+ P:=PQerrorMessage(conn);
+ If Assigned(p) then
+ ErrMsg:=StrPas(P);
+ end
+ else if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+ begin
+ HaveError:=True;
SEVERITY:=PQresultErrorField(res,ord('S'));
SQLSTATE:=PQresultErrorField(res,ord('C'));
MESSAGE_PRIMARY:=PQresultErrorField(res,ord('M'));
@@ -667,6 +693,9 @@ begin
MaybeAdd(sErr,'Hint',MESSAGE_HINT);
MaybeAdd(sErr,'Character',STATEMENT_POSITION);
end;
+ end;
+ if HaveError then
+ begin
if (Self.Name='') then CompName := Self.ClassName else CompName := Self.Name;
E:=EPQDatabaseError.CreateFmt('%s : %s (PostgreSQL: %s)', [CompName, ErrMsg, sErr]);
E.SEVERITY:=SEVERITY;
@@ -675,7 +704,6 @@ begin
E.MESSAGE_DETAIL:=MESSAGE_DETAIL;
E.MESSAGE_HINT:=MESSAGE_HINT;
E.STATEMENT_POSITION:=STATEMENT_POSITION;
-
PQclear(res);
res:=nil;
if assigned(conn) then
@@ -688,7 +716,7 @@ begin
end;
function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
- Size: integer; out ATypeOID: oid): TFieldType;
+ Size: integer; Out ATypeOID: oid): TFieldType;
const
VARHDRSZ=sizeof(longint);
@@ -769,18 +797,18 @@ begin
end;
end;
-function TPQConnection.AllocateCursorHandle: TSQLCursor;
+Function TPQConnection.AllocateCursorHandle: TSQLCursor;
begin
result := TPQCursor.create;
end;
-procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
+Procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
begin
FreeAndNil(cursor);
end;
-function TPQConnection.AllocateTransactionHandle: TSQLHandle;
+Function TPQConnection.AllocateTransactionHandle: TSQLHandle;
begin
result := TPQTrans.create;
@@ -838,6 +866,7 @@ var
i : integer;
P : TParam;
PQ : TSQLDBParam;
+ r : PPGresult;
begin
with (cursor as TPQCursor) do
diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp
index 413471e23c..5cb7b76e1b 100644
--- a/packages/fcl-db/src/sqldb/sqldb.pp
+++ b/packages/fcl-db/src/sqldb/sqldb.pp
@@ -27,6 +27,9 @@ type
TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction);
TConnOptions= set of TConnOption;
+ TConnectionOption = (coExplicitConnect);
+ TConnectionOptions = Set of TConnectionOption;
+
TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
stDDL, stGetSegment, stPutSegment, stExecProcedure,
@@ -148,6 +151,7 @@ type
TSQLConnection = class (TDatabase)
private
FFieldNameQuoteChars : TQuoteChars;
+ FOptions: TConnectionOptions;
FPassword : string;
FTransaction : TSQLTransaction;
FUserName : string;
@@ -159,6 +163,7 @@ type
FOnLog: TDBLogNotifyEvent;
FInternalTransaction : TSQLTransaction;
function GetPort: cardinal;
+ procedure SetOptions(AValue: TConnectionOptions);
procedure SetPort(const AValue: cardinal);
protected
FConnOptions : TConnOptions;
@@ -204,6 +209,7 @@ type
function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
+ function StartImplicitTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual;
function StartdbTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual; abstract;
procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
@@ -211,6 +217,8 @@ type
procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); virtual;
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
+ Procedure MaybeConnect;
+
Property Statements : TFPList Read FStatements;
property Port: cardinal read GetPort write SetPort;
public
@@ -239,6 +247,7 @@ type
property HostName : string Read FHostName Write FHostName;
Property OnLog : TDBLogNotifyEvent Read FOnLog Write FOnLog;
Property LogEvents : TDBEventTypes Read FLogEvents Write FLogEvents Default LogAllEvents;
+ Property Options : TConnectionOptions Read FOptions Write SetOptions;
property Connected;
Property Role : String read FRole write FRole;
property DatabaseName;
@@ -252,16 +261,21 @@ type
TCommitRollbackAction = (caNone, caCommit, caCommitRetaining, caRollback,
caRollbackRetaining);
+ TTransactionOption = (toUseImplicit, toExplicitStart);
+ TTransactionOptions = Set of TTransactionOption;
TSQLTransaction = class (TDBTransaction)
private
+ FOptions: TTransactionOptions;
FTrans : TSQLHandle;
FAction : TCommitRollbackAction;
FParams : TStringList;
function GetSQLConnection: TSQLConnection;
+ procedure SetOptions(AValue: TTransactionOptions);
procedure SetParams(const AValue: TStringList);
procedure SetSQLConnection(AValue: TSQLConnection);
protected
+ Procedure MaybeStartTransaction;
Function AllowClose(DS: TDBDataset): Boolean; override;
function GetHandle : Pointer; virtual;
Procedure SetDatabase (Value : TDatabase); override;
@@ -282,6 +296,7 @@ type
property Action : TCommitRollbackAction read FAction write FAction Default caRollBack;
property Database;
property Params : TStringList read FParams write SetParams;
+ Property Options : TTransactionOptions Read FOptions Write SetOptions;
end;
@@ -987,10 +1002,9 @@ begin
DatabaseError(SErrDatabasenAssigned);
if not assigned(Transaction) then
DatabaseError(SErrTransactionnSet);
- if not Database.Connected then
- Database.Open;
+ Database.MaybeConnect;
if not Transaction.Active then
- Transaction.StartTransaction;
+ Transaction.MaybeStartTransaction;
try
DoPrepare;
except
@@ -1145,7 +1159,8 @@ begin
DatabaseError(SErrTransactionnSet);
if not Connected then Open;
- if not ATransaction.Active then ATransaction.StartTransaction;
+ if not (ATransaction.Active or (toUseImplicit in ATransaction.Options)) then
+ ATransaction.MaybeStartTransaction;
try
SQL := TrimRight(SQL);
@@ -1171,6 +1186,12 @@ begin
result := StrToIntDef(Params.Values['Port'],0);
end;
+procedure TSQLConnection.SetOptions(AValue: TConnectionOptions);
+begin
+ if FOptions=AValue then Exit;
+ FOptions:=AValue;
+end;
+
procedure TSQLConnection.SetPort(const AValue: cardinal);
begin
@@ -1657,6 +1678,12 @@ begin
// empty
end;
+function TSQLConnection.StartImplicitTransaction(trans: TSQLHandle;
+ aParams: string): boolean;
+begin
+ // Do nothing
+end;
+
function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
begin
@@ -1667,6 +1694,16 @@ begin
end;
end;
+Procedure TSQLConnection.MaybeConnect;
+begin
+ If Not Connected then
+ begin
+ If (coExplicitConnect in Options) then
+ DatabaseErrorFmt(SErrImplicitConnect,[Name]);
+ Connected:=True;
+ end;
+end;
+
procedure TSQLConnection.CreateDB;
begin
@@ -1689,7 +1726,10 @@ begin
Commit;
caNone,
caRollback, caRollbackRetaining :
- RollBack;
+ if not (toUseImplicit in Options) then
+ RollBack
+ else
+ CloseTrans;
end;
end;
@@ -1703,11 +1743,29 @@ begin
Result:=Database as TSQLConnection;
end;
+procedure TSQLTransaction.SetOptions(AValue: TTransactionOptions);
+begin
+ if FOptions=AValue then Exit;
+ if (toUseImplicit in Avalue) and Assigned(SQLConnection) And Not (sqImplicitTransaction in SQLConnection.ConnOptions) then
+ DatabaseErrorFmt(SErrNoImplicitTransaction,[SQLConnection.ClassName]);
+ FOptions:=AValue;
+end;
+
procedure TSQLTransaction.SetSQLConnection(AValue: TSQLConnection);
begin
Database:=AValue;
end;
+Procedure TSQLTransaction.MaybeStartTransaction;
+begin
+ if not Active then
+ begin
+ if (toExplicitStart in Options) then
+ DatabaseErrorFmt(SErrImplictTransactionStart,[Database.Name,Name]);
+ StartTransaction;
+ end;
+end;
+
function TSQLTransaction.GetHandle: Pointer;
begin
Result := SQLConnection.GetTransactionHandle(FTrans);
@@ -1723,12 +1781,12 @@ end;
procedure TSQLTransaction.Commit;
begin
- if Active then
+ if Active then
begin
CloseDataSets;
If LogEvent(detCommit) then
Log(detCommit,SCommitting);
- if SQLConnection.Commit(FTrans) then
+ if (toUseImplicit in Options) or SQLConnection.Commit(FTrans) then
begin
CloseTrans;
FreeAndNil(FTrans);
@@ -1750,6 +1808,8 @@ procedure TSQLTransaction.Rollback;
begin
if Active then
begin
+ if (toUseImplicit in Options) then
+ DatabaseError(SErrImplicitNoRollBack);
CloseDataSets;
If LogEvent(detRollback) then
Log(detRollback,SRollingBack);
@@ -1765,6 +1825,8 @@ procedure TSQLTransaction.RollbackRetaining;
begin
if Active then
begin
+ if (toUseImplicit in Options) then
+ DatabaseError(SErrImplicitNoRollBack);
If LogEvent(detRollback) then
Log(detRollback,SRollBackRetaining);
SQLConnection.RollBackRetaining(FTrans);
@@ -1784,11 +1846,20 @@ begin
if Db = nil then
DatabaseError(SErrDatabasenAssigned);
- if not Db.Connected then
- Db.Open;
+ Db.MaybeConnect;
+
if not assigned(FTrans) then FTrans := Db.AllocateTransactionHandle;
- if Db.StartdbTransaction(FTrans,FParams.CommaText) then OpenTrans;
+ if (toUseImplicit in Options) then
+ begin
+ if Db.StartImplicitTransaction(FTrans,FParams.CommaText) then
+ OpenTrans
+ end
+ else
+ begin
+ if Db.StartdbTransaction(FTrans,FParams.CommaText) then
+ OpenTrans
+ end;
end;
constructor TSQLTransaction.Create(AOwner : TComponent);
@@ -1806,17 +1877,21 @@ begin
inherited Destroy;
end;
-procedure TSQLTransaction.SetDatabase(Value: TDatabase);
+Procedure TSQLTransaction.SetDatabase(Value: TDatabase);
begin
If Value<>Database then
begin
- if assigned(value) and not (Value is TSQLConnection) then
+ if Assigned(Value) and not (Value is TSQLConnection) then
DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
CheckInactive;
+ if (toUseImplicit in Options) and Assigned(Value) and Not (sqImplicitTransaction in TSQLConnection(Value).ConnOptions) then
+ DatabaseErrorFmt(SErrNoImplicitTransaction,[Value.ClassName]);
If Assigned(Database) then
+ begin
with SQLConnection do
if Transaction = self then Transaction := nil;
+ end;
inherited SetDatabase(Value);
If Assigned(Database) and not (csLoading in ComponentState) then
If (SQLConnection.Transaction=Nil) then
@@ -1824,12 +1899,12 @@ begin
end;
end;
-function TSQLTransaction.LogEvent(EventType: TDBEventType): Boolean;
+Function TSQLTransaction.LogEvent(EventType: TDBEventType): Boolean;
begin
Result:=Assigned(Database) and SQLConnection.LogEvent(EventType);
end;
-procedure TSQLTransaction.Log(EventType: TDBEventType; const Msg: String);
+Procedure TSQLTransaction.Log(EventType: TDBEventType; Const Msg: String);
Var
M : String;
diff --git a/packages/fcl-db/tests/dbtestframework.pas b/packages/fcl-db/tests/dbtestframework.pas
index d0c37fa6d4..7499826a14 100644
--- a/packages/fcl-db/tests/dbtestframework.pas
+++ b/packages/fcl-db/tests/dbtestframework.pas
@@ -9,6 +9,7 @@ program dbtestframework;
uses
SysUtils,
fpcunit, testreport, testregistry,
+ ibase60dyn,
DigestTestReport,
toolsunit,
// List of supported database connectors
@@ -63,6 +64,7 @@ Var
Application : TTestRunner;
begin
+ ibase60dyn.InitialiseIBase60('libfbclient.so.2.5.2');
InitialiseDBConnector;
Try
Application:=TTestRunner.Create(nil);
diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas
index 84f3fd7f36..db910533e1 100644
--- a/packages/fcl-db/tests/sqldbtoolsunit.pas
+++ b/packages/fcl-db/tests/sqldbtoolsunit.pas
@@ -54,13 +54,14 @@ type
procedure DropFieldDataset; override;
Function InternalGetNDataset(n : integer) : TDataset; override;
Function InternalGetFieldDataset : TDataSet; override;
- procedure TryDropIfExist(ATableName : String);
public
+ procedure TryDropIfExist(ATableName : String);
destructor Destroy; override;
constructor Create; override;
procedure ExecuteDirect(const SQL: string);
// Issue a commit(retaining) for databases that need it (e.g. in DDL)
procedure CommitDDL;
+ Procedure FreeTransaction;
property Connection : TSQLConnection read FConnection;
property Transaction : TSQLTransaction read FTransaction;
property Query : TSQLQuery read FQuery;
@@ -400,7 +401,7 @@ begin
testValues[ftFixedChar,i] := PadRight(testValues[ftFixedChar,i], 10);
end;
-function TSQLDBConnector.CreateQuery: TSQLQuery;
+Function TSQLDBConnector.CreateQuery: TSQLQuery;
begin
Result := TSQLQuery.create(nil);
@@ -555,7 +556,7 @@ begin
end;
procedure TSQLDBConnector.DoLogEvent(Sender: TSQLConnection;
- EventType: TDBEventType; const Msg: String);
+ EventType: TDBEventType; Const Msg: String);
var
Category: string;
begin
@@ -609,7 +610,7 @@ begin
end;
end;
-function TSQLDBConnector.InternalGetNDataset(n: integer): TDataset;
+Function TSQLDBConnector.InternalGetNDataset(n: integer): TDataset;
begin
Result := CreateQuery;
with (Result as TSQLQuery) do
@@ -620,7 +621,7 @@ begin
end;
end;
-function TSQLDBConnector.InternalGetFieldDataset: TDataSet;
+Function TSQLDBConnector.InternalGetFieldDataset: TDataSet;
begin
Result := CreateQuery;
with (Result as TSQLQuery) do
@@ -660,6 +661,11 @@ begin
begin
FConnection.ExecuteDirect('drop table if exists ' + ATableName);
end;
+ ssPostgresql:
+ begin
+ FConnection.ExecuteDirect('drop table if exists ' + ATableName);
+ FTransaction.CommitRetaining;
+ end;
ssOracle:
begin
FConnection.ExecuteDirect(
@@ -702,23 +708,34 @@ begin
Transaction.CommitRetaining;
end;
+Procedure TSQLDBConnector.FreeTransaction;
+begin
+ FreeAndNil(FTransaction);
+end;
+
destructor TSQLDBConnector.Destroy;
begin
+ FreeAndNil(FQuery);
if assigned(FTransaction) then
begin
try
- if Ftransaction.Active then Ftransaction.Rollback;
- Ftransaction.StartTransaction;
- Fconnection.ExecuteDirect('DROP TABLE FPDEV2');
- Ftransaction.Commit;
+ if not (toUseImplicit in Transaction.Options) then
+ begin
+ if Ftransaction.Active then
+ Ftransaction.Rollback;
+ Ftransaction.StartTransaction;
+ end;
+ TryDropIfExist('FPDEV2');
+ if not (toUseImplicit in Transaction.Options) then
+ Ftransaction.Commit;
Except
- if Ftransaction.Active then Ftransaction.Rollback;
+ if Ftransaction.Active and not (toUseImplicit in Transaction.Options) then
+ Ftransaction.Rollback;
end; // try
end;
- inherited Destroy;
- FreeAndNil(FQuery);
- FreeAndNil(FTransaction);
+ FreeTransaction;
FreeAndNil(FConnection);
+ inherited Destroy;
end;
constructor TSQLDBConnector.Create;
diff --git a/packages/fcl-db/tests/testsqldb.pas b/packages/fcl-db/tests/testsqldb.pas
index c98737ceb6..04cca84c06 100644
--- a/packages/fcl-db/tests/testsqldb.pas
+++ b/packages/fcl-db/tests/testsqldb.pas
@@ -10,24 +10,27 @@ interface
uses
Classes, sqldb, SysUtils, fpcunit, testregistry,
- db;
+ sqldbtoolsunit,toolsunit, db;
type
{ TSQLDBTestCase }
TSQLDBTestCase = class(TTestCase)
+ private
+ function GetDBC: TSQLDBConnector;
protected
procedure SetUp; override;
procedure TearDown; override;
+ Property SQLDBConnector : TSQLDBConnector Read GetDBC;
end;
{ TTestTSQLQuery }
TTestTSQLQuery = class(TSQLDBTestCase)
- procedure DoAfterPost(DataSet: TDataSet);
private
FMyQ: TSQLQuery;
+ procedure DoAfterPost(DataSet: TDataSet);
Procedure Allow;
Procedure SetQueryOPtions;
Procedure TrySetPacketRecords;
@@ -45,8 +48,16 @@ type
TTestTSQLConnection = class(TSQLDBTestCase)
private
+ procedure SetImplicit;
+ procedure TestImplicitTransaction;
+ procedure TestImplicitTransaction2;
+ procedure TestImplicitTransactionNotAssignable;
+ procedure TestImplicitTransactionOK;
+ procedure TryOpen;
published
- procedure ReplaceMe;
+ procedure TestUseImplicitTransaction;
+ procedure TestUseExplicitTransaction;
+ procedure TestExplicitConnect;
end;
{ TTestTSQLScript }
@@ -60,7 +71,6 @@ type
implementation
-uses sqldbtoolsunit, toolsunit;
{ TTestTSQLQuery }
@@ -79,7 +89,7 @@ procedure TTestTSQLQuery.TestMasterDetail;
var MasterQuery, DetailQuery: TSQLQuery;
MasterSource: TDataSource;
begin
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
try
MasterQuery := GetNDataset(10) as TSQLQuery;
MasterSource := TDatasource.Create(nil);
@@ -107,7 +117,7 @@ begin
// 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
+ 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
@@ -130,7 +140,7 @@ begin
end;
try
- Q := TSQLDBConnector(DBConnector).Query;
+ Q := SQLDBConnector.Query;
Q.SQL.Text:='select * from '+name1;
Q.Prepare;
Q.ServerIndexDefs.Update;
@@ -151,7 +161,7 @@ begin
CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '3.3');
finally
Q.UnPrepare;
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
ExecuteDirect('DROP TABLE '+name1);
ExecuteDirect('DROP TABLE '+name2);
@@ -167,7 +177,7 @@ var Q: TSQLQuery;
begin
// Test that for a disconnected SQL query, calling commit does not close the dataset.
// Test also that an edit still works.
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
try
ExecuteDirect('DROP table testdiscon');
@@ -179,7 +189,7 @@ begin
for I:=1 to 20 do
ExecuteDirect(Format('INSERT INTO testdiscon values (%d,''%.6d'')',[i,i]));
Transaction.COmmit;
- Q := TSQLDBConnector(DBConnector).Query;
+ Q := SQLDBConnector.Query;
Q.SQL.Text:='select * from testdiscon';
Q.QueryOptions:=[sqoDisconnected];
AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
@@ -211,9 +221,9 @@ end;
Procedure TTestTSQLQuery.TestDisconnectedPacketRecords;
begin
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
- FMyQ := TSQLDBConnector(DBConnector).Query;
+ FMyQ := SQLDBConnector.Query;
FMyQ.QueryOptions:=[sqoDisconnected];
AssertException('Cannot set packetrecords when sqoDisconnected is active',EDatabaseError,@TrySetPacketRecords);
end;
@@ -228,7 +238,7 @@ end;
Procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
begin
// Check that we can only set QueryOptions when the query is inactive.
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
try
ExecuteDirect('DROP table testdiscon');
@@ -239,9 +249,9 @@ begin
Transaction.COmmit;
ExecuteDirect(Format('INSERT INTO testdiscon values (%d,''%.6d'')',[1,1]));
Transaction.COmmit;
- FMyQ := TSQLDBConnector(DBConnector).Query;
+ FMyQ := SQLDBConnector.Query;
FMyQ.SQL.Text:='select * from testdiscon';
- FMyQ := TSQLDBConnector(DBConnector).Query;
+ FMyQ := SQLDBConnector.Query;
FMyQ.OPen;
AssertException('Cannot set packetrecords when sqoDisconnected is active',EDatabaseError,@SetQueryOptions);
end;
@@ -253,7 +263,7 @@ var Q: TSQLQuery;
begin
// Test that if sqoAutoApplyUpdates is in QueryOptions, then POST automatically does an ApplyUpdates
// Test also that POST afterpost event is backwards compatible.
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
try
ExecuteDirect('DROP table testdiscon');
@@ -265,7 +275,7 @@ begin
for I:=1 to 2 do
ExecuteDirect(Format('INSERT INTO testdiscon values (%d,''%.6d'')',[i,i]));
Transaction.COmmit;
- Q := TSQLDBConnector(DBConnector).Query;
+ Q := SQLDBConnector.Query;
FMyQ:=Q; // so th event handler can reach it.
Q.SQL.Text:='select * from testdiscon';
Q.QueryOptions:=[ sqoAutoApplyUpdates];
@@ -292,7 +302,7 @@ var Q: TSQLQuery;
I, J : Integer;
begin
// Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
- with TSQLDBConnector(DBConnector) do
+ with SQLDBConnector do
begin
try
ExecuteDirect('DROP table testdiscon');
@@ -304,7 +314,7 @@ begin
for I:=1 to 2 do
ExecuteDirect(Format('INSERT INTO testdiscon values (%d,''%.6d'')',[i,i]));
Transaction.COmmit;
- Q := TSQLDBConnector(DBConnector).Query;
+ Q := SQLDBConnector.Query;
FMyQ:=Q; // so th event handler can reach it.
Q.SQL.Text:='select * from testdiscon';
Q.QueryOptions:=[ sqoAutoApplyUpdates];
@@ -323,11 +333,127 @@ begin
end;
end;
+
{ TTestTSQLConnection }
-procedure TTestTSQLConnection.ReplaceMe;
+procedure TTestTSQLConnection.TestImplicitTransaction;
+
+Var
+ T : TSQLTransaction;
+
begin
- // replace this procedure with any test for TSQLConnection
+ T:=TSQLTransaction.Create(Nil);
+ try
+ T.Options:=[toUseImplicit];
+ T.DataBase:=SQLDBConnector.Connection;
+ finally
+ T.Free;
+ end;
+end;
+
+procedure TTestTSQLConnection.TestImplicitTransaction2;
+
+Var
+ T : TSQLTransaction;
+
+begin
+ T:=TSQLTransaction.Create(Nil);
+ try
+ T.Options:=[toUseImplicit];
+ SQLDBConnector.Connection.Transaction:=T;
+ finally
+ T.Free;
+ end;
+end;
+
+procedure TTestTSQLConnection.SetImplicit;
+
+begin
+ SQLDBConnector.Transaction.Options:=[toUseImplicit];
+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, J : Integer;
+begin
+ with SQLDBConnector do
+ begin
+ try
+ TryDropIfExist('testdiscon');
+ except
+ // Ignore
+ end;
+ ExecuteDirect('create table testdiscon (id integer not null, a varchar(10), constraint pk_testdiscon 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 testdiscon 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 testdiscon';
+ 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:=[toExplicitStart];
+ 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:=[coExplicitConnect];
+ SQLDBConnector.Connection.Connected:=False;
+ SQLDBConnector.Query.SQL.Text:='select * from FPDEV';
+ AssertException('toExplicitStart raises exception on implicit start',EDatabaseError,@TryOpen)
end;
{ TTestTSQLScript }
@@ -339,21 +465,21 @@ begin
try
with Ascript do
begin
- DataBase := TSQLDBConnector(DBConnector).Connection;
- Transaction := TSQLDBConnector(DBConnector).Transaction;
+ 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
- TSQLDBConnector(DBConnector).CommitDDL;
+ SQLDBConnector.CommitDDL;
end;
finally
AScript.Free;
- TSQLDBConnector(DBConnector).ExecuteDirect('drop table FPDEV_A');
- TSQLDBConnector(DBConnector).ExecuteDirect('drop table FPDEV_B');
+ 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
- TSQLDBConnector(DBConnector).CommitDDL;
+ SQLDBConnector.CommitDDL;
end;
end;
@@ -368,8 +494,8 @@ begin
try
with Ascript do
begin
- DataBase := TSQLDBConnector(DBConnector).Connection;
- Transaction := TSQLDBConnector(DBConnector).Transaction;
+ DataBase := SQLDBConnector.Connection;
+ Transaction := SQLDBConnector.Transaction;
Script.Clear;
UseSetTerm := true;
// Example procedure that selects table names
@@ -392,13 +518,13 @@ begin
);
ExecuteScript;
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).CommitDDL;
+ SQLDBConnector.CommitDDL;
end;
finally
AScript.Free;
- TSQLDBConnector(DBConnector).ExecuteDirect('DROP PROCEDURE FPDEV_TESTCOLON');
+ SQLDBConnector.ExecuteDirect('DROP PROCEDURE FPDEV_TESTCOLON');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).CommitDDL;
+ SQLDBConnector.CommitDDL;
end;
end;
@@ -416,8 +542,8 @@ begin
try
with Ascript do
begin
- DataBase := TSQLDBConnector(DBConnector).Connection;
- Transaction := TSQLDBConnector(DBConnector).Transaction;
+ DataBase := SQLDBConnector.Connection;
+ Transaction := SQLDBConnector.Transaction;
Script.Clear;
UseCommit:=true;
// Example procedure that selects table names
@@ -427,9 +553,9 @@ begin
Script.Append('COMMIT;');
ExecuteScript;
// This line should not run, as the commit above should have taken care of it:
- //TSQLDBConnector(DBConnector).CommitDDL;
+ //SQLDBConnector.CommitDDL;
// Test whether second line of script executed, just to be sure
- CheckQuery:=TSQLDBConnector(DBConnector).Query;
+ 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);
@@ -437,13 +563,18 @@ begin
end;
finally
AScript.Free;
- TSQLDBConnector(DBConnector).ExecuteDirect('DROP TABLE fpdev_scriptusecommit');
- TSQLDBConnector(DBConnector).Transaction.Commit;
+ SQLDBConnector.ExecuteDirect('DROP TABLE fpdev_scriptusecommit');
+ SQLDBConnector.Transaction.Commit;
end;
end;
{ TSQLDBTestCase }
+function TSQLDBTestCase.GetDBC: TSQLDBConnector;
+begin
+ Result:=DBConnector as TSQLDBConnector;
+end;
+
procedure TSQLDBTestCase.SetUp;
begin
inherited SetUp;
@@ -455,8 +586,9 @@ procedure TSQLDBTestCase.TearDown;
begin
DBConnector.StopTest(TestName);
if assigned(DBConnector) then
- with TSQLDBConnector(DBConnector) do
- Transaction.Rollback;
+ with SQLDBConnector do
+ if Assigned(Transaction) and not (toUseImplicit in Transaction.Options) then
+ Transaction.Rollback;
FreeDBConnector;
inherited TearDown;
end;