* passing of dyn. arrays of tvarrec to array of const fixed, fixes bug #4219

git-svn-id: trunk@816 -

.gitattributes

@@ -6155,6 +6155,7 @@ tests/webtbs/tw4188.pp svneol=native#text/plain
 tests/webtbs/tw4199.pp svneol=native#text/plain
 tests/webtbs/tw4202.pp svneol=native#text/plain
 tests/webtbs/tw4215.pp svneol=native#text/plain
+tests/webtbs/tw4219.pp svneol=native#text/plain
 tests/webtbs/tw4233.pp svneol=native#text/plain
 tests/webtbs/tw4240.pp svneol=native#text/plain
 tests/webtbs/tw4247.pp svneol=native#text/plain

compiler/ncgcal.pas

@@ -385,7 +385,12 @@ implementation
                          (left.resulttype.def.deftype in [pointerdef,classrefdef])
                         ) and
                      paramanager.push_addr_param(parasym.varspez,parasym.vartype.def,
-                         aktcallnode.procdefinition.proccalloption)) then
+                         aktcallnode.procdefinition.proccalloption)) and
+                     { dyn. arrays passed to an array of const must be passed by value, see tests/webtbs/tw4219.pp }
+                     not(
+                         is_array_of_const(parasym.vartype.def) and
+                         is_dynamic_array(left.resulttype.def)
+                        ) then
                    begin
                       { Passing a var parameter to a var parameter, we can
                         just push the address transparently }

tests/webtbs/tw4219.pp

@@ -0,0 +1,34 @@
+{ Source provided for Free Pascal Bug Report 4219 }
+{ Submitted by "Marijn Kruisselbrink" on  2005-07-25 }
+{ e-mail: [email protected] }
+
+{$mode objfpc}
+program test;
+
+procedure f1(const p: array of const);
+begin
+  write('f1:');
+  writeln(p[0].VType);
+  if p[0].VType<>vtInteger then
+    halt(1);
+end;
+
+procedure f2(const p: array of TVarRec);
+begin
+  write('f2:');
+  writeln(p[0].VType);
+  if p[0].VType<>vtInteger then
+    halt(1);
+end;
+
+var
+  p: array of TVarRec;
+begin
+  setlength(p, 1);
+  p[0].VType := vtInteger;
+  p[0].VInteger := 0;
+
+  f1(p);
+  f2(p);
+  writeln('ok');
+end.