Multithreaded bubblesort. Works fine with delphi 7 but not with Lazarus? Compiler bug?

Question

First of all I would like to show you my code:

unit BSort;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils;

{==============================================================================}

type
  TcompFunc = function(AValue1, AValue2 : Integer) : boolean;
  TIntegerArray = array of integer;
  PIntegerArray = ^TIntegerArray;

{==============================================================================}

procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;

{==============================================================================}

implementation

{==============================================================================}

procedure Swap(var AValue1, AValue2 : Integer);
var
  Tmp : Integer;
begin
  Tmp := AValue1;
  AValue1 := AValue2;
  AValue2 := Tmp;
end;

{==============================================================================}

function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;
begin
  result := AValue1 > AValue2;
end;

{------------------------------------------------------------------------------}

procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
var
  i,j : Word;
begin
  for i := Low(AMatrix) to High(AMatrix) - 1 do
    for j := Low(AMatrix) to High(AMatrix) - 1 do
    begin
      if ACompFunc(AMatrix[j], AMatrix[j+1]) then
        Swap(AMatrix[j], AMatrix[j+1]);
    end;
end;

{==============================================================================}

end.

unit MultiThreadSort;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, BSort;

{==============================================================================}

type
  TSortThread = class(TThread)
      FMatrix : PIntegerArray;
    protected
      procedure Execute; override;
    public
      constructor Create(var AMatrix : TIntegerArray);
    public
      property Terminated;
  end;

{==============================================================================}

implementation

{==============================================================================}

constructor TSortThread.Create(var AMatrix : TIntegerArray);
begin
  inherited Create(False);
  FreeOnTerminate := False;
  FMatrix := @AMatrix;
end;

{------------------------------------------------------------------------------}

procedure TSortThread.Execute;
begin
  BubbleSort(FMatrix^, @V1LargerV2);
end;

{==============================================================================}

end.


program sortuj;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, MultiThreadSort, BSort, Crt;

{==============================================================================}

const
  Zakres = 20;

{==============================================================================}

var
  Start  : Double;
  Stop   : Double;
  Time   : array[0..1] of Double;
  Matrix : array[0..9] of TIntegerArray;
  i,j    : Word;

{==============================================================================}

procedure Sort(var AMatrix : TIntegerArray);
var
  SortThread : array[0..1] of TSortThread;
  Matrix     : array[0..1] of TIntegerArray;
  Highest    : Integer;
  i, j, k    : Word;
begin
  // Znalezienie największej liczby w tablicy.
  Highest := Low(Integer);
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] > Highest then
      Highest := AMatrix[i];

  // Zerowanie tablic pomocniczych.
  for i := 0 to 1 do
    SetLength(Matrix[i], 0);

  // Podział tablicy do sortowania na dwie tablice:
  // - pierwsza od najniższej do połowy najwyższej liczby.
  // - druga od połowy najwyższej do najwyższej liczby.
  j := 0;
  k := 0;
  for i := Low(AMatrix) to High(AMatrix) do
    if AMatrix[i] < Highest div 2 then
    begin
      SetLength(Matrix[0], Length(Matrix[0]) + 1);
      Matrix[0,j] := AMatrix[i];
      Inc(j);
    end
    else
    begin
      SetLength(Matrix[1], Length(Matrix[1]) + 1);
      Matrix[1,k] := AMatrix[i];
      Inc(k);
    end;

  //Tworzenie i start wątków sortujacych.
  for i := 0 to 1 do
    SortThread[i] := TSortThread.Create(Matrix[i]);

  // Oczekiwanie na zakończenie watków sortujących.
  //for i := 0 to 1 do
  //  SortThread[i].WaitFor;
  //  while not SortThread[i].Terminated do
  //    sleep(2);

  Sleep(10);
  SortThread[0].WaitFor;
  Sleep(10);
  SortThread[1].WaitFor;
  Sleep(10);

  // Zwalnianie wątków sortujacych.
  for i := 0 to 1 do
    FreeAndNil(SortThread[i]);

  // Łączenie tablic pomocniczych w jedną.
  k := 0;
  for i := 0 to 1 do
    for j := Low(Matrix[i]) to High(Matrix[i]) do
    begin
      AMatrix[k] := Matrix[i,j];
      Inc(k);
    end;
end;

{==============================================================================}

begin
  Randomize;
  ClrScr;

  for i := 0 to 9 do
  begin
    SetLength(Matrix[i],Zakres);
    Write('Losowanie ', i, ' tablicy...');
    for j := 0 to Zakres - 1 do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;

  Writeln;
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 9 do
  begin
    Write('Sortowanie ', i, ' tablicy...');
    BubbleSort(Matrix[i],@V1LargerV2);
    Writeln('Posortowana');
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Time[0] := Stop - Start;

  Writeln;
  for i := 0 to 9 do
  begin
    Write('Losowanie ',i,' tablicy...');
    for j := 0 to Zakres do
      Matrix[i,j] := Random(100) - 50;
    Writeln('Wylosowana');
  end;

  Writeln;
  Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  for i := 0 to 9 do
  begin
    Write('Sortowanie dwuwatkowe ', i, ' tablicy...');
    Sort(Matrix[i]);
    Writeln('Posortowana');
  end;
  Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
  Time[1] := Stop - Start;

  Writeln;
  Writeln('Sortowanie bąbelkowe : ',Time[0]);
  Writeln('Sortowanie dwuwatkowe: ',Time[1]);
  Readln;
end.

When I compile that code and run with Delphi 7 it is working fine. But when I compile it with Lazarus the last "writeln" text is doubled or tripled and program hangs. Could someone tell me why?

Delphi 7 is correct:

Lazarus is not correct:

Answer 1

This seems like a bug in FPC. To narrow down the problem it often helps to eliminate code and try to create a minimal example. This, for example, demonstrates the problem :

program project1;    
uses
  Classes, Crt;    
type
  TSortThread = class(TThread)
    protected
      procedure Execute; override;
    public
      constructor Create;
  end;

constructor TSortThread.Create;
begin
  inherited Create(False);
  FreeOnTerminate := False;
end;

procedure TSortThread.Execute;
begin
end;

var
  SortThread :  TSortThread;
begin
  Write('test ...');
  SortThread := TSortThread.Create;
  Writeln('created');
  SortThread.WaitFor;
  SortThread.Free;
  Writeln('complete');
  Readln;
end.

and produces output:

This seems like a bug in the console output only. Your original program, although it could certainly be improved in a sizeable number of ways, otherwise seems to sort the matrices correctly. This type of bug nevertheless does not inspire confidence in the FPC...

Answer 2

@user246408 Yes u re right the problem is CRT unit. i removed it from uses section and code started to work correctly.