paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 14:22:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-12-23 23:11:25 +01:00
parent 65234c674a
commit 3b7d6d21e2
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); procedure TDBTransaction.SetDatabase(Value: TDatabase);
begin begin
If Value<>FDatabase then If Value=FDatabase then
begin exit;
CheckInactive; CheckInactive;
If Assigned(FDatabase) then If Assigned(FDatabase) then
FDatabase.UnregisterTransaction(Self); FDatabase.UnregisterTransaction(Self);
If Value<>Nil Then If Value<>Nil Then
Value.RegisterTransaction(Self); Value.RegisterTransaction(Self);
FDatabase:=Value; FDatabase:=Value;
end;
end; end;
constructor TDBTransaction.Create(AOwner: TComponent); constructor TDBTransaction.Create(AOwner: TComponent);
@ -523,9 +522,9 @@ end;
destructor TDBTransaction.Destroy; destructor TDBTransaction.Destroy;
begin begin
Database:=Nil;
CloseDataSets; CloseDataSets;
RemoveDatasets; RemoveDatasets;
Database:=Nil;
FDatasets.Free; FDatasets.Free;
Inherited; Inherited;
end; end;

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

@ -2518,13 +2518,21 @@ Const
var var
Q : TSQLQuery; Q : TSQLQuery;
C : TSQLConnection;
begin begin
Q:=DS as TSQLQuery; Q:=DS as TSQLQuery;
if not (sqoKeepOpenOnCommit in Q.Options) then if not (sqoKeepOpenOnCommit in Q.Options) then
inherited CloseDataset(Q,InCommit); inherited CloseDataset(Q,InCommit);
if UnPrepOptions[InCommit] in SQLConnection.ConnOptions then C:=SQLConnection;
Q.UnPrepare; 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; end;
procedure TSQLTransaction.Commit; procedure TSQLTransaction.Commit;