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

* Fix AV when freeing transactions. Reported by Pascal Riekenberg. Fixes issuu #40571

Browse Source 
(cherry picked from commit 3b7d6d21e2)
This commit is contained in:
Michaël Van Canneyt 2023-12-23 23:11:25 +01:00
parent 3b45e9c5bb
commit 8db3828637
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
packages/fcl-db/src/base/database.inc
View File

@ -454,15 +454,14 @@ end;
procedure TDBTransaction.SetDatabase(Value: TDatabase);
begin
If Value<>FDatabase then
begin
CheckInactive;
If Assigned(FDatabase) then
FDatabase.UnregisterTransaction(Self);
If Value<>Nil Then
Value.RegisterTransaction(Self);
FDatabase:=Value;
end;
If Value=FDatabase then
exit;
CheckInactive;
If Assigned(FDatabase) then
FDatabase.UnregisterTransaction(Self);
If Value<>Nil Then
Value.RegisterTransaction(Self);
FDatabase:=Value;
end;
constructor TDBTransaction.Create(AOwner: TComponent);
@ -523,9 +522,9 @@ end;
destructor TDBTransaction.Destroy;
begin
Database:=Nil;
CloseDataSets;
RemoveDatasets;
Database:=Nil;
FDatasets.Free;
Inherited;
end;

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

@ -2497,13 +2497,21 @@ Const
var
Q : TSQLQuery;
C : TSQLConnection;
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;
C:=SQLConnection;
if C=Nil then
C:=Q.SQLConnection;
if Q.Prepared then
if not Assigned(C) then
// No database, we must unprepare...
Q.UnPrepare // Unprepare checks if there is still a cursor.
else if UnPrepOptions[InCommit] in C.ConnOptions then
Q.UnPrepare;
end;
procedure TSQLTransaction.Commit;