多线程bubblesort.与delphi 7一起工作正常但与Lazarus不一样吗？编译错误？

Question

首先,我想向您展示我的代码:

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.

当我编译该代码并使用Delphi 7运行时它工作正常.但是当我用Lazarus编译它时,最后一个"writeln"文本加倍或三倍并且程序挂起.有人能告诉我为什么吗？

Delphi 7是正确的:

拉撒路不正确:

Answer 1

这似乎是FPC中的一个错误.为了缩小问题范围,通常有助于消除代码并尝试创建一个最小的示例.例如,这表明了这个问题:

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.

并产生输出:

这似乎只是控制台输出中的错误.你的原始程序,虽然它肯定可以用相当多的方式进行改进,否则似乎正确地对矩阵进行排序.然而,这种类型的错误并没有激发对FPC的信心......