* allow tthread-based threads to only start executing once the constructor

    has finished running (based on patch by Jared Davison, mantis #16884)

git-svn-id: trunk@15599 -

.gitattributes

@@ -10543,6 +10543,7 @@ tests/webtbs/tw16820.pp svneol=native#text/plain
 tests/webtbs/tw16861.pp svneol=native#text/plain
 tests/webtbs/tw16863.pp svneol=native#text/plain
 tests/webtbs/tw16874.pp svneol=native#text/plain
+tests/webtbs/tw16884.pp svneol=native#text/plain
 tests/webtbs/tw16901.pp svneol=native#text/plain
 tests/webtbs/tw16949a.pp svneol=native#text/plain
 tests/webtbs/tw16949b.pp svneol=native#text/plain

rtl/objpas/classes/classes.inc

@@ -124,7 +124,8 @@ end;
 procedure TThread.AfterConstruction;
 begin
   inherited AfterConstruction;
-//  Resume;
+  if not FInitialSuspended then
+    Resume;
 end;
 
 

rtl/objpas/classes/classesh.inc

@@ -1490,6 +1490,7 @@ type
     FSem: Pointer;
     FInitialSuspended: boolean;
     FSuspendedExternal: boolean;
+    FSuspendedInternal: longbool;
     FThreadReaped: boolean;
 {$endif}
 {$ifdef netwlibc}

rtl/unix/tthread.inc

@@ -40,6 +40,8 @@
 
 { ok, so this is a hack, but it works nicely. Just never use
   a multiline argument with WRITE_DEBUG! }
+
+{.$DEFINE DEBUG_MT}
 {$MACRO ON}
 {$IFDEF DEBUG_MT}
 {$define WRITE_DEBUG := writeln} // actually write something
@@ -120,7 +122,10 @@ begin
       end
      else
        begin
-         WRITE_DEBUG('going into LThread.Execute');
+         LThread.FSuspendedInternal := true;
+         WRITE_DEBUG('waiting for SuspendedInternal - ', LThread.ClassName);
+        CurrentTM.SemaphoreWait(LThread.FSem);
+         WRITE_DEBUG('going into LThread.Execute - ', LThread.ClassName);
          LThread.Execute;
        end;
   except
@@ -180,6 +185,7 @@ begin
   FThreadReaped := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
+  FSuspendedInternal := not CreateSuspended;
   WRITE_DEBUG('creating thread, self = ',longint(self));
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   if FHandle = TThreadID(0) then
@@ -221,7 +227,7 @@ begin
       if not FThreadReaped then
         begin
           Terminate;
-          if (FInitialSuspended) then
+          if (FSuspendedInternal or FInitialSuspended) then
             Resume;
           WaitFor;
         end;
@@ -263,7 +269,12 @@ end;
 
 procedure TThread.Resume;
 begin
-  if (not FSuspendedExternal) then
+  if FSuspendedInternal and (InterLockedExchange(longint(FSuspendedInternal),ord(false)) = longint(longbool(true))) then
+    begin
+      WRITE_DEBUG('resuming thread after TThread construction',ptruint(self));
+      CurrentTM.SemaphorePost(FSem);
+    end
+  else if (not FSuspendedExternal) then
     begin
       if FSuspended and
          { don't compare with ord(true) or ord(longbool(true)), }

tests/webtbs/tw16884.pp

@@ -0,0 +1,71 @@
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  sysutils, classes;
+
+type
+ TThreadChild = class(TThread)
+  private
+    FThreadState: Integer;
+  public
+    constructor CreateRace(const ForceFail: Boolean);
+    procedure Execute; override;
+  end; 
+
+constructor TThreadChild.CreateRace(const ForceFail: Boolean);
+begin
+  FThreadState := 1;
+  inherited Create(False {not suspended}); { the bug is that the inherited call will actually cause execute to be run before the rest of the constructor - serious problem as the thread state may not be initialised properly }
+
+  if ForceFail then
+    Sleep(1000); { This will force the issue. -
+                   it may not be easily reproducable depending on your OS, CPU thread scheduling.
+
+                   I discovered this on my OSX macbook but my collegue never had the problem on his computer OSX mac mini}
+
+  FThreadState := 2; { this is the final state that we should see in the execute, if we get a 1 in the TThreadChild.Execute, then we know that the execute won the race with the constructor }
+
+  Sleep(200);
+end;
+
+var
+  ATestFailed: boolean;
+
+procedure TThreadChild.Execute;
+var
+  ThreadState: Integer;
+begin
+  ThreadState := FThreadState;
+
+  if ThreadState = 1 then
+    begin
+      writeln(Format('ThreadState = %d - constructor race condition occured (should be 2)', [FThreadState])); { we should get the Value 2 here every time, not 1. }
+      ATestFailed := True;
+      readwritebarrier;
+    end
+  else if ThreadSTate = 2 then
+    begin
+      writeln(Format('ThreadState = %d - constructor race condition did not occur (should be 2)', [FThreadState]));
+    end;
+end;
+
+var
+  t1, t2, t3: tthread;
+begin
+  ATestFailed:=false;
+  t1:=TThreadChild.createrace(true);
+  t2:=TThreadChild.createrace(true);
+  t3:=TThreadChild.createrace(true);
+  t1.waitfor;
+  t1.free;
+  t2.waitfor;
+  t2.free;
+  t3.waitfor;
+  t3.free;
+  readwritebarrier;
+  if ATestFailed then
+    halt(1);
+end.