aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2019-07-03 08:16:11 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-03 08:16:11 +0000
commit5460389b1fde0393afeaab5ce338ebe72a517cae (patch)
tree8ede8d2ef640803b5dc6e2a8358d56ff9cc36a3f
parenteee51f3dd6d8e444270efb6fe191524b79a01445 (diff)
downloadgcc-5460389b1fde0393afeaab5ce338ebe72a517cae.zip
gcc-5460389b1fde0393afeaab5ce338ebe72a517cae.tar.gz
gcc-5460389b1fde0393afeaab5ce338ebe72a517cae.tar.bz2
[Ada] Crash on front-end inlining of subp. with aspect specifications
This patch fixes a gap in the handling of formals when inlining a call to a subprogram marked Inline_Always. For the inlining, the formals are replaced by the actuals in the block constructed for inlining, The traversal that performs this replacement does not apply to aspect specifications that may appear in the original body, because these aspects are only indirectly reachable from the nodes to which they apply: a separate traversal is required to perform the replacement in the expressions for any aspect specification present in the source. 2019-07-03 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * inline.adb (Process_Formals_In_Aspects): New procedure within Expand_Inlined_Call, to perform a replacement of references to formals that appear in aspect specifications within the body being inlined. gcc/testsuite/ * gnat.dg/inline16.adb, gnat.dg/inline16_gen.adb, gnat.dg/inline16_gen.ads, gnat.dg/inline16_types.ads: New testcase. From-SVN: r272983
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/inline.adb31
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gnat.dg/inline16.adb26
-rw-r--r--gcc/testsuite/gnat.dg/inline16_gen.adb16
-rw-r--r--gcc/testsuite/gnat.dg/inline16_gen.ads9
-rw-r--r--gcc/testsuite/gnat.dg/inline16_types.ads7
7 files changed, 102 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 152820f..f06663d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-03 Ed Schonberg <schonberg@adacore.com>
+
+ * inline.adb (Process_Formals_In_Aspects): New procedure within
+ Expand_Inlined_Call, to perform a replacement of references to
+ formals that appear in aspect specifications within the body
+ being inlined.
+
2019-07-03 Justin Squirek <squirek@adacore.com>
* sem_ch8.adb (Analyze_Object_Renaming): Add call to search for
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 653908a..b2038a6 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -2481,6 +2481,13 @@ package body Inline is
-- thunk generated for it. Replace a return statement with an assignment
-- to the target of the call, with appropriate conversions if needed.
+ function Process_Formals_In_Aspects (N : Node_Id)
+ return Traverse_Result;
+ -- Because aspects are linked indirectly to the rest of the tree,
+ -- replacement of formals appearing in aspect specifications must
+ -- be performed in a separate pass, using an instantiation of the
+ -- previous subprogram over aspect specifications reachable from N.
+
function Process_Sloc (Nod : Node_Id) return Traverse_Result;
-- If the call being expanded is that of an internal subprogram, set the
-- sloc of the generated block to that of the call itself, so that the
@@ -2821,6 +2828,29 @@ package body Inline is
procedure Replace_Formals is new Traverse_Proc (Process_Formals);
+ --------------------------------
+ -- Process_Formals_In_Aspects --
+ --------------------------------
+
+ function Process_Formals_In_Aspects (N : Node_Id)
+ return Traverse_Result
+ is
+ A : Node_Id;
+ begin
+ if Has_Aspects (N) then
+ A := First (Aspect_Specifications (N));
+ while Present (A) loop
+ Replace_Formals (Expression (A));
+
+ Next (A);
+ end loop;
+ end if;
+ return OK;
+ end Process_Formals_In_Aspects;
+
+ procedure Replace_Formals_In_Aspects is
+ new Traverse_Proc (Process_Formals_In_Aspects);
+
------------------
-- Process_Sloc --
------------------
@@ -3633,6 +3663,7 @@ package body Inline is
-- Attach block to tree before analysis and rewriting.
Replace_Formals (Blk);
+ Replace_Formals_In_Aspects (Blk);
Set_Parent (Blk, N);
if GNATprove_Mode then
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 709e0c5..3b61539 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-07-03 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/inline16.adb, gnat.dg/inline16_gen.adb,
+ gnat.dg/inline16_gen.ads, gnat.dg/inline16_types.ads: New
+ testcase.
+
2019-07-03 Justin Squirek <squirek@adacore.com>
* gnat.dg/renaming13.adb, gnat.dg/renaming14.adb: New testcases.
diff --git a/gcc/testsuite/gnat.dg/inline16.adb b/gcc/testsuite/gnat.dg/inline16.adb
new file mode 100644
index 0000000..ebe8482
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline16.adb
@@ -0,0 +1,26 @@
+-- { dg-do compile }
+-- { dg-options "-gnatN" }
+
+with Inline16_Types; use Inline16_Types;
+with Inline16_Gen;
+
+procedure Inline16 is
+ type TYPE1 is record
+ f1 : NvU32;
+ f2 : NvU32;
+ f3 : NvU32;
+ end record
+ with Size => 96, Object_Size => 96;
+
+ package Gfw_Image_Read_Pkg1 is new Inline16_Gen (Payload_Type => TYPE1);
+ use Gfw_Image_Read_Pkg1;
+ procedure Get_Boot_Block_Info(Status : out Integer)
+ is
+ Ifr_Fixed_Min : TYPE1;
+ begin
+ Gfw_Image_Read(Ifr_Fixed_Min);
+ Status := 13;
+ end Get_Boot_Block_Info;
+begin
+ null;
+end Inline16;
diff --git a/gcc/testsuite/gnat.dg/inline16_gen.adb b/gcc/testsuite/gnat.dg/inline16_gen.adb
new file mode 100644
index 0000000..bd5b749
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline16_gen.adb
@@ -0,0 +1,16 @@
+with Inline16_Types; use Inline16_Types;
+
+package body Inline16_Gen
+with SPARK_Mode => On
+is
+ procedure Gfw_Image_Read (Data : out Payload_Type)
+ with SPARK_Mode => Off
+ is
+ Array_Len : constant NvU32 := Data'Size / NvU8'Size;
+ Array_Max_Idx : constant NvU32 := Array_Len - 1;
+ type Payload_As_Arr_Type is new Arr_NvU8_Idx32(0 .. Array_Max_Idx);
+ Data_As_Array : Payload_As_Arr_Type with Address => Data'Address;
+ begin
+ null;
+ end Gfw_Image_Read;
+end Inline16_Gen;
diff --git a/gcc/testsuite/gnat.dg/inline16_gen.ads b/gcc/testsuite/gnat.dg/inline16_gen.ads
new file mode 100644
index 0000000..90f1f58
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline16_gen.ads
@@ -0,0 +1,9 @@
+generic
+ type Payload_Type is private;
+package Inline16_Gen
+with SPARK_Mode => On
+is
+ procedure Gfw_Image_Read(Data : out Payload_Type)
+ with Inline_Always;
+
+end Inline16_Gen;
diff --git a/gcc/testsuite/gnat.dg/inline16_types.ads b/gcc/testsuite/gnat.dg/inline16_types.ads
new file mode 100644
index 0000000..dfaf640
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline16_types.ads
@@ -0,0 +1,7 @@
+package Inline16_Types with SPARK_Mode is
+
+ type NvU8 is mod 2 ** 8 with Size => 8;
+ type NvU32 is mod 2 ** 32 with Size => 32;
+
+ type Arr_NvU8_Idx32 is array (NvU32 range <>) of NvU8;
+end Inline16_Types;