mORMot and Open Source friends
Check-in [265f6a043b]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{2284} override the TSynThread.Destroy method for FPC so that it calls Terminate and WaitFor, as TThread.Destroy in Delphi RTL
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 265f6a043b375432d323fecab9b7103520bd8ff6
User & Date: ab 2016-01-21 15:19:01
References
2017-06-20
09:16
{3690} revert [265f6a043b] as Alfred reported it as buggy for FPC check-in: d0c1512d05 user: ab tags: trunk
Context
2016-01-21
15:35
{2285} fixed TServiceContainerServer instance creation in sicShared mode to use TServiceFactoryServer.CreateInstance as expected check-in: bec753f7ef user: ab tags: trunk
15:19
{2284} override the TSynThread.Destroy method for FPC so that it calls Terminate and WaitFor, as TThread.Destroy in Delphi RTL check-in: 265f6a043b user: ab tags: trunk
09:52
{2283} ensure OSVersionText would not contain "SP0" if no service pack is installed check-in: 3263439712 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynCrtSock.pas. 

767
768
769
770
771
772
773




774
775
776
777
778
779
780
....
3870
3871
3872
3873
3874
3875
3876











3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894

    {$ifndef HASTTHREADSTART}
    /// method to be called when the thread was created as suspended
    // - Resume is deprecated in the newest RTL, since some OS - e.g. Linux -
    // do not implement this pause/resume feature
    // - we define here this method for older versions of Delphi
    procedure Start;
    {$endif}




  end;
  {$M-}

{$ifdef USETHREADPOOL}
  TSynThreadPoolTHttpServer = class;
{$endif}

................................................................................
begin
  {$ifdef FPC}
  inherited Create(CreateSuspended,512*1024); // DefaultSizeStack=512KB
  {$else}
  inherited Create(CreateSuspended);
  {$endif}
end;












{$ifndef LVCL}
procedure TSynThread.DoTerminate;
begin
  if Assigned(fStartNotified) and Assigned(fOnTerminate) then begin
    fOnTerminate(self);
    fStartNotified := nil;
  end;
  inherited DoTerminate;
end;

{$endif}

{$ifndef HASTTHREADSTART}
procedure TSynThread.Start;
begin
  Resume;
end;







>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>










<








767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
....
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901

3902
3903
3904
3905
3906
3907
3908

    {$ifndef HASTTHREADSTART}
    /// method to be called when the thread was created as suspended
    // - Resume is deprecated in the newest RTL, since some OS - e.g. Linux -
    // do not implement this pause/resume feature
    // - we define here this method for older versions of Delphi
    procedure Start;
    {$endif}
    {$ifdef FPC}
    /// under FPC, would call Terminate and WaitFor just with Delphi RTL
    destructor Destroy; override;
    {$endif}
  end;
  {$M-}

{$ifdef USETHREADPOOL}
  TSynThreadPoolTHttpServer = class;
{$endif}

................................................................................
begin
  {$ifdef FPC}
  inherited Create(CreateSuspended,512*1024); // DefaultSizeStack=512KB
  {$else}
  inherited Create(CreateSuspended);
  {$endif}
end;

{$ifdef FPC}
destructor TSynThread.Destroy;
begin
  if not Terminated then begin
    Terminate;
    WaitFor;
  end;
  inherited Destroy;
end;
{$endif}

{$ifndef LVCL}
procedure TSynThread.DoTerminate;
begin
  if Assigned(fStartNotified) and Assigned(fOnTerminate) then begin
    fOnTerminate(self);
    fStartNotified := nil;
  end;
  inherited DoTerminate;
end;

{$endif}

{$ifndef HASTTHREADSTART}
procedure TSynThread.Start;
begin
  Resume;
end;

Changes to SynSelfTests.pas. 

2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
....
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
....
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
....
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672

  Check(CompareMem(pointer(W),pointer(A),length(W)));
  {$else}
  Check(A=W);
  Check(C.RawUnicodeToAnsi(C.AnsiToRawUnicode(W))=W);
  {$endif}
  FillChar(tmpA,SizeOf(tmpA),1);
  L := C.Utf8ToAnsiBuffer(RawByteString(W),tmpA,sizeof(tmpA));
  Check(L=StrLen(@tmpA));
  if L<sizeof(tmpA)-1 then
    Check(L=Length(W)) else
    Check(L=sizeof(tmpA)-1);
  Check(CompareMem(@tmpA,pointer(W),L));
end;
var i, CP, L: integer;
    W: WinAnsiString;
................................................................................
    {$ifndef DELPHI5OROLDER}
    q: RawUTF8;
    {$endif}
    Unic: RawUnicode;
    WA: Boolean;
begin
  res := 'one,two,three';
  Check(StrLen(nil)=0);
  for i := length(res)+1 downto 1 do
    Check(StrLen(Pointer(@res[i]))=length(res)-i+1);
  Check(StrLenPas(nil)=0);
  for i := length(res)+1 downto 1 do
    Check(StrLenPas(Pointer(@res[i]))=length(res)-i+1);
  CSVToRawUTF8DynArray(pointer(res),arr);
  Check(arr[0]='one');
  Check(arr[1]='two');
  Check(arr[2]='three');
