(* Collection of code snippets by Arne Vajhøj *)
(* (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) *)
program NotCorrect;

uses
  Classes, SysUtils, Windows;

type
  Data = class(TObject)
    constructor Create(s : string);
    function GetS : string;
    procedure SetS(s : string);
    property S : string read GetS write SetS;
  private
    _s : string;
  end;
  Processor = class(TThread)
    constructor Create(d : Data);
    function GetD : Data;
    property D : Data read GetD;
  protected
    procedure Execute; override;
  private
    _d : Data;
  end;

constructor Data.Create(s : string);

begin
  _s := s;
end;

function Data.GetS : string;

begin
  GetS := _s;
end;

procedure Data.SetS(s : string);

begin
  _s := s;
end;

constructor Processor.Create(d : Data);

begin
  inherited Create(true);
  _d := d;
end;

function Processor.GetD : Data;

begin
  GetD := _d;
end;

procedure Processor.Execute;

var
  s : string;

begin
  (* simulate some work between get and set *)
  s := D.S;
  Yield;
  D.S := s + 'X';
end;

procedure Test(njobs, nthreads : integer);

var
  d : Data;
  t : array of TThread;
  i, j : integer;

begin
  (* setup data*)
  d := Data.Create('');
  (* process with sharted data *)
  for i := 0 to (njobs div nthreads - 1) do begin
    SetLength(t, nthreads);
    (* create threads *)
    for j := 0 to nthreads-1 do begin
      t[j] := Processor.Create(d);
    end;
    (* start threads *)
    for j := 0 to nthreads-1 do begin
      t[j].Start;
    end;
    (* wait for threads to complete *)
    for j := 0 to nthreads-1 do begin
      t[j].WaitFor;
      t[j].Terminate;
      t[j].Free;
    end;
  end;
  writeln(nthreads:1,' threads : expected = ',njobs:1,', actual = ', length(d.S):1);
end;

begin
  Test(2560, 1);
  Test(2560, 2);
  Test(2560, 4);
  Test(2560, 8);
  Test(2560, 16);
  Test(2560, 32);
  Test(2560, 64);
end.