Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.2.0 / tests / webtbs / tw10815.pp
Size: Mime:
{%skiptarget=$nothread }

program MaxThread;

{$mode objfpc}{$H+}

uses
 {$ifdef unix}
 cthreads,
 {$endif}
 Classes, SysUtils;
 { add your units here }


type
 ThProva = class(TThread)
 private
   Number: Integer;
 protected
   procedure Execute; override;
 public
   constructor Create(ThreadNumber: Integer);
 end;

var
 threadsfinished: Integer;


constructor ThProva.Create(ThreadNumber: Integer);
begin
 self.Number:= ThreadNumber;
 self.FreeOnTerminate:= true;
 inherited Create(true);
end;

procedure ThProva.Execute;
begin
 WriteLn('I am the thread number '+ IntToStr(Number));
 Terminate;
 { not exactly finished yet, but good enough }
 interlockedincrement(threadsfinished);
end;


var
 ThreadNumber: Integer;
 thr: thprova;
begin
 ThreadNumber:= 0;
 WriteLn('Begin');
 { needs to be > 410 because at least on Mac OS X and Linux you can start }
 { about 400 threads before you run into trouble if they aren't finished  }
 while (threadnumber < 500) do
   begin
     try
       Inc(ThreadNumber);
       thr:=ThProva.Create(Threadnumber);
       thr.start;
     Except on e: Exception do
       begin
         { maybe the previously started threads didn't finish yet -> give them some
           more time to completely terminate }
         sleep(1000);
         try
           thr:=ThProva.Create(Threadnumber);
           thr.start;
         except
           WriteLn(e.Message);
           halt(1);
         end;
       end;
     end;
   end;
  while (threadsfinished<>threadnumber) do
    { give some time to the started threads to finish }
    sleep(100);
  sleep(200)
end.