................................................................................
  result := JSONDecode(P,['Major','Minor','Release','Build','Main','Detailed'],Values);
  if result=nil then
    exit; // result^ = ',' or ']' for last item of array
  V.Major := GetInteger(Values[0]);
  V.Minor := GetInteger(Values[1]);
  V.Release := GetInteger(Values[2]);
  V.Build := GetInteger(Values[3]);
  V.Main := UTF8DecodeToString(Values[4],StrLen(Values[4]));
  V.Detailed := UTF8DecodeToString(Values[5],StrLen(Values[5]));
  aValid := true;
end;

class procedure TCollTstDynArray.FVWriter2(const aWriter: TTextWriter; const aValue);
var V: TFV absolute aValue;
begin
  aWriter.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
................................................................................
  result := JSONDecode(aFrom,['Major','Minor','Release','Build','Main','BuildDateTime'],Values);
  aValid := (result<>nil);
  if aValid then begin
    V.Major := GetInteger(Values[0]);
    V.Minor := GetInteger(Values[1]);
    V.Release := GetInteger(Values[2]);
    V.Build := GetInteger(Values[3]);
    V.Main := UTF8DecodeToString(Values[4],StrLen(Values[4]));
    V.BuildDateTime := Iso8601ToDateTimePUTF8Char(Values[5]);
  end;
end;

class procedure TCollTstDynArray.FVClassWriter(const aSerializer: TJSONSerializer;
  aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
var V: TFileVersion absolute aValue;







|







 







|

|







 







|
|







 







|








2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
....
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
....
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
....
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672

  Check(CompareMem(pointer(W),pointer(A),length(W)));
  {$else}
  Check(A=W);
  Check(C.RawUnicodeToAnsi(C.AnsiToRawUnicode(W))=W);
  {$endif}
  FillChar(tmpA,SizeOf(tmpA),1);
  L := C.Utf8ToAnsiBuffer(RawByteString(W),tmpA,sizeof(tmpA));
  Check(L=SynCommons.StrLen(@tmpA));
  if L<sizeof(tmpA)-1 then
    Check(L=Length(W)) else
    Check(L=sizeof(tmpA)-1);
  Check(CompareMem(@tmpA,pointer(W),L));
end;
var i, CP, L: integer;
    W: WinAnsiString;
................................................................................
    {$ifndef DELPHI5OROLDER}
    q: RawUTF8;
    {$endif}
    Unic: RawUnicode;
    WA: Boolean;
begin
  res := 'one,two,three';
  Check(SynCommons.StrLen(nil)=0);
  for i := length(res)+1 downto 1 do
    Check(SynCommons.StrLen(Pointer(@res[i]))=length(res)-i+1);
  Check(StrLenPas(nil)=0);
  for i := length(res)+1 downto 1 do
    Check(StrLenPas(Pointer(@res[i]))=length(res)-i+1);
  CSVToRawUTF8DynArray(pointer(res),arr);
  Check(arr[0]='one');
  Check(arr[1]='two');
  Check(arr[2]='three');
................................................................................
  result := JSONDecode(P,['Major','Minor','Release','Build','Main','Detailed'],Values);
  if result=nil then
    exit; // result^ = ',' or ']' for last item of array
  V.Major := GetInteger(Values[0]);
  V.Minor := GetInteger(Values[1]);
  V.Release := GetInteger(Values[2]);
  V.Build := GetInteger(Values[3]);
  V.Main := UTF8DecodeToString(Values[4],SynCommons.StrLen(Values[4]));
  V.Detailed := UTF8DecodeToString(Values[5],SynCommons.StrLen(Values[5]));
  aValid := true;
end;

class procedure TCollTstDynArray.FVWriter2(const aWriter: TTextWriter; const aValue);
var V: TFV absolute aValue;
begin
  aWriter.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
................................................................................
  result := JSONDecode(aFrom,['Major','Minor','Release','Build','Main','BuildDateTime'],Values);
  aValid := (result<>nil);
  if aValid then begin
    V.Major := GetInteger(Values[0]);
    V.Minor := GetInteger(Values[1]);
    V.Release := GetInteger(Values[2]);
    V.Build := GetInteger(Values[3]);
    V.Main := UTF8DecodeToString(Values[4],SynCommons.StrLen(Values[4]));
    V.BuildDateTime := Iso8601ToDateTimePUTF8Char(Values[5]);
  end;
end;

class procedure TCollTstDynArray.FVClassWriter(const aSerializer: TJSONSerializer;
  aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
var V: TFileVersion absolute aValue;

Changes to SynopseCommit.inc. 

1

'1.18.2283'

|

1

'1.18.2284'

©2010-2022 Synopse Informatique