* Unprepare on commit/rollback

(cherry picked from commit c120a13af849b2075b862bd96847d41408a03267)

packages/fcl-db/src/base/database.inc

@@ -485,7 +485,12 @@ begin
   Result:=Assigned(DS);
 end;
 
-procedure TDBTransaction.CloseDataSets;
+procedure TDBTransaction.CloseDataset(DS: TDBDataset; InCommit : Boolean);
+begin
+  DS.Close;
+end;
+
+procedure TDBTransaction.CloseDataSets(InCommit: Boolean);
 
 Var
   I : longint;
@@ -501,7 +506,7 @@ begin
         begin
         DS:=TDBDataset(L[i]);
         If AllowClose(DS) then
-          DS.Close;
+          CloseDataset(DS,InCommit);
         end;
     finally
       FDatasets.UnlockList;
@@ -509,6 +514,12 @@ begin
     end;
 end;
 
+procedure TDBTransaction.CloseDataSets;
+
+begin
+  CloseDatasets(Active);
+end;
+
 destructor TDBTransaction.Destroy;
 
 begin

packages/fcl-db/src/base/db.pas

@@ -2168,21 +2168,23 @@ type
 
   { TDBTransaction }
 
-  TDBTransactionClass = Class of TDBTransaction;
+
   TDBTransaction = Class(TComponent)
   Private
     FActive        : boolean;
     FDatabase      : TDatabase;
     FDataSets      : TThreadList;
+    FClients      : TThreadList;
     FOpenAfterRead : boolean;
-    Function GetDataSetCount : Longint;
-    Function GetDataset(Index : longint) : TDBDataset;
-    procedure RegisterDataset (DS : TDBDataset);
-    procedure UnRegisterDataset (DS : TDBDataset);
+    function GetDataSet(Index: Longint): TDBDataset;
+    function GetDatasetCount: Integer;
     procedure RemoveDataSets;
     procedure SetActive(Value : boolean);
   Protected
+    procedure RegisterDataset (DS : TDBDataset); virtual;
+    procedure UnRegisterDataset (DS : TDBDataset); virtual;
     Function AllowClose(DS: TDBDataset): Boolean; virtual;
+    procedure CloseDataset(DS: TDBDataset; InCommit : Boolean); virtual;
     Procedure SetDatabase (Value : TDatabase); virtual;
     procedure CloseTrans;
     procedure OpenTrans;
@@ -2197,10 +2199,13 @@ type
     procedure StartTransaction; virtual; abstract;
     procedure InternalHandleException; virtual;
     procedure Loaded; override;
+    Property DatasetCount : Integer Read GetDatasetCount;
+    property Datasets[Index: Longint]: TDBDataset read GetDataSet;
   Public
     constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
     procedure CloseDataSets;
+    procedure CloseDataSets(InCommit : Boolean);
     Property DataBase : TDatabase Read FDatabase Write SetDatabase;
   published
     property Active : boolean read FActive write setactive;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -433,7 +433,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences];
+  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences] - [sqCommitEndsPrepared];
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
   FHandlePool:=TThreadlist.Create;
@@ -768,7 +768,7 @@ begin
   // unprepare statements associated with given transaction
   L:=FCursorList.LockList;
   try
-    For I:=0 to L.Count-1 do
+    For I:=L.Count-1 downto 0 do
       begin
       C:=TPQCursor(L[i]);
       UnprepareStatement(C,False);

packages/fcl-db/src/sqldb/sqldb.pp

@@ -174,7 +174,7 @@ type
   
   TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
 
-  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences);
+  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences, sqCommitEndsPrepared, sqRollbackEndsPrepared);
   TConnOptions= set of TConnOption;
 
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
@@ -237,7 +237,7 @@ type
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
     Procedure RegisterStatement(S : TCustomSQLStatement);
     Procedure UnRegisterStatement(S : TCustomSQLStatement);
-
+    Procedure UnPrepareStatements(aTransaction : TSQLTransaction);
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
     Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     function StrToStatementType(s : string) : TStatementType; virtual;
@@ -280,6 +280,7 @@ type
     // Unified version
     function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
     // Older versions.
+    Function HasTable(const aTable : String; SearchSystemTables : Boolean = false) : Boolean;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
@@ -330,8 +331,10 @@ type
     procedure SetParams(const AValue: TStringList);
     procedure SetSQLConnection(AValue: TSQLConnection);
   protected
+    Procedure UnPrepareStatements; virtual;
     Procedure MaybeStartTransaction;
     Function AllowClose(DS: TDBDataset): Boolean; override;
+    procedure CloseDataset(DS: TDBDataset; InCommit : Boolean); override;
     function GetHandle : Pointer; virtual;
     Procedure SetDatabase (Value : TDatabase); override;
     Function LogEvent(EventType : TDBEventType) : Boolean;
