TTask running twice?

[RaelB 4]

I have the following code. It creates 3 tasks and then calls `TTask.WaitForAll(tasks)` :

 

procedure TVideoFrame.AddVideo(....);
var
...
begin
  MainTrace.SendStack('AddVideo');
  btnPaste.Enabled := False;
  btnUpdate.Enabled := False;
  Application.ProcessMessages;
  ...

  TTask.Run(procedure()
    var
     tasks: array of ITask;
	 ...
     S: String;
     Res: Integer;

    begin
     Setlength(tasks ,3);
     MemStream := nil;

     tasks[0] := TTask.Create (procedure ()
       begin
         ...
       end);
     tasks[0].Start;

     tasks[1] := TTask.Create (procedure ()
       begin
         MainTrace.Send('Run Task 1');
         S := GetHtml(Url);
       end);
     tasks[1].Start;

     tasks[2] := TTask.Create (procedure ()
       begin
	     ...
       end);
     tasks[2].Start;

     MainTrace.Send('WaitForAll');
     TTask.WaitForAll(tasks);

     EnterCriticalSection(_CritSec);  // Don't think it's necessary but just to be safe...
     try
       try
		 .... // Process results..
       except
         On E: Exception do
           MainTrace.Send(E.ClassName, E.Message);
       end;
     finally
       LeaveCriticalSection(_CritSec);
     end;

     TThread.Synchronize(nil, procedure()
       begin
         btnUpdate.Enabled := True;
         btnPaste.Enabled := True;
		 
		 ....
		 
		
       end);
    end);
end;

 

A normal trace would look like this:

 

It seems a little strange that the trace of `WaitForAll` happens before `Run Task 1`, but maybe that's because it takes a few moments before Task 1 starts to run. Anyway that is not the main issue.

 

The problem is I get a trace like this:

 

