* fixed memory statistics after try_concat_free_chunk_forward() concatenated

some blocks, but the result was still not large enough to satisfy a
    reallocmem call (mantis #14315)

git-svn-id: trunk@22249 -

.gitattributes

@@ -12360,6 +12360,7 @@ tests/webtbs/tw14230.pp svneol=native#text/plain
 tests/webtbs/tw14236.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
+tests/webtbs/tw14315.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
 tests/webtbs/tw14363.pp svneol=native#text/plain
 tests/webtbs/tw14388.pp svneol=native#text/pascal

rtl/inc/heap.inc

@@ -1174,7 +1174,7 @@ begin
     exit(chunksize);
   end;
 
-  { insert the block in it's freelist }
+  { insert the block in its freelist }
   pmcv^.size := pmcv^.size and (not usedflag);
   append_to_list_var(pmcv);
   pmcv := try_concat_free_chunk(pmcv);
@@ -1385,6 +1385,16 @@ begin
     currsize := pcurr^.size and sizemask;
   if size>currsize then
     begin
+      { adjust statistics (try_concat_free_chunk_forward may have merged a free
+        block into the current block, which we will subsequently free (so the
+        combined size will be freed -> make sure the combined size is marked as
+        used) }
+      with loc_freelists^.internal_status do
+      begin
+        inc(currheapused, currsize-oldsize);
+        if currheapused > maxheapused then
+          maxheapused := currheapused;
+      end;
       { the size is bigger than the previous size, we need to allocate more mem
         but we could not concatenate with next block or not big enough }
       exit;

tests/webtbs/tw14315.pp

@@ -0,0 +1,46 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+function RandomRange(const low : longint;
+                     const high : longint) : longint;
+begin
+  if (high < low) then
+    result := high + random(low - high + 1)
+  else
+    Result := low + random(high - low + 1);
+end;
+
+procedure GetStats(out used: ptruint);
+var
+  fpcHeapStatus : TFPCHeapStatus;
+begin
+  fpcHeapStatus := GetFPCHeapStatus();
+  used:=fpcHeapStatus.CurrHeapUsed;
+  writeln(' heap status: cu=' +
+          IntToStr(fpcHeapStatus.CurrHeapUsed) + ', cs=' +
+          IntToStr(fpcHeapStatus.CurrHeapSize) + ', cf=' +
+          IntToStr(fpcHeapStatus.CurrHeapFree) + ', mu=' +
+          IntToStr(fpcHeapStatus.MaxHeapUsed) + ', ms=' +
+          IntToStr(fpcHeapStatus.MaxHeapSize));
+end;
+
+var
+  i : integer;
+  a : array of byte;
+  u1, u2: ptruint;
+begin
+  randomize();
+  writeln('randseed: ',randseed);
+  GetStats(u1);
+  for i := 0 to 50 do begin
+    SetLength(a, RandomRange(1024,1024*1024*15));
+  end;
+  SetLength(a, 0);
+  GetStats(u2);
+  if u1<>u2 then
+    halt(1);
+end.