From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 5 Jul 2019 07:03:30 +0000 (+0000)
Subject: [Ada] Fix internal error on packed array In/Out actual parameter
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d21328a0d42f1b6a92f777acf4972e3c1c5d330c;p=gcc.git

[Ada] Fix internal error on packed array In/Out actual parameter

This fixes an issue introduced in Ada 2012 for calls to functions taking
an In/Out parameter and for which the actual is the component of a
packed array.  In this case, the front-end needs to create a temporary
for the actual, initialize it before the call and assign it back after
it, because operations on bit-packed arrays are converted into
mask-and-shift sequences.

2019-07-05  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Indexed_Component): Do not expand actual
	parameters of function calls here either.

gcc/testsuite/

	* gnat.dg/pack23.adb, gnat.dg/pack23_pkg.ads: New testcase.

From-SVN: r273124
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1899bffd697..8373be77975 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Indexed_Component): Do not expand actual
+	parameters of function calls here either.
+
 2019-07-05  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* bindo-units.adb, checks.adb, exp_attr.adb, exp_ch3.adb,
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a611e03c47a..78b5028d75e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6762,7 +6762,7 @@ package body Exp_Ch4 is
       --    Renaming objects in renaming associations
       --      This case is handled when a use of the renamed variable occurs
 
-      --    Actual parameters for a procedure call
+      --    Actual parameters for a subprogram call
       --      This case is handled in Exp_Ch6.Expand_Actuals
 
       --    The second expression in a 'Read attribute reference
@@ -6783,11 +6783,12 @@ package body Exp_Ch4 is
             if Nkind (Parnt) = N_Unchecked_Expression then
                null;
 
-            elsif Nkind_In (Parnt, N_Object_Renaming_Declaration,
-                                   N_Procedure_Call_Statement)
+            elsif Nkind (Parnt) = N_Object_Renaming_Declaration then
+               return;
+
+            elsif Nkind (Parnt) in N_Subprogram_Call
               or else (Nkind (Parnt) = N_Parameter_Association
-                        and then
-                          Nkind (Parent (Parnt)) = N_Procedure_Call_Statement)
+                        and then Nkind (Parent (Parnt)) in N_Subprogram_Call)
             then
                return;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cdf0b40de02..53d79948979 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/pack23.adb, gnat.dg/pack23_pkg.ads: New testcase.
+
 2019-07-05  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/task3.adb, gnat.dg/task3.ads, gnat.dg/task3_pkg1.ads,
diff --git a/gcc/testsuite/gnat.dg/pack23.adb b/gcc/testsuite/gnat.dg/pack23.adb
new file mode 100644
index 00000000000..aa8099fd3cb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack23.adb
@@ -0,0 +1,14 @@
+--  { dg-do compile }
+--  { dg-options "-gnatws" }
+
+with Pack23_Pkg;
+
+function Pack23 return Integer is
+
+  type Arr is array (1 .. 32) of Boolean with Size => 32, Pack;
+
+  A : Arr;
+
+begin
+  return Pack23_Pkg.Func (A (1));
+end;
diff --git a/gcc/testsuite/gnat.dg/pack23_pkg.ads b/gcc/testsuite/gnat.dg/pack23_pkg.ads
new file mode 100644
index 00000000000..beacbade464
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack23_pkg.ads
@@ -0,0 +1,5 @@
+package Pack23_Pkg is
+
+  function Func (B : in out Boolean) return Integer;
+
+end Pack23_Pkg;