Просмотр исходного кода

Merged revisions 816 via svnmerge from
/trunk

git-svn-id: branches/fixes_2_0@820 -

florian 20 лет назад
Родитель
Сommit
d4bd1e495d
3 измененных файлов с 41 добавлено и 1 удалено
  1. 1 0
      .gitattributes
  2. 6 1
      compiler/ncgcal.pas
  3. 34 0
      tests/webtbs/tw4219.pp

+ 1 - 0
.gitattributes

@@ -5988,6 +5988,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/tw4247.pp svneol=native#text/plain
 tests/webtbs/tw4260.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain

+ 6 - 1
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 }

+ 34 - 0
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.