Проблема с TThread

[Yura]

Здравствуйте уважаемые!

Возникла у меня такая вот проблема с классом TThread. Хочу запустить несколько потоков, в которых бы использовались pipes.
Для начала создал один поток для проверки с таким вот кодом:

Код: Выделить всё

uses
   cthreads,Classes,Unix;
 
  TPingThread = class(TThread)
  protected
    procedure execute(); override;
  end; 

procedure TPingThread.execute;
var
  p: TextFile;
  s: String;
begin
popen(p,'ping 1.2.3.4','r');
repeat
  ReadLn(p,s);
  WriteLn(s);
until EOF(p);
pclose(p);
end;

var
  MyPing: TPingThread;
begin
  MyPing := TPingThread.Create(True);
  MyPing.Resume;
end.


НО результата пинга на мониторе не увидел. Если вместо тела метода Execute даю просто WriteLn('Test'), то на мониторе печатает Test.
То есть, я так понимаю, поток рабочий. Не подскажете в чем может быть проблемка?

[VirtUX]

Вот слегка модифицированный пример мультипоточности (добавлена на форму метка Label1 и процедура обработки клика по ней; разгрузка процессора - sleep(1)):

Код: Выделить всё

unit MainUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TMyThread }

  TMyThread = class(TThread)
  private
    fStatusText: string;
    procedure ShowStatus;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  MyThread : TMyThread;
begin
  MyThread := TMyThread.Create(True); // With the True parameter it doesn't start automatically
  if Assigned(MyThread.FatalException) then
    raise MyThread.FatalException;
     
  // Here the code initialises anything required before the threads starts executing

  MyThread.Resume;

end;

procedure TForm1.Label1Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 10000 do
    sleep(1);
  Label1.Caption:= 'yes10000';
end;

{ TMyThread }

procedure TMyThread.ShowStatus;
// this method is only called by Synchronize(@ShowStatus) and therefore
// executed by the main thread
// The main thread can access GUI elements, for example Form1.Caption.
begin
  Form1.Caption := fStatusText;
end;

procedure TMyThread.Execute;
var
  newStatus : string;
begin
  fStatusText := 'TMyThread Starting...';
  Synchronize(@Showstatus);
  fStatusText := 'TMyThread Running...';
  while (not Terminated) and (true {any condition required}) do begin

    //here goes the code of the main thread loop
    newStatus:='TMyThread Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now);
   
    if NewStatus <> fStatusText then begin
      fStatusText := newStatus;
      Synchronize(@Showstatus);
    end;
    sleep(1);
  end;
end;

constructor TMyThread.Create(CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

initialization
  {$I mainunit.lrs}

end.   

При клике MyThread замирает и ждет пока неотработает процедура клика по метке Label1, после продолжает свою работу. Как сделать, чтоб и основной и дочерний потоки работали синхронно?

[*vmr]

Т.е. вы хотели сказать "Как сделать, чтоб и основной и дочерний потоки работали асинхронно?"
Краткий ответ: отказаться от Synchronize

Дело в том что процедура переданная в Synchronize будет выполнятся в основном потоке, а не в потоке вызывающем Synchronize.
Synchronize банально ставит переданный ему делегат в очередь для основного потока и ожидает пока этот делегат не обработаеться.
Основной же поток обрабатывает "синхронизируемые процедуры" только на Application.ProcessMessages (на самом деле CheckSynchronize, но это неважно)
Следовательно пока основной поток крутится внутри TForm1.Label1Click, то никакие запросы на синхронизацию не будут обработаны

[VirtUX]

Основной же поток обрабатывает "синхронизируемые процедуры" только на Application.ProcessMessages (на самом деле CheckSynchronize, но это неважно)

Следовательно, если в основном потоке добавить в цикле Application.ProcessMessages, то будет выглядить, как еслиб работали два дочерних с sychronize. А если нет цикла, так и синхронизировать не нужно.

[FoMonster]

Вот глянь мой код, обрати внимание, что в .execute присутствует бесконечный цикл. Пока не terminated. Иначе поток выполниться один раз и всё. Его надо бесконечно крутить самому.

Код: Выделить всё

interface

TTextureCacheThread = class(TThread)
private
  index:Integer;
  FSize: Integer;
  texturelist:TTextureList;
  procedure ThreadDone(Sender: TObject);
protected
  procedure Execute; override;
public
  constructor Create(IsSuspended:boolean);
end;     

implementation

{*******************************************************************************
  CLASS: TTextureCacheThread Дополнительный поток для загрузки текстур
*******************************************************************************}
constructor TTextureCacheThread.Create(IsSuspended:boolean);
begin
//  OnTerminate:=ThreadDone;
  FreeOnTerminate := True;
  Priority := tpNormal;
//  Suspend;
  inherited Create(IsSuspended);
end;
{******************************************************************************}
procedure TTextureCacheThread.LoadTextureIfNeed;
begin


end;
{******************************************************************************}
procedure TTextureCacheThread.Execute;
  var
    i:Integer;
begin
  //Suspend;
  while not Terminated do begin

    for i:=0 to texturelist.count-1 do begin

      if texturelist[i].IsNeedToLoad and ( not texturelist[i].IsLoaded ) then begin
        texturelist[i].Load;
      end;

    end;
    Suspend;
  end;
end;
{******************************************************************************}
procedure TTextureCacheThread.ThreadDone(Sender: TObject);
begin



end;
{******************************************************************************}

[*vmr]

Следовательно, если в основном потоке добавить в цикле Application.ProcessMessages, то будет выглядить, как еслиб работали два дочерних с sychronize

А я бы за этот Application.ProcessMessages отрывал бы руки
Используй CheckSynchronize