Browse Source

* fix TVector.Reserve after IncreaseCapacity changes, resolves #36698

git-svn-id: trunk@44167 -
florian 5 years ago
parent
commit
1e64133a08
3 changed files with 55 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 13 7
      packages/fcl-stl/src/gvector.pp
  3. 41 0
      tests/webtbs/tw36698.pp

+ 1 - 0
.gitattributes

@@ -18034,6 +18034,7 @@ tests/webtbs/tw36589.pp svneol=native#text/pascal
 tests/webtbs/tw3661.pp svneol=native#text/plain
 tests/webtbs/tw3661.pp svneol=native#text/plain
 tests/webtbs/tw3666.pp svneol=native#text/plain
 tests/webtbs/tw3666.pp svneol=native#text/plain
 tests/webtbs/tw3669.pp svneol=native#text/plain
 tests/webtbs/tw3669.pp svneol=native#text/plain
+tests/webtbs/tw36698.pp -text svneol=native#text/pascal
 tests/webtbs/tw3676.pp svneol=native#text/plain
 tests/webtbs/tw3676.pp svneol=native#text/plain
 tests/webtbs/tw3681.pp svneol=native#text/plain
 tests/webtbs/tw3681.pp svneol=native#text/plain
 tests/webtbs/tw3683.pp svneol=native#text/plain
 tests/webtbs/tw3683.pp svneol=native#text/plain

+ 13 - 7
packages/fcl-stl/src/gvector.pp

@@ -33,7 +33,8 @@ type
     procedure SetValue(Position: SizeUInt; const Value: T); inline;
     procedure SetValue(Position: SizeUInt; const Value: T); inline;
     function GetValue(Position: SizeUInt): T; inline;
     function GetValue(Position: SizeUInt): T; inline;
     function GetMutable(Position: SizeUInt): PT; inline;
     function GetMutable(Position: SizeUInt): PT; inline;
-    procedure IncreaseCapacity; inline;
+    function NewCapacity: SizeUInt;
+    procedure IncreaseCapacity;
 
 
   const
   const
     // todo: move these constants to implementation when
     // todo: move these constants to implementation when
@@ -162,7 +163,7 @@ begin
   inc(FDataSize);
   inc(FDataSize);
 end;
 end;
 
 
-procedure TVector.IncreaseCapacity();
+function TVector.NewCapacity: SizeUInt;
 const
 const
   // if size is small, multiply by 2;
   // if size is small, multiply by 2;
   // if size bigger but <256M, inc by 1/8*size;
   // if size bigger but <256M, inc by 1/8*size;
@@ -174,15 +175,20 @@ var
 begin
 begin
   DataSize:=FCapacity*SizeOf(T);
   DataSize:=FCapacity*SizeOf(T);
   if FCapacity=0 then
   if FCapacity=0 then
-    FCapacity:=4
+    Result:=4
   else
   else
   if DataSize<cSizeSmall then
   if DataSize<cSizeSmall then
-    FCapacity:=FCapacity*2
+    Result:=FCapacity*2
   else
   else
   if DataSize<cSizeBig then
   if DataSize<cSizeBig then
-    FCapacity:=FCapacity+FCapacity div 8
+    Result:=FCapacity+FCapacity div 8
   else
   else
-    FCapacity:=FCapacity+FCapacity div 16;
+    Result:=FCapacity+FCapacity div 16;
+end;
+
+procedure TVector.IncreaseCapacity();
+begin
+  FCapacity:=NewCapacity;
   SetLength(FData, FCapacity);
   SetLength(FData, FCapacity);
 end;
 end;
 
 
@@ -239,7 +245,7 @@ procedure TVector.Reserve(Num: SizeUInt);
 begin
 begin
   if(Num < FCapacity) then 
   if(Num < FCapacity) then 
     exit
     exit
-  else if(Num <= 2*FCapacity) then 
+  else if (Num <= NewCapacity) then 
     IncreaseCapacity
     IncreaseCapacity
   else begin 
   else begin 
     SetLength(FData, Num);
     SetLength(FData, Num);

+ 41 - 0
tests/webtbs/tw36698.pp

@@ -0,0 +1,41 @@
+program map_test;
+
+{$mode objfpc}
+
+uses
+  SysUtils, ghashmap;
+
+const
+  TestSize = 270000;
+
+type
+
+  THash = class
+    class function Hash(aValue: Integer; n: SizeUInt): SizeUInt; static;
+  end;
+  TMap = specialize THashmap<Integer, Integer, THash>;
+
+
+class function THash.Hash(aValue: Integer; n: SizeUInt): SizeUInt;
+begin
+  aValue := aValue xor aValue shr 20 xor aValue shr 12;
+  Result := SizeUInt(aValue xor aValue shr 7 xor aValue shr 4) and (n-1);
+end;
+
+procedure Test;
+var
+  Map: TMap;
+  I: Integer;
+begin
+  Map := TMap.Create;
+  try
+    for I := 1 to TestSize do
+      Map.Insert(I, I);
+  finally
+    Map.Free;
+  end;
+end;
+
+begin
+  Test;
+end.