* Make link dataset/connection/transaction thread safe (Bug ID 34274)

git-svn-id: trunk@42972 -

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

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

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

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

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

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

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

@@ -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;
@@ -1193,7 +1193,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;
@@ -1269,11 +1270,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;
@@ -1792,9 +1799,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);