WaitForThreadTerminate timeout Parameter is not working
lazarus / 32-Linux

----------------------------------------------------------------------
jkl69 · 2015-02-05 14:49

i wrote a very small Thread-Test Programm
in the main Programm i start an Thread and
then call  "return:=WaitForThreadTerminate(tid,100);"
on Windows this Program detects the Thread Terminate Timeout and gives
me "258" as return value.
on Linux the same Program never detects Thread Timeout and gives me
allways "0" as return value.

Code:

program mythread;

{$mode objfpc}{$H+}

uses
 {$ifdef unix}  cthreads,  {$endif}
 Classes, sysutils, dateutils ;

function f(p: pointer): ptrint;
var anow:TDatetime;     i,c:integer;
begin
  c:=longint(p);
  anow:=now;
  for i:=0 to c do
     begin
       writeln('_THREAD_LOOP ',i,' msec:
',MilliSecondsBetween(ANow,now));
       sleep(1);
     end;
  f:=0;
end;


var tid:TThreadID; s:string;i,c,r:integer;  e:DWord;

begin
  s:=paramstr(1);
  writeln('Start ',s);
  val(s,i,c);
  if (i=0) then i:=10 ;
  writeln('Threadtest loops:',i);
  tid:=BeginThread(@f,pointer(i));
  writeln('Wait for Thread id:',tid);
  e:=WaitForThreadTerminate(tid,100);
  writeln('Thread-Exit ',e);
end.

----------------------------------------------------------------------
lagprogramming · 2015-02-05 16:31

http://bugs.freepascal.org/view.php?id=25711
   I remember I've also had a solution for the problem. It was related
to the way threads were started. If I remember correctly the
workaround was to modify the fpc sources to start a thread within a
thread.
   At the moment, you start the thread without being sure that timeout
parameter is taken into account by the operating system. By adding a
new thread that creates and runs your desired code within a thread the
timeout parameter would be taken into account by the
major(hidden,pattern) thread. Windows doesn't need this workaround but
other OS's might need. Instead of starting a new debate with main
developers I've designed my code to use two parameters: maximum thread
time duration(start to finish) and timeout. This way main thread code
never fails no matter the platform.

----------------------------------------------------------------------
jkl69 · 2015-02-05 19:34

@lagprogramming
thanks for your Idea "By adding a new thread that creates and runs
your desired code"

I soled it now Not by addin new thread but i wrote my Own
waitforthreadterminate function.

code:

program myThread;

uses
{$ifdef unix}  cthreads,{$endif}
  sysutils, dateutils;

var tid:TThreadID;     s:String;     t2,TTerminated:boolean;   
 r,c:integer;

function f(p : pointer) : ptrint;
 var astart:TDatetime;
     i,c:integer;
begin
  TTerminated:=false;
  astart:=now;
  c:=longint(p);
  for i:=0 to c do
     Writeln('_thread_loop ',i,'
msec:',MilliSecondsBetween(Astart,Now));
  f:=0;
  TTerminated:=true;
end;

function waitforthreadterminate(timeout: integer):boolean;
var  r:integer;
    thtime:TDatetime;
begin
  waitforthreadterminate:=false;
  thtime:=now;
  repeat
    sleep(1);
    r:= MilliSecondsBetween(thtime,Now)
  until (r>=timeout) OR (Tterminated);
  if tterminated then
      waitforthreadterminate:=true;
end;

begin
  s:=ParamStr(1);
  val(s,r,c);
  if r=0 then r:=10;
  WriteLn('Thread Loops: ', r);
  tid:= BeginThread(@f,pointer(r));
  writeln('start THREAD ',tid);
  t2:=waitforthreadterminate(100);
  if not t2 then writeln(' EXIT TIMEOUT ')
  else writeln(' EXIT ');
end.

----------------------------------------------------------------------
jkl69 · 2015-02-05 19:43

Quote from: jkl69 on February 05, 2015, 08:34:10 pm@lagprogramming
thanks for your Idea "By adding a new thread that creates and runs
your desired code"

I soled it now Not by addin new thread but i wrote my Own
waitforthreadterminate function.

Code: [Select]
program myThread;

uses
{$ifdef unix}  cthreads,{$endif}
  sysutils, dateutils;

var tid:TThreadID;     s:String;     t2,TTerminated:boolean;   
 r,c:integer;

function f(p : pointer) : ptrint;
 var astart:TDatetime;
     i,c:integer;
begin
  TTerminated:=false;
  astart:=now;
  c:=longint(p);
  for i:=0 to c do
     Writeln('_thread_loop ',i,'
msec:',MilliSecondsBetween(Astart,Now));
  f:=0;
  TTerminated:=true;
end;

function waitforthreadterminate(timeout: integer):boolean;
var  r:integer;
    thtime:TDatetime;
begin
  waitforthreadterminate:=false;
  thtime:=now;
  repeat
    sleep(1);
    r:= MilliSecondsBetween(thtime,Now)
  until (r>=timeout) OR (Tterminated);
  if tterminated then
      waitforthreadterminate:=true;
end;

begin
  s:=ParamStr(1);
  val(s,r,c);
  if r=0 then r:=10;
  WriteLn('Thread Loops: ', r);
  tid:= BeginThread(@f,pointer(r));
  writeln('start THREAD ',tid);
  t2:=waitforthreadterminate(100);
  if not t2 then writeln(' EXIT TIMEOUT ')
  else writeln(' EXIT ');
end.