--- Merging r48876 into '.':

U    packages/rtl-objpas/src/inc/fmtbcd.pp
--- Recording mergeinfo for merge of r48876 into '.':
 G   .
--- Merging r49021 into '.':
U    packages/fcl-process/src/win/process.inc
--- Recording mergeinfo for merge of r49021 into '.':
 G   .

# revisions: 48876,49021
r48876 | marco | 2021-03-04 11:37:50 +0100 (Thu, 04 Mar 2021) | 1 line
Changed paths:
   M /trunk/packages/rtl-objpas/src/inc/fmtbcd.pp

 * Patch from Lacak. Better fix for mantis 30853
r49021 | marco | 2021-03-20 22:45:19 +0100 (Sat, 20 Mar 2021) | 1 line
Changed paths:
   M /trunk/packages/fcl-process/src/win/process.inc

 * also assign threadid. mantis 38645


git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@49039 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 158 insertions, 17 deletions

diff --git a/packages/fcl-process/src/win/process.inc b/packages/fcl-process/src/win/process.inc
index 7c690060d8..03e512e8c4 100644
--- a/packages/fcl-process/src/win/process.inc
+++ b/packages/fcl-process/src/win/process.inc
@@ -285,6 +285,7 @@ Var
         Raise EProcess.CreateFmt(SErrCannotExecute,[FCommandLine,GetLastError]);
       FProcessHandle:=FProcessInformation.hProcess;
       FThreadHandle:=FProcessInformation.hThread;
+      FThreadId:=FProcessInformation.dwThreadId;  
       FProcessID:=FProcessINformation.dwProcessID;
     Finally
       if POUsePipes in Options then
diff --git a/packages/fcl-stl/src/gdeque.pp b/packages/fcl-stl/src/gdeque.pp
index c620188000..ac106e5581 100644
--- a/packages/fcl-stl/src/gdeque.pp
+++ b/packages/fcl-stl/src/gdeque.pp
@@ -14,6 +14,11 @@
 
 unit gdeque;
 
