View Issue Details

IDProjectCategoryView StatusLast Update
0035638FPCRTLpublic2019-06-19 10:16
ReporterPascal RiekenbergAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindows 10 x64OS Version1809
Product Version3.3.1Product Build 
Target VersionFixed in Version3.3.1 
Summary0035638: Make TReader.ReadRootComponent threadsafe
DescriptionInstantiating componentes from different threads often doesn't work due to not unique component names.
Attached patch fixes this.
TagsNo tags attached.
Fixed in Revision42248
FPCOldBugId
FPCTarget3.2.0
Attached Files
  • classes.patch (2,311 bytes)
    Index: rtl/objpas/classes/classesh.inc
    ===================================================================
    --- rtl/objpas/classes/classesh.inc	(revision 42128)
    +++ rtl/objpas/classes/classesh.inc	(working copy)
    @@ -1437,6 +1437,7 @@
         FParent: TComponent;
         FFixups: TObject;
         FLoaded: TFpList;
    +    FLock: TRTLCriticalSection;
         FOnFindMethod: TFindMethodEvent;
         FOnSetMethodProperty: TSetMethodPropertyEvent;
         FOnSetName: TSetNameEvent;
    @@ -1451,6 +1452,8 @@
         FOnReadStringProperty:TReadWriteStringPropertyEvent;
         procedure DoFixupReferences;
         function FindComponentClass(const AClassName: string): TComponentClass;
    +    procedure Lock;
    +    procedure Unlock;
       protected
         function Error(const Message: string): Boolean; virtual;
         function FindMethod(ARoot: TComponent; const AMethodName: string): CodePointer; virtual;
    Index: rtl/objpas/classes/reader.inc
    ===================================================================
    --- rtl/objpas/classes/reader.inc	(revision 42128)
    +++ rtl/objpas/classes/reader.inc	(working copy)
    @@ -609,14 +609,26 @@
       If (Stream=Nil) then
         Raise EReadError.Create(SEmptyStreamIllegalReader);
       FDriver := CreateDriver(Stream, BufSize);
    +  InitCriticalSection(FLock);
     end;
     
     destructor TReader.Destroy;
     begin
    +  DoneCriticalSection(FLock);
       FDriver.Free;
       inherited Destroy;
     end;
     
    +procedure TReader.Lock;
    +begin
    +  EnterCriticalSection(FLock);
    +end;
    +
    +procedure TReader.Unlock;
    +begin
    +  LeaveCriticalSection(FLock);
    +end;
    +
     procedure TReader.FlushBuffer;
     begin
       Driver.FlushBuffer;
    @@ -1476,12 +1488,17 @@
               { Don't use Result.Name directly, as this would influence
                 FindGlobalComponent in successive loop runs }
               ResultName := CompName;
    -          while Assigned(FindGlobalComponent(ResultName)) do
    -          begin
    -            Inc(i);
    -            ResultName := CompName + '_' + IntToStr(i);
    +          Lock;
    +          try
    +            while Assigned(FindGlobalComponent(ResultName)) do
    +            begin
    +              Inc(i);
    +              ResultName := CompName + '_' + IntToStr(i);
    +            end;
    +            Result.Name := ResultName;
    +          finally
    +            Unlock;
               end;
    -          Result.Name := ResultName;
             end;
           end;
     
    
    classes.patch (2,311 bytes)

Activities

Pascal Riekenberg

2019-05-27 10:47

reporter  

classes.patch (2,311 bytes)
Index: rtl/objpas/classes/classesh.inc
===================================================================
--- rtl/objpas/classes/classesh.inc	(revision 42128)
+++ rtl/objpas/classes/classesh.inc	(working copy)
@@ -1437,6 +1437,7 @@
     FParent: TComponent;
     FFixups: TObject;
     FLoaded: TFpList;
+    FLock: TRTLCriticalSection;
     FOnFindMethod: TFindMethodEvent;
     FOnSetMethodProperty: TSetMethodPropertyEvent;
     FOnSetName: TSetNameEvent;
@@ -1451,6 +1452,8 @@
     FOnReadStringProperty:TReadWriteStringPropertyEvent;
     procedure DoFixupReferences;
     function FindComponentClass(const AClassName: string): TComponentClass;
+    procedure Lock;
+    procedure Unlock;
   protected
     function Error(const Message: string): Boolean; virtual;
     function FindMethod(ARoot: TComponent; const AMethodName: string): CodePointer; virtual;
Index: rtl/objpas/classes/reader.inc
===================================================================
--- rtl/objpas/classes/reader.inc	(revision 42128)
+++ rtl/objpas/classes/reader.inc	(working copy)
@@ -609,14 +609,26 @@
   If (Stream=Nil) then
     Raise EReadError.Create(SEmptyStreamIllegalReader);
   FDriver := CreateDriver(Stream, BufSize);
+  InitCriticalSection(FLock);
 end;
 
 destructor TReader.Destroy;
 begin
+  DoneCriticalSection(FLock);
   FDriver.Free;
   inherited Destroy;
 end;
 
+procedure TReader.Lock;
+begin
+  EnterCriticalSection(FLock);
+end;
+
+procedure TReader.Unlock;
+begin
+  LeaveCriticalSection(FLock);
+end;
+
 procedure TReader.FlushBuffer;
 begin
   Driver.FlushBuffer;
@@ -1476,12 +1488,17 @@
           { Don't use Result.Name directly, as this would influence
             FindGlobalComponent in successive loop runs }
           ResultName := CompName;
-          while Assigned(FindGlobalComponent(ResultName)) do
-          begin
-            Inc(i);
-            ResultName := CompName + '_' + IntToStr(i);
+          Lock;
+          try
+            while Assigned(FindGlobalComponent(ResultName)) do
+            begin
+              Inc(i);
+              ResultName := CompName + '_' + IntToStr(i);
+            end;
+            Result.Name := ResultName;
+          finally
+            Unlock;
           end;
-          Result.Name := ResultName;
         end;
       end;
 
classes.patch (2,311 bytes)

Michael Van Canneyt

2019-06-19 08:25

administrator   ~0116780

Checked and applied, thank you for the patch !

Pascal Riekenberg

2019-06-19 10:16

reporter   ~0116785

yw

Issue History

Date Modified Username Field Change
2019-05-27 10:47 Pascal Riekenberg New Issue
2019-05-27 10:47 Pascal Riekenberg File Added: classes.patch
2019-05-27 11:02 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-05-27 11:02 Michael Van Canneyt Status new => assigned
2019-06-19 08:25 Michael Van Canneyt Status assigned => resolved
2019-06-19 08:25 Michael Van Canneyt Resolution open => fixed
2019-06-19 08:25 Michael Van Canneyt Fixed in Version => 3.3.1
2019-06-19 08:25 Michael Van Canneyt Fixed in Revision => 42248
2019-06-19 08:25 Michael Van Canneyt FPCTarget => 3.2.0
2019-06-19 08:25 Michael Van Canneyt Note Added: 0116780
2019-06-19 10:16 Pascal Riekenberg Status resolved => closed
2019-06-19 10:16 Pascal Riekenberg Note Added: 0116785