Task 1 is running twice, and you can see from the trace in a different thread. I also have a breakpoint in the `GetHtml` method, and I see that in fact it is being called twice. How does this happen? In the main user interface I only click the button once. (as you can see from the code, I disable the button so I can't click it twice anyway..)

 

Thanks

Rael

[Guest]

as first dont show nothing, it dont appears on your debug screen... the second show a message on Maintrace.Send...

 

try works like sample in

http://docwiki.embarcadero.com/RADStudio/Sydney/en/Using_TTask_from_the_Parallel_Programming_Library

 

try without Task.Run()....

 

hug

[Der schöne Günther 316]

What is the second column with the hexadecimal numbers? A thread ID? If yes, it doesn't make sense for "WaitForAll" and "Run Task 1" to be run in the very same thread. There must be something wrong with your code. Can you provide a code example that is reproducable?

[Guest]

WaitForAll is raised and wait for Task more long...

then, appears firstly because it "raise"  the others

some like this!

im on smartphone now, no pc near...

hexa it should be memory pointer where the call is in

Edited December 30, 2020 by Guest

[Guest]

read the HELP please

Edited December 30, 2020 by Guest

[RaelB 4]

@Der schöne Günther: Yes, it is a thread ID.

 

What you say is an interesting observation. I have created a small demo (attached). I am not able to reproduce the problem of Task 1 running twice, however on some occassion, the WaitForAll and Run Task 1 calls have the same Thread ID.

 

Here is an example trace. The issue occurred for the first run, but not the others.

0x3374	19:33:20:910	AddVideo	
0x6518	19:33:21:125	WaitForAll	
0x6518	19:33:21:179	Run Task 1	
0x6518	19:33:22:590	---	
0x3374	19:33:24:230	AddVideo	
0x47C4	19:33:24:240	WaitForAll	
0x1984	19:33:24:240	Run Task 1	
0x47C4	19:33:24:875	---	
0x3374	19:33:26:397	AddVideo	
0x6130	19:33:26:459	WaitForAll	
0x6518	19:33:26:459	Run Task 1	
0x6130	19:33:27:247	---	

 

Perhaps if you look at the code you will see something wrong.

 

I am using the open source TraceTool for the logging. (https://github.com/capslock66/Tracetool)

 

TTaskRun Test.zip

 

(btw, I'm using Rio 10.3.2)

 

Thanks

Edited December 30, 2020 by RaelB
Added Delphi Version

[Der schöne Günther 316]

It sounds like this could be the cause:

[RSP-16377] TTask.WaitForAll crashes if timeout is INFINITE - Embarcadero Technologies

Rio 10.3.2 is still affected, it was fixed in 10.4 Sydney.

 

Quote

The inner task procedure is called twice sometimes (...)

Can you check what happens if you add an explicit timeout to your WaitForAll(..)

Edited December 30, 2020 by Der schöne Günther

[Guest]

try my sample 

• UI main totally responsive!

 

 

unit uFormMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btn_Start_TaskRUN: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    btn_Stop_TaskRUN: TButton;
    Memo1: TMemo;
    procedure btn_Start_TaskRUNClick(Sender: TObject);
    procedure btn_Stop_TaskRUNClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.Threading;

// Proc: TProc
var
  lMyProc1: TProc = nil;
  lMyProc2: TProc = nil;
  lMyProc3: TProc = nil;
  //
  lMyValue1: integer = 0;
  lMyValue2: integer = 0;
  lMyValue3: integer = 0;
  //
  lMyTaskRUN_obj: ITask = nil;
  //
  lMyTasks: array [0 .. 2] of ITask = (
    nil,
    nil,
    nil
  ); // if is only 3, then...

procedure prcTask1;
begin
  // some code pertinent...
  Sleep(3000);
  lMyValue1 := 111;
end;

procedure prcTask2;
begin
  // some code pertinent...
  Sleep(2000);
  lMyValue2 := 222;
end;

procedure prcTask3;
begin
  // some code pertinent...
  Sleep(5000);
  lMyValue3 := 333;
end;

procedure TForm1.btn_Start_TaskRUNClick(Sender: TObject);
begin
  lMyProc1 := prcTask1;
  lMyProc2 := prcTask2;
  lMyProc3 := prcTask3;
  //
  lMyTaskRUN_obj := TTask.Run( { }
    procedure()                { }
    begin
      //
      lMyTasks[0] := TTask.Create(lMyProc1);
      lMyTasks[1] := TTask.Create(lMyProc2);
      lMyTasks[2] := TTask.Create(lMyProc3);
      //
      lMyTasks[0].Start;
      lMyTasks[1].Start;
      lMyTasks[2].Start;
      //
      Edit1.Text := 'Tasks started in: ' + TimeToStr(now);
      //
      TTask.WaitForAll(lMyTasks); { boolean return }           // wait all task end = 3sec, 2sec and 5sec = 5sec is your time to wait!
      // TTask.WaitForAny(lMyTasks); { integer return = task ID } // who's end firstly, then, go back! in this case, 2sec < 3sec < 5sec
      //
      Edit2.Text := 'Tasks ended in: ' + TimeToStr(now);
      //
      (*
        try
        TThread.Synchronize(nil,
        procedure()                  { }
        begin                        { }
        TTask.WaitForAll(lMyTasks) { }
        end                          { }
        );
        finally

        end;
      *)
      //
      ShowMessage('All done' +            { }
        sLineBreak + lMyValue1.ToString + { }
        sLineBreak + lMyValue2.ToString + { }
        sLineBreak + lMyValue3.ToString   { }
        );
    end { }
    );  // TTask.Run... procedure...
  //
end;

procedure TForm1.btn_Stop_TaskRUNClick(Sender: TObject);
var
  i              : integer;
  lMyTaskWainting: ITask;
begin
  try
    if not(lMyTaskRUN_obj = nil) then
    begin
      Caption := 'not(lMyTaskRUN_obj = nil)';
      //
      // TTaskStatus = (Created, WaitingToRun, Running, Completed, WaitingForChildren, Canceled, Exception);
      if (lMyTaskRUN_obj.Status = TTaskStatus.Running) then
      begin
        for lMyTaskWainting in lMyTasks do
          if (lMyTaskWainting.Status in [TTaskStatus.Running, TTaskStatus.WaitingToRun]) then
            lMyTaskWainting.Cancel;
        //
        lMyTaskRUN_obj.Cancel;
      end;
      //
      Self.Close; // close app
    end
    else
      Caption := 'lMyTaskRUN_obj = nil';
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

finalization

end.

 

hug

Edited December 30, 2020 by Guest

[RaelB 4]

@Der schöne Günther: If I set a timeout the problem does not occur. Thanks a lot for your help. Kudos for noticing the thread ID issue. It is something that can be reproduced quite easily as in my test application.

[Der schöne Günther 316]

I find it a bit sad that none of these fixes get backported to earlier versions. They had something like this around 2016, but somehow stopped doing so. Or never really started, I don't know.

 

I think this especially important when everything (editor, debugger, runtime, ...) is so tightly coupled together.