@@ -1390,6 +1393,7 @@ begin
   FLogEvents:=LogAllEvents; //match Property LogEvents...Default LogAllEvents
   FStatements:=TThreadList.Create;
   FStatements.Duplicates:=dupIgnore;
+  FConnOptions:=[sqCommitEndsPrepared, sqRollbackEndsPrepared];
 end;
 
 destructor TSQLConnection.Destroy;
@@ -1717,6 +1721,22 @@ begin
   end;
 end;
 
+function TSQLConnection.HasTable(const aTable: String; SearchSystemTables: Boolean) : Boolean;
+
+var
+  L : TStrings;
+
+begin
+  L:=TStringList.Create;
+  try
+    TStringList(L).Sorted:=True;
+    GetTableNames(L,SearchSystemTables);
+    Result:=L.IndexOf(aTable)<>-1;
+  Finally
+    L.Free;
+  end;
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -2015,6 +2035,29 @@ begin
     FStatements.Remove(S);
 end;
 
+procedure TSQLConnection.UnPrepareStatements(aTransaction: TSQLTransaction);
+Var
+  I : integer;
+  L : TList;
+  S : TCustomSQLStatement;
+
+begin
+  if not Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
+    exit;
+  L:=FStatements.LockList;
+  try
+    For I:=0 to L.Count-1 do
+      begin
+      S:=TCustomSQLStatement(L[i]);
+      if (S.Transaction=aTransaction) then
+        S.Unprepare;
+      end;
+    L.Clear;
+  finally
+    FStatements.UnlockList;
+  end;
+end;
+
 function TSQLConnection.CreateCustomQuery(aOwner : TComponent) : TCustomSQLQuery;
 
 begin
@@ -2418,6 +2461,14 @@ begin
   Database:=AValue;
 end;
 
+
+procedure TSQLTransaction.UnPrepareStatements;
+
+begin
+  if Assigned(SQLConnection) then
+    SQLConnection.UnPrepareStatements(Self);
+end;
+
 Procedure TSQLTransaction.MaybeStartTransaction;
 begin
   if not Active then
@@ -2435,10 +2486,24 @@ end;
 
 Function TSQLTransaction.AllowClose(DS: TDBDataset): Boolean;
 begin
-  if (DS is TSQLQuery) then
-    Result:=not (sqoKeepOpenOnCommit in TSQLQuery(DS).Options)
-  else
-    Result:=Inherited AllowClose(DS);
+  Result:=(DS is TSQLQuery);
+end;
+
+procedure TSQLTransaction.CloseDataset(DS: TDBDataset; InCommit : Boolean);
+
+Const
+  UnPrepOptions : Array[Boolean] of TConnOption
+                = (sqRollBackEndsPrepared, sqCommitEndsPrepared);
+
+var
+  Q : TSQLQuery;
+
+begin
+  Q:=DS as TSQLQuery;
+  if not (sqoKeepOpenOnCommit in Q.Options) then
+    inherited CloseDataset(Q,InCommit);
+  if UnPrepOptions[InCommit] in SQLConnection.ConnOptions then
+   Q.UnPrepare;
 end;
 
 procedure TSQLTransaction.Commit;
@@ -2446,6 +2511,8 @@ begin
   if Active  then
     begin
     CloseDataSets;
+    if sqCommitEndsPrepared in SQLConnection.ConnOptions then
+      UnPrepareStatements;
     If LogEvent(detCommit) then
       Log(detCommit,SCommitting);
     // The inherited closetrans must always be called.
@@ -2477,6 +2544,8 @@ begin
     if (stoUseImplicit in Options) then
       DatabaseError(SErrImplicitNoRollBack);
     CloseDataSets;
+    if sqRollbackEndsPrepared in SQLConnection.ConnOptions then
+      UnPrepareStatements;
     If LogEvent(detRollback) then
       Log(detRollback,SRollingBack);
     // The inherited closetrans must always be called.

packages/fcl-db/tests/dbtestframework.lpi

@@ -25,13 +25,13 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestFieldTypes.TestRefresh"/>
+        <CommandLineParams Value="--suite=TTestTSQLConnection.TestRollBackUnprepares"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestFieldTypes.TestRefresh"/>
+            <CommandLineParams Value="--suite=TTestTSQLConnection.TestRollBackUnprepares"/>
           </local>
         </Mode0>
       </Modes>
@@ -128,6 +128,11 @@
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -579,15 +579,23 @@ begin
   if assigned(FTransaction) then
     begin
     try
-      if Ftransaction.Active then Ftransaction.Rollback;
-      Ftransaction.StartTransaction;
+      if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+        begin
+        Ftransaction.Rollback;
+        Ftransaction.StartTransaction;
+        end;
       Fconnection.ExecuteDirect('DROP TABLE FPDEV');
-      Ftransaction.Commit;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
+      Fconnection.ExecuteDirect('DROP TABLE  FPDEV2');
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
     Except
       on E: Exception do begin
         if dblogfilename<>'' then
           DoLogEvent(nil,detCustom,'Exception running DropNDatasets: '+E.Message);
