From a7f1ce2e98fa344cc8d15f89ed283e6e7ba437fc Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sat, 26 Dec 2015 08:53:56 +0000
Subject: [PATCH] * patch by Dmitry Boyarintsev: initialize dyn. arrays more
 cleverly in a setlength call with ref. count>1, resolves issue #29250

git-svn-id: trunk@32721 -
---
 .gitattributes          |  1 +
 rtl/inc/dynarr.inc      |  8 ++++--
 tests/webtbs/tw29250.pp | 61 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 68 insertions(+), 2 deletions(-)
 create mode 100644 tests/webtbs/tw29250.pp

diff --git a/.gitattributes b/.gitattributes
index d3712d28ad..28c9f43601 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -14898,6 +14898,7 @@ tests/webtbs/tw29153.pp svneol=native#text/plain
 tests/webtbs/tw2916.pp svneol=native#text/plain
 tests/webtbs/tw2920.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
+tests/webtbs/tw29250.pp svneol=native#text/pascal
 tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
 tests/webtbs/tw2942a.pp svneol=native#text/plain
diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
index 214fd3b5b8..f97806d8b3 100644
--- a/rtl/inc/dynarr.inc
+++ b/rtl/inc/dynarr.inc
@@ -128,6 +128,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
      updatep: boolean;
      elesize : sizeint;
      eletype : pointer;
+     movsize : sizeint;
 
   begin
      { negative length is not allowed }
@@ -171,12 +172,15 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                updatep := true;
                { make an unique copy }
                getmem(newp,size);
-               fillchar(newp^,size,0);
+               fillchar(newp^,sizeof(tdynarray),0);
                if realp^.high < dims[0] then
                  movelen := realp^.high+1
                else
                  movelen := dims[0];
-               move(p^,(pointer(newp)+sizeof(tdynarray))^,elesize*movelen);
+               movsize := elesize*movelen;
+               move(p^,(pointer(newp)+sizeof(tdynarray))^, movsize);
+               if size-sizeof(tdynarray)>movsize then
+                 fillchar((pointer(newp)+sizeof(tdynarray)+movsize)^,size-sizeof(tdynarray)-movsize,0);
 
                { increment ref. count of members }
                for i:= 0 to movelen-1 do
diff --git a/tests/webtbs/tw29250.pp b/tests/webtbs/tw29250.pp
new file mode 100644
index 0000000000..e33f39ac23
--- /dev/null
+++ b/tests/webtbs/tw29250.pp
@@ -0,0 +1,61 @@
+{$mode objfpc}
+
+function comparearr(const a,b: array of byte; len: integer): Boolean;
+var
+  i : integer;
+begin
+  for i:=0 to len-1 do
+    if a[i]<>b[i] then begin
+      Result:=false;
+      Exit;
+    end;
+  Result:=true;
+end;
+
+procedure printarr(const a: array of byte);
+var
+  i : integer;
+begin
+  for i:=0 to length(a)-1 do write(a[i],' ');
+  writeln;
+end;
+
+const
+  size_cnt = 8;
+  size_inc = 20;
+  size_dec = 4;
+
+var
+  a: array of byte;
+  b: array of byte;
+  i: integer;
+  r: integer;
+begin
+  SetLength(a, size_cnt);
+  for i:=0 to length(a)-1 do a[i]:=$F0+i;
+
+  // test decrease size
+  // match, by less size
+  b:=a;
+  SetLength(b, size_dec);
+  if not comparearr(a,b,length(b))  then
+    halt(1);
+
+  // test same size/copy
+  // full match
+  b:=a;
+  SetLength(b, length(b));
+  if not comparearr(a,b,length(b)) then
+    halt(1);
+
+  // test increase size
+  // first part must match, last part must be zero
+  b:=a;
+  SetLength(b, size_inc);
+  if not comparearr(a,b,length(a)) then
+    halt(1);
+  r:=1;
+  for i:=length(a) to length(b)-1 do
+    if b[i]<>0 then begin r:=0; halt(1) end;
+  writeln('ok');
+end.