paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 10:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Transaction options and connection options

Browse Source 
git-svn-id: trunk@29109 -
This commit is contained in:
michael 2014-11-22 16:28:09 +00:00
parent 8e1f922248
commit 6b32a6e0e5
7 changed files with 350 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-db/src/base/dbconst.pas
View File

@ -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

2
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -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;

61
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -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

103
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -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;

2
packages/fcl-db/tests/dbtestframework.pas
View File

@ -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);

43
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

@ -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;

212
packages/fcl-db/tests/testsqldb.pas
View File

@ -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;