+{
+  Implements a generic double ended queue.
+  (See: https://en.wikipedia.org/wiki/Double-ended_queue)
+}
+
 interface
 
 type
@@ -30,10 +35,18 @@ type
     procedure SetValue(position:SizeUInt; value:T);inline;
     function GetValue(position:SizeUInt):T;inline;
     function GetMutable(position:SizeUInt):PT;inline;
-    procedure IncreaseCapacity();inline;
+    procedure IncreaseCapacity();
+  protected
+    procedure MoveSimpleData(StartIndex: SizeUInt; Offset: SizeInt; NrElems: SizeUInt);
+    procedure MoveManagedData(StartIndex: SizeUInt; Offset: SizeInt; NrElems: SizeUInt);
+    procedure MoveData(StartIndex: SizeUInt; Offset: SizeInt; NrElems: SizeUInt);
+    procedure ClearSingleDataEntry(Index: SizeUInt); virtual;
+    procedure ClearData; virtual;
+    property Data: TArr read FData;
   public
     function Size():SizeUInt;inline;
     constructor Create();
+    destructor Destroy(); override;
     Procedure  Clear;
     procedure PushBack(value:T);inline;
     procedure PushFront(value:T);inline;
@@ -59,8 +72,15 @@ begin
   FStart:=0;
 end;
 
+destructor TDeque.Destroy();
+begin
+  Clear;
+  inherited Destroy;
+end;
+
 procedure TDeque.Clear;
 begin
+ ClearData;
  FDataSize:=0;
  FStart:=0;
 end;
@@ -87,6 +107,7 @@ procedure TDeque.PopFront();inline;
 begin
   if(FDataSize>0) then
   begin
+    ClearSingleDataEntry(FStart);
     inc(FStart);
     dec(FDataSize);
     if(FStart=FCapacity) then
@@ -97,7 +118,10 @@ end;
 procedure TDeque.PopBack();inline;
 begin
   if(FDataSize>0) then
+  begin
+    ClearSingleDataEntry((FStart+FDataSize-1)mod FCapacity);
     dec(FDataSize);
+  end;
 end;
 
 procedure TDeque.PushFront(value:T);inline;
@@ -127,6 +151,7 @@ end;
 procedure TDeque.SetValue(position:SizeUInt; value:T);inline;
 begin
   Assert(position < size, 'Deque access out of range');
+  ClearSingleDataEntry((FStart+position)mod FCapacity);
   FData[(FStart+position)mod FCapacity]:=value;
 end;
 
@@ -142,7 +167,68 @@ begin
   GetMutable:=@FData[(FStart+position) mod FCapacity];
 end;
 
-procedure TDeque.IncreaseCapacity;inline;
+
+procedure TDeque.MoveSimpleData(StartIndex: SizeUInt; Offset: SizeInt;  NrElems: SizeUInt);
+begin
+  Move(FData[StartIndex], FData[StartIndex+Offset], NrElems*SizeOf(T));
+  if Offset>0 then
+    FillChar(FData[StartIndex], NrElems*SizeOf(T), 0)
+  else
+    FillChar(FData[StartIndex+NrElems+Offset], -Offset*SizeOf(T), 0);
+end;
+
+procedure TDeque.MoveManagedData(StartIndex: SizeUInt; Offset: SizeInt; NrElems: SizeUInt);
+var
+  i: SizeUInt;
+begin
+  //since we always move blocks where Abs(Offset)>=NrElems, there is no need for
+  //2 seperate loops (1 for ngeative and 1 for positive Offsett)
+  for i := 0 to NrElems-1 do
+  begin
+    Finalize(FData[StartIndex+i+Offset]);
+    FData[StartIndex+i+Offset] := FData[StartIndex+i];
+    Finalize(FData[StartIndex+i]);
+    FillChar(FData[StartIndex+i], SizeOf(T), 0);
+  end;
+end;
+
+procedure TDeque.MoveData(StartIndex: SizeUInt; Offset: SizeInt; NrElems: SizeUInt);
+begin
+  if IsManagedType(T) then
+    MoveManagedData(StartIndex, Offset, NrElems)
+  else
+    MoveSimpleData(StartIndex, Offset, NrElems);
+end;
+
+procedure TDeque.ClearSingleDataEntry(Index: SizeUInt);
+begin
+  if IsManagedType(T) then
+  begin
+    Finalize(FData[Index]);
+    FillChar(FData[Index], SizeOf(T), 0);
+  end
+  else
+    FData[Index] := default(T);
+end;
+
+procedure TDeque.ClearData;
+var
+  i: SizeUint;
+begin
+  if IsManagedType(T) then
+    for i := Low(FData) to High(FData) do
+      Finalize(FData[i]);
+  FillChar(FData[Low(FData)], SizeUInt(Length(FData))*SizeOf(T), 0);
+end;
+
+procedure TDeque.IncreaseCapacity;
+  function Min(const A,B: SizeUInt): SizeUInt; inline; //no need to drag in the entire Math unit ;-)
+  begin
+    if (A<B) then
+      Result:=A
+    else
+      Result:=B;
+  end;
 const
   // if size is small, multiply by 2;
   // if size bigger but <256M, inc by 1/8*size;
@@ -151,7 +237,7 @@ const
   cSizeBig = 256*1024*1024;
 var
   i,OldEnd,
-  DataSize:SizeUInt;
+  DataSize,CurLast,EmptyElems,Elems:SizeUInt;
 begin
   OldEnd:=FCapacity;
   DataSize:=FCapacity*SizeOf(T);
@@ -165,11 +251,26 @@ begin
     FCapacity:=FCapacity+FCapacity div 8
   else
     FCapacity:=FCapacity+FCapacity div 16;
-
   SetLength(FData, FCapacity);
   if (FStart>0) then
-    for i:=0 to FStart-1 do
-      FData[OldEnd+i]:=FData[i];
+  begin
+    if (FCapacity-OldEnd>=FStart) then //we have room to move all items in one go
+    begin
+      MoveData(0, OldEnd ,FStart)
+    end
+    else
+    begin  //we have to move things around in chunks: we have more data in front of FStart than we have newly created unused elements
+      CurLast := OldEnd-1;
+      EmptyElems:=FCapacity-1-CurLast;
+      while (FStart>0) do
+      begin
+        Elems := Min(EmptyElems, FStart);
+        MoveData(0, CurLast+1, Elems);
+        MoveData(Elems, -Elems, FCapacity-Elems);
+        Dec(FStart, Elems);
+      end;
+    end;
+  end;
 end;
 
 procedure TDeque.Reserve(cap:SizeUInt);inline;
diff --git a/packages/rtl-objpas/src/inc/fmtbcd.pp b/packages/rtl-objpas/src/inc/fmtbcd.pp
index f26041d984..293bc346fc 100644
--- a/packages/rtl-objpas/src/inc/fmtbcd.pp
+++ b/packages/rtl-objpas/src/inc/fmtbcd.pp
@@ -797,10 +797,12 @@ INTERFACE
 {$endif}
 
   function __get_null : tBCD; Inline;
+  function __get_zero : tBCD; Inline;
   function __get_one : tBCD; Inline;
 
   PROPERTY
     NullBCD : tBCD Read __get_null;
+    ZeroBCD : tBCD Read __get_zero;
     OneBCD : tBCD Read __get_one;
 
 //{$define __lo_bh := 1 * ( -( MaxFmtBCDFractionSize * 1 + 2 ) ) }
@@ -887,16 +889,20 @@ IMPLEMENTATION
     OneBCD_ : tBCD;
 
   function __get_null : tBCD; Inline;
-
     begin
       __get_null := NullBCD_;
-     end;
+    end;
 
-  function __get_one : tBCD; Inline;
+  function __get_zero : tBCD; Inline;
+    begin
+      __get_zero := NullBCD_;
+      __get_zero.Precision := 1;
+    end;
 
+  function __get_one : tBCD; Inline;
     begin
       __get_one := OneBCD_;
-     end;
+    end;
 
   type
     range_digits = 1..maxfmtbcdfractionsize;
@@ -1584,7 +1590,7 @@ IMPLEMENTATION
     begin
       _SELECT
         _WHEN aValue = 0
-          _THEN result := NullBCD;
+          _THEN result := ZeroBCD;
         _WHEN aValue = 1
           _THEN result := OneBCD;
         _WHEN aValue = low ( myInttype )
@@ -4130,12 +4136,6 @@ begin
     else { array or something like that }
         not_implemented;
     end;
-  // peephole, avoids problems with databases, mantis #30853
-  if (Result.Precision = 0) and (Result.SignSpecialPlaces = 0) then 
-    begin
-      Result.Precision := 10;
-      Result.SignSpecialPlaces := 2;
-    end;
 end;
 
 function VarToBCD ( const aValue : Variant ) : tBCD;
diff --git a/tests/webtbs/tw38306.pp b/tests/webtbs/tw38306.pp
new file mode 100644
index 0000000000..1fbcea7a38
--- /dev/null
+++ b/tests/webtbs/tw38306.pp
@@ -0,0 +1,39 @@
+{ %OPT=-gh }

+{$mode objfpc}

+program gqueue_test;

+

+uses

+  gqueue;

+

+type

+  TIntQueue = specialize TQueue<Integer>;

+

+var

+  IntQueue: TIntQueue;

+  PushCnt: Integer;

+

+procedure Push2Pop1;

+var

+  i: Integer;

+begin

+  for i:= 0 to 1000000 do begin

+    IntQueue.Push(PushCnt);

+    inc(PushCnt);

+    IntQueue.Push(PushCnt);

+    inc(PushCnt);

+    IntQueue.Pop();

+  end;

+end;

+

+var

+  i: Integer;

+begin

+  try

+    IntQueue:= TIntQueue.Create;

+    Push2Pop1;

+    WriteLn('Ready');

+  finally

+    IntQueue.Free;

+  end;

+end.

+