Re: [lazarus] Making GTK Thread Safe

[Giuliano Colla]

willem ha scritto:

Please send your modified threadbug program , so that i can compare the results on my system.

Please find it here attached.

Giuliano


program multithread;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes,sysutils
  { add your units here };

type

  { TThreadBug }

  TThreadBug=class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
  end;

var
  Ft: Boolean;
  BugArray: array [0..299] of TThreadBug;

{ TThreadBug }

procedure TThreadBug.Execute;
var
  I,J:Integer;
begin
  write('.');
  repeat
    sleep(10);
  until Terminated;
end;

constructor TThreadBug.Create(CreateSuspended: Boolean);
begin
  inherited Create (CreateSuspended);
  FreeOnTerminate:= Ft;
end;

var t1:TThreadBug; ans:string; I: Integer;

begin

  Ft := False; // set FreeOnTerminate
  // Here we create a lot of threads
  writeln('Type <Enter> to start threads');
  readln(ans);
  
  for I := 0 to high(BugArray) do begin
    BugArray[I]:=TThreadBug.Create(false);
    end;
  WriteLn('-');
  writeln('Type <Enter> to Destroy threads');
  readln(ans);
  for I := 0 to high(BugArray) do begin
    t1 := BugArray[I];
    t1.Terminate;
    t1.WaitFor;
    write ('.');
    if not Ft then begin
      sleep(50);
      t1.Free;
      end;
    end;
  WriteLn('-');
  // Here we create just one
  writeln('Type <Enter> to start thread');
  readln(ans);

  t1:=TThreadBug.Create(false);

  writeln('WaitFor? [y/N]');
  readln(ans);
  t1.Terminate;
  if ans='y' then begin
    if not Ft then begin
      t1.WaitFor;
      writeln('OS thread memory released.');
      end;
  end else
    writeln('OS thread memory left dangling.');

  if not Ft then t1.Free;
  writeln('Confirm with top now!');
  readln;
end.