multithreading - 多线程冒泡排序。在 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 的信心......