From 1eed46514fd8bd5d82c192bdfa75e16d05ca1b12 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 7 Aug 2005 14:43:45 +0000
Subject: [PATCH] * passing of dyn. arrays of tvarrec to array of const fixed,
 fixes bug #4219

git-svn-id: trunk@816 -
---
 .gitattributes         |  1 +
 compiler/ncgcal.pas    |  7 ++++++-
 tests/webtbs/tw4219.pp | 34 ++++++++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw4219.pp

diff --git a/.gitattributes b/.gitattributes
index 24a4d97245..0644d85f81 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index a528a4f0b1..04e2de2924 100644
--- a/compiler/ncgcal.pas
+++ b/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 }
diff --git a/tests/webtbs/tw4219.pp b/tests/webtbs/tw4219.pp
new file mode 100644
index 0000000000..26647ac275
--- /dev/null
+++ b/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: mkruisselbrink@hexis.nl }
+
+{$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.