-        if Ftransaction.Active then Ftransaction.Rollback
+        if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+           Ftransaction.Rollback
       end;
     end;
     end;
@@ -598,10 +606,16 @@ begin
   if assigned(FTransaction) then
     begin
     try
-      if Ftransaction.Active then Ftransaction.Rollback;
-      Ftransaction.StartTransaction;
+      if Ftransaction.Active and not (stoUseImplicit in FTransaction.Options) then
+        begin
+        Ftransaction.Rollback;
+        Ftransaction.StartTransaction;
+        end;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.StartTransaction;
       Fconnection.ExecuteDirect('DROP TABLE FPDEV_FIELD');
-      Ftransaction.Commit;
+      if not (stoUseImplicit in FTransaction.Options) then
+        Ftransaction.Commit;
     Except
       on E: Exception do begin
         if dblogfilename<>'' then

packages/fcl-db/tests/testsqldb.pas

@@ -73,12 +73,15 @@ type
     procedure TestImplicitTransactionNotAssignable;
     procedure TestImplicitTransactionOK;
     procedure TryOpen;
+    procedure TestUnprepare(DoCommit : Boolean);
   published
     procedure TestUseImplicitTransaction;
     procedure TestUseExplicitTransaction;
     procedure TestExplicitConnect;
     procedure TestGetStatementInfo;
     procedure TestGetNextValue;
+    Procedure TestCommitUnprepares;
+    Procedure TestRollBackUnprepares;
   end;
 
   { TTestTSQLScript }
@@ -922,6 +925,63 @@ begin
   SQLDBConnector.Query.Open;
 end;
 
+procedure TTestTSQLConnection.TestUnprepare(DoCommit: Boolean);
+
+Var
+  Q1,Q2 : TSQLQuery;
+  S1,S2 : TSQLStatement;
+  PrepState : Boolean;
+begin
+  S1:=Nil;
+  S2:=Nil;
+  Q2:=Nil;
+  try
+    // Only prepared, not open
+    Q1:=TSQLQuery.Create(Nil);
+    Q1.DataBase:=SQLDBConnector.Connection;
+    Q1.Transaction:=SQLDBConnector.Transaction;
+    Q1.SQL.text:='SELECT COUNT(*) from FPDEV where (ID<:MaxID)';
+    Q1.Prepare;
+    // Explicitly prepared and opened
+    Q2:=TSQLQuery.Create(Nil);
+    Q2.DataBase:=SQLDBConnector.Connection;
+    Q2.Transaction:=SQLDBConnector.Transaction;
+    Q2.SQL.text:='SELECT COUNT(*) from FPDEV where (ID>:MinID)';
+    Q2.Prepare;
+    Q2.Open;
+    // A prepared statement;
+    S1:=TSQLStatement.Create(Nil);
+    S1.DataBase:=SQLDBConnector.Connection;
+    S1.Transaction:=SQLDBConnector.Transaction;
+    S1.SQL.Text:='update fpdev set id=id+1 where (id<:MaxID);';
+    S1.Prepare;
+    // A prepared and exected statement;
+    S2:=TSQLStatement.Create(Nil);
+    S2.DataBase:=SQLDBConnector.Connection;
+    S2.Transaction:=SQLDBConnector.Transaction;
+    S2.SQL.Text:='update fpdev set id=id+1 where (id<:MaxID);';
+    S2.Prepare;
+    S2.Execute;
+    if DoCommit then
+      begin
+      SQLDBConnector.Transaction.Commit;
+      PrepState:=Not (sqCommitEndsPrepared in SQLDBConnector.Connection.ConnOptions);
+      end
+    else
+      begin
+      SQLDBConnector.Transaction.RollBack;
+      PrepState:=Not (sqRollbackEndsPrepared in SQLDBConnector.Connection.ConnOptions);
+      end;
+    AssertEquals('Q1 prepared state',PrepState,Q1.Prepared);
+    AssertEquals('Q2 prepared state',PrepState,Q2.Prepared);
+    AssertEquals('S prepared state',PrepState,S1.Prepared);
+    AssertEquals('S prepared state',PrepState,S2.Prepared);
+  finally
+    Q1.Free;
+    Q2.Free;
+  end;
+end;
+
 procedure TTestTSQLConnection.TestUseExplicitTransaction;
 begin
   SQLDBConnector.Transaction.Active:=False;
@@ -987,6 +1047,16 @@ begin
   AssertTrue('Get value',SQLDBConnector.Connection.GetNextValue('me',1)>0);
 end;
 
+procedure TTestTSQLConnection.TestCommitUnprepares;
+begin
+  TestUnprepare(True);
+end;
+
+procedure TTestTSQLConnection.TestRollBackUnprepares;
+begin
+  TestUnprepare(False);
+end;
+
 
 { TTestTSQLScript }