다중 스레드 거품입니다. 델파이 7에서는 잘 작동하지만 나사로와는 잘 작동하지 않습니까? 컴파일러 버그? 난 당신이 내 코드를 보여 드리고자합니다 모든

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. 

것은 그 코드를 컴파일하고 벌금을하고있다 델파이 7을 실행하는 경우. 그러나 나사로와 함께 그것을 컴파일 할 때, 마지막 "writeln"텍스트는 두 배가되거나 세 배가되고 프로그램은 중단됩니다. 누군가 왜 저에게 말할 수 있습니까?

델파이 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의 신뢰를 불러 일으키지 않습니다 ...

Answer 2

@ user246408 예 오른쪽 문제는 CRT 단위입니다. 내가 사용 섹션에서 제거하고 코드가 제대로 작동하기 시작했습니다.