Test suite results for test file webtbs/tw3467.pp

Test run data :

Test file "webtbs/tw3467.pp" information:

t_id 1420
t_adddate 2004/12/27
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 1

No log of 497919.

Source:

{ Source provided for Free Pascal Bug Report 3467 }
{ Submitted by "Micha Nelissen" on  2004-12-24 }
{ e-mail: micha@neli.hopto.org }
program threadvartest;

{$mode objfpc}
{$H+}

uses
  erroru,
  sysutils,
  classes
{$ifdef unix}
  , cthreads
{$endif}
  ;

type
  tthread1 = class(tthread)
  public
    p : pointer;
    procedure execute; override;
  end;

  tthread2 = class(tthread)
  public
    p : pointer;
    procedure execute; override;
  end;

threadvar
  athreadvar: integer;

procedure tthread1.execute;
var
  i: integer;
begin
  writeln('thread 1 var is @', ptrint(@athreadvar));
    athreadvar := 1;
    p:=@athreadvar;
   Sleep(2000);
    for i := 0 to 100000 do
      if athreadvar <> 1 then
      begin
        writeln(athreadvar);
        error;
        break;
      end;
end;

procedure tthread2.execute;
var
  i: integer;
begin
  writeln('thread 2 var is @', ptrint(@athreadvar));
    athreadvar := 9;
    p:=@athreadvar;
   Sleep(2000);
    for i := 0 to 100000 do
      if athreadvar <> 9 then
      begin
        writeln('  ', athreadvar);
        error;
        break;
      end;
end;

var
  thread1: tthread1;
  thread2: tthread2;
begin
  thread1 := tthread1.create(false);
  thread2 := tthread2.create(false);
  thread1.waitfor;
  thread2.waitfor;
  if thread1.p=thread2.p then
    error;
end.

Link to SVN view of webtbs/tw3467.pp source.