From a15505521c0e75084a646d3922e9eb25774ca712 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Thu, 16 Feb 2006 20:27:31 +0000
Subject: [PATCH]   * fixed handling of wrong invocations of slice + improved
 error reporting

git-svn-id: trunk@2614 -
---
 .gitattributes                     |  2 ++
 compiler/ncal.pas                  | 22 +++++++++++++++++-----
 compiler/ninl.pas                  | 10 +++++++---
 tests/test/units/system/tslice1.pp |  9 +++++++++
 tests/test/units/system/tslice2.pp |  9 +++++++++
 5 files changed, 44 insertions(+), 8 deletions(-)
 create mode 100644 tests/test/units/system/tslice1.pp
 create mode 100644 tests/test/units/system/tslice2.pp

diff --git a/.gitattributes b/.gitattributes
index c5f1f472f2..8d1addbca3 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -5796,6 +5796,8 @@ tests/test/units/system/tround.pp svneol=native#text/plain
 tests/test/units/system/tseg.pp svneol=native#text/plain
 tests/test/units/system/tsetstr.pp svneol=native#text/plain
 tests/test/units/system/tsetstr2.pp svneol=native#text/plain
+tests/test/units/system/tslice1.pp svneol=native#text/plain
+tests/test/units/system/tslice2.pp svneol=native#text/plain
 tests/test/units/system/tstring.pp svneol=native#text/plain
 tests/test/units/system/ttrig.pas svneol=native#text/plain
 tests/test/units/system/ttrunc.pp svneol=native#text/plain
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 987ca6e0cf..e0f5825205 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -703,7 +703,7 @@ type
                          (tloadnode(left).is_addr_param_load)
                         )
                     ) then
-                   make_not_regable(left);
+                   make_not_regable(left,false);
 
                  if do_count then
                   begin
@@ -2218,9 +2218,12 @@ type
                    )
                   ) then
                   begin
-                    { in theory, this is always regable, but ncgcall can't }
-                    { handle it yet in all situations (JM)                 }
-                    tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,tparavarsym(para.parasym).varregable <> vr_none);
+                    { make sure records which could be written to are not }
+                    { kept in a register                                  }
+                    tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,
+                      (tparavarsym(para.parasym).varregable <> vr_none) and
+                      ((para.parasym.vartype.def.deftype <> recorddef) or
+                       not(para.parasym.varspez in [vs_var,vs_out])));
                     addstatement(createstatement,tempnode);
                     { assign the value of the parameter to the temp, except in case of the function result }
                     { (in that case, para.left is a block containing the creation of a new temp, while we  }
@@ -2254,7 +2257,16 @@ type
                       caddrnode.create_internal(para.left)));
                     para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resulttype);
                     addstatement(deletestatement,ctempdeletenode.create(tempnode));
-                  end;
+                  end
+                { the regvar status of vs_var/vs_out paras is never changed, }
+                { so in case the are records turn of regvarability of the    }
+                { para (because we can't write to regvar records yet)        }
+                else if (para.parasym.vartype.def.deftype = recorddef) and
+                        (para.parasym.varspez in [vs_var,vs_out]) then
+                  if (para.left.nodetype = blockn) then
+                    make_not_regable(laststatement(tblocknode(para.left)),true)
+                  else
+                    make_not_regable(para.left,true);
               end;
             para := tcallparanode(para.right);
           end;
diff --git a/compiler/ninl.pas b/compiler/ninl.pas
index 56dafbb809..ea33c8e00c 100644
--- a/compiler/ninl.pas
+++ b/compiler/ninl.pas
@@ -1745,9 +1745,13 @@ implementation
               in_slice_x:
                 begin
                   result:=nil;
-                  resulttype:=tcallparanode(tcallparanode(left).left).resulttype;
-                  if not(resulttype.def.deftype=arraydef) then
-                    CGMessage(type_e_mismatch);
+                  resulttype:=tcallparanode(left).left.resulttype;
+                  if (resulttype.def.deftype <> arraydef) then
+                    CGMessagePos(left.fileinfo,type_e_mismatch);
+                  if not(is_integer(tcallparanode(tcallparanode(left).right).left.resulttype.def)) then
+                    CGMessagePos1(tcallparanode(left).right.fileinfo,
+                      type_e_integer_expr_expected,
+                      tcallparanode(tcallparanode(left).right).left.resulttype.def.typename);
                 end;
 
               in_low_x,
diff --git a/tests/test/units/system/tslice1.pp b/tests/test/units/system/tslice1.pp
new file mode 100644
index 0000000000..5ede19c84a
--- /dev/null
+++ b/tests/test/units/system/tslice1.pp
@@ -0,0 +1,9 @@
+{ %fail }
+
+procedure t(arr: array of integer);
+begin
+  t(slice(arr));
+end;
+
+begin
+end.
diff --git a/tests/test/units/system/tslice2.pp b/tests/test/units/system/tslice2.pp
new file mode 100644
index 0000000000..1340d903ff
--- /dev/null
+++ b/tests/test/units/system/tslice2.pp
@@ -0,0 +1,9 @@
+{ %fail }
+
+procedure t(arr: array of integer);
+begin
+  t(slice(arr,'k'));
+end;
+
+begin
+end.