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

* Merging revisions 42972 from trunk:

Browse Source 
------------------------------------------------------------------------
    r42972 | michael | 2019-09-10 10:44:41 +0200 (Tue, 10 Sep 2019) | 1 line
    
    * Make link dataset/connection/transaction thread safe (Bug ID 34274)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43237 -
This commit is contained in:
michael 2019-10-19 14:38:01 +00:00
parent 299e79e0f0
commit 8ca580c2ad
4 changed files with 248 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -58,8 +58,8 @@ constructor TDatabase.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FParams:=TStringlist.Create;
FDatasets:=TList.Create;
FTransactions:=TList.Create;
FDatasets:=TThreadList.Create;
FTransactions:=TThreadList.Create;
FConnected:=False;
end;
@ -77,51 +77,81 @@ end;
procedure TDatabase.CloseDataSets;
Var I : longint;
Var
I : longint;
L : TList;
begin
If Assigned(FDatasets) then
begin
For I:=FDatasets.Count-1 downto 0 do
TDataset(FDatasets[i]).Close;
L:=FDatasets.LockList;
try
For I:=L.Count-1 downto 0 do
TDataset(L[i]).Close;
finally
FDatasets.UnlockList;
end;
end;
end;
procedure TDatabase.CloseTransactions;
Var I : longint;
Var
I : longint;
L : TList;
begin
If Assigned(FTransactions) then
begin
For I:=FTransactions.Count-1 downto 0 do
try
TDBTransaction(FTransactions[i]).EndTransaction;
except
if not ForcedClose then
Raise;
end;
L:=FTransactions.LockList;
try
For I:=L.Count-1 downto 0 do
try
TDBTransaction(L[i]).EndTransaction;
except
if not ForcedClose then
Raise;
end;
finally
FTransactions.UnlockList
end;
end;
end;
procedure TDatabase.RemoveDataSets;
Var I : longint;
Var
I : longint;
L : TList;
begin
If Assigned(FDatasets) then
For I:=FDataSets.Count-1 downto 0 do
TDBDataset(FDataSets[i]).Database:=Nil;
begin
L:=FDatasets.LockList;
try
For I:=L.Count-1 downto 0 do
TDBDataset(L[i]).Database:=Nil;
finally
FDatasets.UnlockList;
end;
end;
end;
procedure TDatabase.RemoveTransactions;
Var I : longint;
Var
I : longint;
L : TList;
begin
If Assigned(FTransactions) then
For I:=FTransactions.Count-1 downto 0 do
TDBTransaction(FTransactions[i]).Database:=Nil;
begin
L:=FTransactions.LockList;
try
For I:=L.Count-1 downto 0 do
TDBTransaction(L[i]).Database:=Nil;
finally
FTransactions.UnlockList
end;
end;
end;
procedure TDatabase.SetParams(AValue: TStrings);
@ -132,92 +162,157 @@ end;
Function TDatabase.GetDataSetCount : Longint;
Var
L : TList;
begin
Result:=0;
If Assigned(FDatasets) Then
Result:=FDatasets.Count
else
Result:=0;
begin
L:=FDatasets.LockList;
try
Result:=L.Count;
finally
FDatasets.Unlocklist;
end;
end;
end;
Function TDatabase.GetTransactionCount : Longint;
Var
L : TList;
begin
Result:=0;
If Assigned(FTransactions) Then
Result:=FTransactions.Count
else
Result:=0;
begin
L:=FTransactions.LockList;
try
Result:=L.Count;
finally
FTransactions.UnlockList;
end;
end;
end;
Function TDatabase.GetDataset(Index : longint) : TDataset;
Var
L : TList;
begin
If Assigned(FDatasets) then
Result:=TDataset(FDatasets[Index])
else
If Not Assigned(FDatasets) then
begin
result := nil;
DatabaseError(SNoDatasets);
end
else
begin
L:=FDatasets.LockList;
try
Result:=TDataset(L[Index])
finally
FDatasets.UnlockList;
end;
end;
end;
Function TDatabase.GetTransaction(Index : longint) : TDBtransaction;
Var
L : TList;
begin
If Assigned(FTransactions) then
Result:=TDBTransaction(FTransactions[Index])
else
If Not Assigned(FTransactions) then
begin
result := nil;
DatabaseError(SNoTransactions);
end
else
begin
L:=FTransactions.LockList;
try
Result:=TDBTransaction(L[Index])
finally
FTransactions.UnlockList;
end;
end;
end;
procedure TDatabase.RegisterDataset (DS : TDBDataset);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FDatasets.IndexOf(DS);
If I=-1 then
FDatasets.Add(DS)
else
DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
L:=FDatasets.LockList;
try
I:=L.IndexOf(DS);
If I=-1 then
L.Add(DS)
else
DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
finally
FDatasets.UnlockList;
end;
end;
procedure TDatabase.RegisterTransaction (TA : TDBTransaction);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FTransactions.IndexOf(TA);
If I=-1 then
FTransactions.Add(TA)
else
DatabaseErrorFmt(STransactionRegistered,[TA.Name]);
L:=FTransactions.LockList;
try
I:=L.IndexOf(TA);
If I=-1 then
L.Add(TA)
else
DatabaseErrorFmt(STransactionRegistered,[TA.Name]);
finally
FTransactions.UnlockList;
end;
end;
procedure TDatabase.UnRegisterDataset (DS : TDBDataset);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FDatasets.IndexOf(DS);
If I<>-1 then
FDatasets.Delete(I)
else
DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
L:=FDatasets.LockList;
try
I:=L.IndexOf(DS);
If I<>-1 then
L.Delete(I)
else
DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
finally
FDatasets.UnlockList;
end;
end;
procedure TDatabase.UnRegisterTransaction (TA : TDBTransaction);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FTransactions.IndexOf(TA);
If I<>-1 then
FTransactions.Delete(I)
else
DatabaseErrorFmt(SNoTransactionRegistered,[TA.Name]);
L:=FTransactions.LockList;
try
I:=L.IndexOf(TA);
If I<>-1 then
L.Delete(I)
else
DatabaseErrorFmt(SNoTransactionRegistered,[TA.Name]);
finally
FTransactions.UnlockList;
end;
end;
@ -374,7 +469,7 @@ constructor TDBTransaction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDatasets:=TList.Create;
FDatasets:=TThreadList.Create;
end;
procedure TDBTransaction.CheckDatabase;
@ -394,17 +489,23 @@ procedure TDBTransaction.CloseDataSets;
Var
I : longint;
L : TList;
DS : TDBDataset;
begin
If Assigned(FDatasets) then
begin
For I:=FDatasets.Count-1 downto 0 do
begin
DS:=TDBDataset(FDatasets[i]);
If AllowClose(DS) then
DS.Close;
end;
L:=FDatasets.LockList;
try
For I:=L.Count-1 downto 0 do
begin
DS:=TDBDataset(L[i]);
If AllowClose(DS) then
DS.Close;
end;
finally
FDatasets.UnlockList;
end;
end;
end;
@ -420,57 +521,91 @@ end;
procedure TDBTransaction.RemoveDataSets;
Var I : longint;
Var
I : longint;
L : TList;
begin
If Assigned(FDatasets) then
For I:=FDataSets.Count-1 downto 0 do
TDBDataset(FDataSets[i]).Transaction:=Nil;
If Not Assigned(FDatasets) then
exit;
L:=FDatasets.LockList;
try
For I:=L.Count-1 downto 0 do
TDBDataset(L[i]).Transaction:=Nil;
finally
FDatasets.unlockList;
end;
end;
function TDBTransaction.GetDataset(Index: longint): TDBDataset;
Var
L : TList;
begin
If Assigned(FDatasets) then
Result:=TDBDataset(FDatasets[Index])
else
begin
Result := nil;
If Not Assigned(FDatasets) then
DatabaseError(SNoDatasets);
L:=FDatasets.LockList;
try
Result:=TDBDataset(L[Index])
finally
FDatasets.UnlockList;
end;
end;
function TDBTransaction.GetDataSetCount: Longint;
Var
L : TList;
begin
If Assigned(FDatasets) Then
Result:=FDatasets.Count
else
Result:=0;
Result:=0;
If Not Assigned(FDatasets) Then
exit;
L:=FDatasets.lockList;
try
Result:=L.Count
finally
FDatasets.UnlockList;
end;
end;
procedure TDBTransaction.RegisterDataset (DS : TDBDataset);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FDatasets.IndexOf(DS);
If I=-1 then
FDatasets.Add(DS)
else
DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
L:=FDatasets.LockList;
try
I:=L.IndexOf(DS);
If I=-1 then
L.Add(DS)
else
DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
finally
FDatasets.UnlockList;
end;
end;
procedure TDBTransaction.UnRegisterDataset (DS : TDBDataset);
Var I : longint;
Var
I : longint;
L : TList;
begin
I:=FDatasets.IndexOf(DS);
If I<>-1 then
FDatasets.Delete(I)
else
DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
L:=FDatasets.LockList;
try
I:=L.IndexOf(DS);
If I<>-1 then
L.Delete(I)
else
DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
finally
FDatasets.UnlockList;
end;
end;
{ ---------------------------------------------------------------------

6
packages/fcl-db/src/base/db.pas
View File

@ -1956,7 +1956,7 @@ type
Private
FActive : boolean;
FDatabase : TDatabase;
FDataSets : TList;
FDataSets : TThreadList;
FOpenAfterRead : boolean;
Function GetDataSetCount : Longint;
Function GetDataset(Index : longint) : TDBDataset;
@ -2047,8 +2047,8 @@ type
private
FConnected : Boolean;
FDataBaseName : String;
FDataSets : TList;
FTransactions : TList;
FDataSets : TThreadList;
FTransactions : TThreadList;
FDirectory : String;
FKeepConnection : Boolean;
FParams : TStrings;

2
packages/fcl-db/src/base/fields.inc
View File

@ -496,6 +496,8 @@ end;
function TField.GetAsBytes: TBytes;
begin
Result:=Default(TBytes);
Writeln('Allocating ',Datasize,' bytes');
SetLength(Result, DataSize);
if assigned(result) and not GetData(@Result[0], False) then
Result := nil;

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

@ -192,7 +192,7 @@ type
FCharSet : string;
FCodePage : TSystemCodePage;
FRole : String;
FStatements : TFPList;
FStatements : TThreadList;
FLogEvents: TDBEventTypes;
FOnLog: TDBLogNotifyEvent;
function GetPort: cardinal;
@ -265,11 +265,9 @@ type
Procedure MaybeConnect;
Property Statements : TFPList Read FStatements;
Property Statements : TThreadList Read FStatements;
property Port: cardinal read GetPort write SetPort;
public
property Handle: Pointer read GetHandle;
property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTransaction; override;
@ -290,6 +288,8 @@ type
procedure DropDB; virtual;
function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual;
property ConnOptions: TConnOptions read FConnOptions;
property Handle: Pointer read GetHandle;
property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars;
published
property Password : string read FPassword write FPassword;
property Transaction : TSQLTransaction read FTransaction write SetTransaction;
@ -1192,7 +1192,8 @@ begin
FSQLFormatSettings:=DefaultSQLFormatSettings;
FFieldNameQuoteChars:=DoubleQuotes;
FLogEvents:=LogAllEvents; //match Property LogEvents...Default LogAllEvents
FStatements:=TFPList.Create;
FStatements:=TThreadList.Create;
FStatements.Duplicates:=dupIgnore;
end;
destructor TSQLConnection.Destroy;
@ -1268,11 +1269,17 @@ procedure TSQLConnection.DoInternalDisconnect;
Var
I : integer;
L : TList;
begin
For I:=0 to FStatements.Count-1 do
TCustomSQLStatement(FStatements[i]).Unprepare;
FStatements.Clear;
L:=FStatements.LockList;
try
For I:=0 to L.Count-1 do
TCustomSQLStatement(L[i]).Unprepare;
L.Clear;
finally
FStatements.UnlockList;
end;
end;
procedure TSQLConnection.StartTransaction;
@ -1791,9 +1798,9 @@ begin
end;
procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
begin
if FStatements.IndexOf(S)=-1 then
FStatements.Add(S);
FStatements.Add(S);
end;
procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);