Multithreaded 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

Это похоже на ошибку в ФФК. Чтобы сузить проблему, она часто помогает устранить код и попытаться создать минимальный пример. Это, например, демонстрирует проблему:

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 ...

Answer 2

@ user246408 Да, проблема связана с CRT. я удалил его из раздела uses, и код начал работать правильно.