[fpc-devel] TThread.Queue and TThread.Destroy

[Martin]

On 21/06/2018 01:27, Martin wrote:
> fpc 3.0.4 / Linux 64bit (Fedora)
>
> What should happen if:
>
> - A Thread has queued a call with "TThread.Queue"
> - The Thread gets Terminated and Destroyed before the queued method 
> can be executed.
>   That is the thread checks for "Terminated" and exits Execute before 
> the queued method can be executed.
>
> Diving into TThread.Destroy I can see: RemoveQueuedEvents(Self);
> So I would assume that all the queued calls are removed, and will not 
> be executed.
...
>
> class procedure TThread.RemoveQueuedEvents(aThread: TThread; aMethod: 
> TThreadMethod);
> var
>   entry, tmpentry, lastentry: PThreadQueueEntry;
> begin
>   { anything to do at all? }
>   if not Assigned(aThread) or not Assigned(aMethod) then
>     Exit;
Arrgh, my fault, the above is correct, but instead a few lines further

       if Assigned(aThread) and (entry^.Thread <> aThread) then begin
         lastentry := entry;
         entry := entry^.Next;
         Continue;
       end;
       { then check for the method }
       if entry^.Method <> aMethod then begin  ///////////// <<< should 
that not also be "if assigned(aMethod) and ..." // entry^.Method will 
never be equal to nil
         lastentry := entry;
         entry := entry^.Next;
         Continue;
       end;


But even then, I made a test project and still get the call.
tested with fpc 3.0.4 on
- win 10 64 / but 32 bit fpc
- fedora 64bit



program Project1;

uses
   // cthreads,  // uncomment on Linux
   Classes, sysutils;

type
   TTestThread = class(TThread)
   protected
     procedure Execute; override;
   public
   end;

   TTest = class
   public
     procedure CallMeNot;
   end;

var
   Foo: TTestThread;
   Test: TTest;
   event: PRTLEvent;

procedure TTestThread.Execute;
begin
   Queue(@Test.CallMeNot);
   RTLeventSetEvent(event);
   while not Terminated do ;
end;

procedure TTest.CallMeNot;
begin
   writeln('shouldnt be here');
end;

begin
   event := RTLEventCreate;

   Test := TTest.Create;
   Foo := TTestThread.Create(False);
   RTLeventWaitFor(event); // make sure the event is queued

   //TThread.RemoveQueuedEvents(foo, @Test.CallMeNot); // this works
   Sleep(500);

   Foo.Terminate;
   foo.Destroy;

   TThread.RemoveQueuedEvents(foo, @Test.CallMeNot); // this does not 
remove it in most cases // foo still has the value of the pointer to 
freed mem, so it should
   sleep(500);

   CheckSynchronize();
   writeln('done');
   readln;
end.