* 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

@@ -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

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

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.