This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Spurious elaboration issue due to inlining
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Hristian Kirtchev <kirtchev at adacore dot com>
- Date: Wed, 26 Sep 2018 05:25:45 -0400
- Subject: [Ada] Spurious elaboration issue due to inlining
This patch ensures that the full compilation context is captured prior
to package or subprogram instantiation/inlining and restored after the
action takes place.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-09-26 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* sem_ch12.adb (Instantiate_Package_Body): Capture and restore
the full compilation context.
(Instantiate_Subprogram_Body): Capture and restore the full
compilation context.
gcc/testsuite/
* gnat.dg/elab7.adb, gnat.dg/elab7_pkg1.adb,
gnat.dg/elab7_pkg1.ads, gnat.dg/elab7_pkg2.adb,
gnat.dg/elab7_pkg2.ads: New testcase.
--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -11202,10 +11202,6 @@ package body Sem_Ch12 is
Gen_Decl : constant Node_Id := Unit_Declaration_Node (Gen_Unit);
Loc : constant Source_Ptr := Sloc (Inst_Node);
- Saved_ISMP : constant Boolean :=
- Ignore_SPARK_Mode_Pragmas_In_Instance;
- Saved_Style_Check : constant Boolean := Style_Check;
-
procedure Check_Initialized_Types;
-- In a generic package body, an entity of a generic private type may
-- appear uninitialized. This is suspicious, unless the actual is a
@@ -11276,20 +11272,30 @@ package body Sem_Ch12 is
-- Local variables
- Saved_GM : constant Ghost_Mode_Type := Ghost_Mode;
- Saved_IGR : constant Node_Id := Ignored_Ghost_Region;
- Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
- Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
- -- Save the Ghost and SPARK mode-related data to restore on exit
+ -- The following constants capture the context prior to instantiating
+ -- the package body.
- Act_Body : Node_Id;
- Act_Body_Id : Entity_Id;
- Act_Body_Name : Node_Id;
- Gen_Body : Node_Id;
- Gen_Body_Id : Node_Id;
- Par_Ent : Entity_Id := Empty;
- Par_Vis : Boolean := False;
- Parent_Installed : Boolean := False;
+ Saved_CS : constant Config_Switches_Type := Save_Config_Switches;
+ Saved_GM : constant Ghost_Mode_Type := Ghost_Mode;
+ Saved_IGR : constant Node_Id := Ignored_Ghost_Region;
+ Saved_ISMP : constant Boolean :=
+ Ignore_SPARK_Mode_Pragmas_In_Instance;
+ Saved_LSST : constant Suppress_Stack_Entry_Ptr :=
+ Local_Suppress_Stack_Top;
+ Saved_SC : constant Boolean := Style_Check;
+ Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
+ Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
+ Saved_SS : constant Suppress_Record := Scope_Suppress;
+ Saved_Warn : constant Warning_Record := Save_Warnings;
+
+ Act_Body : Node_Id;
+ Act_Body_Id : Entity_Id;
+ Act_Body_Name : Node_Id;
+ Gen_Body : Node_Id;
+ Gen_Body_Id : Node_Id;
+ Par_Ent : Entity_Id := Empty;
+ Par_Installed : Boolean := False;
+ Par_Vis : Boolean := False;
Vis_Prims_List : Elist_Id := No_Elist;
-- List of primitives made temporarily visible in the instantiation
@@ -11452,13 +11458,13 @@ package body Sem_Ch12 is
Par_Ent := Entity (Prefix (Gen_Id));
Par_Vis := Is_Immediately_Visible (Par_Ent);
Install_Parent (Par_Ent, In_Body => True);
- Parent_Installed := True;
+ Par_Installed := True;
elsif Is_Child_Unit (Gen_Unit) then
Par_Ent := Scope (Gen_Unit);
Par_Vis := Is_Immediately_Visible (Par_Ent);
Install_Parent (Par_Ent, In_Body => True);
- Parent_Installed := True;
+ Par_Installed := True;
end if;
-- If the instantiation is a library unit, and this is the main unit,
@@ -11527,7 +11533,7 @@ package body Sem_Ch12 is
-- Remove the parent instances if they have been placed on the scope
-- stack to compile the body.
- if Parent_Installed then
+ if Par_Installed then
Remove_Parent (In_Body => True);
-- Restore the previous visibility of the parent
@@ -11599,13 +11605,21 @@ package body Sem_Ch12 is
end if;
end if;
- Expander_Mode_Restore;
-
<<Leave>>
+
+ -- Restore the context that was in effect prior to instantiating the
+ -- package body.
+
Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP;
- Restore_Ghost_Region (Saved_GM, Saved_IGR);
- Restore_SPARK_Mode (Saved_SM, Saved_SMP);
- Style_Check := Saved_Style_Check;
+ Local_Suppress_Stack_Top := Saved_LSST;
+ Scope_Suppress := Saved_SS;
+ Style_Check := Saved_SC;
+
+ Expander_Mode_Restore;
+ Restore_Config_Switches (Saved_CS);
+ Restore_Ghost_Region (Saved_GM, Saved_IGR);
+ Restore_SPARK_Mode (Saved_SM, Saved_SMP);
+ Restore_Warnings (Saved_Warn);
end Instantiate_Package_Body;
---------------------------------
@@ -11630,27 +11644,31 @@ package body Sem_Ch12 is
Pack_Id : constant Entity_Id :=
Defining_Unit_Name (Parent (Act_Decl));
- Saved_GM : constant Ghost_Mode_Type := Ghost_Mode;
- Saved_IGR : constant Node_Id := Ignored_Ghost_Region;
- Saved_ISMP : constant Boolean :=
- Ignore_SPARK_Mode_Pragmas_In_Instance;
- Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
- Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
- -- Save the Ghost and SPARK mode-related data to restore on exit
-
- Saved_Style_Check : constant Boolean := Style_Check;
- Saved_Warnings : constant Warning_Record := Save_Warnings;
+ -- The following constants capture the context prior to instantiating
+ -- the subprogram body.
- Act_Body : Node_Id;
- Act_Body_Id : Entity_Id;
- Gen_Body : Node_Id;
- Gen_Body_Id : Node_Id;
- Pack_Body : Node_Id;
- Par_Ent : Entity_Id := Empty;
- Par_Vis : Boolean := False;
- Ret_Expr : Node_Id;
-
- Parent_Installed : Boolean := False;
+ Saved_CS : constant Config_Switches_Type := Save_Config_Switches;
+ Saved_GM : constant Ghost_Mode_Type := Ghost_Mode;
+ Saved_IGR : constant Node_Id := Ignored_Ghost_Region;
+ Saved_ISMP : constant Boolean :=
+ Ignore_SPARK_Mode_Pragmas_In_Instance;
+ Saved_LSST : constant Suppress_Stack_Entry_Ptr :=
+ Local_Suppress_Stack_Top;
+ Saved_SC : constant Boolean := Style_Check;
+ Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
+ Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
+ Saved_SS : constant Suppress_Record := Scope_Suppress;
+ Saved_Warn : constant Warning_Record := Save_Warnings;
+
+ Act_Body : Node_Id;
+ Act_Body_Id : Entity_Id;
+ Gen_Body : Node_Id;
+ Gen_Body_Id : Node_Id;
+ Pack_Body : Node_Id;
+ Par_Ent : Entity_Id := Empty;
+ Par_Installed : Boolean := False;
+ Par_Vis : Boolean := False;
+ Ret_Expr : Node_Id;
begin
Gen_Body_Id := Corresponding_Body (Gen_Decl);
@@ -11792,13 +11810,13 @@ package body Sem_Ch12 is
Par_Ent := Entity (Prefix (Gen_Id));
Par_Vis := Is_Immediately_Visible (Par_Ent);
Install_Parent (Par_Ent, In_Body => True);
- Parent_Installed := True;
+ Par_Installed := True;
elsif Is_Child_Unit (Gen_Unit) then
Par_Ent := Scope (Gen_Unit);
Par_Vis := Is_Immediately_Visible (Par_Ent);
Install_Parent (Par_Ent, In_Body => True);
- Parent_Installed := True;
+ Par_Installed := True;
end if;
-- Subprogram body is placed in the body of wrapper package,
@@ -11843,7 +11861,7 @@ package body Sem_Ch12 is
Restore_Private_Views (Pack_Id, False);
- if Parent_Installed then
+ if Par_Installed then
Remove_Parent (In_Body => True);
-- Restore the previous visibility of the parent
@@ -11852,7 +11870,6 @@ package body Sem_Ch12 is
end if;
Restore_Env;
- Restore_Warnings (Saved_Warnings);
-- Body not found. Error was emitted already. If there were no previous
-- errors, this may be an instance whose scope is a premature instance.
@@ -11923,13 +11940,21 @@ package body Sem_Ch12 is
Analyze (Pack_Body);
end if;
- Expander_Mode_Restore;
-
<<Leave>>
+
+ -- Restore the context that was in effect prior to instantiating the
+ -- subprogram body.
+
Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP;
- Restore_Ghost_Region (Saved_GM, Saved_IGR);
- Restore_SPARK_Mode (Saved_SM, Saved_SMP);
- Style_Check := Saved_Style_Check;
+ Local_Suppress_Stack_Top := Saved_LSST;
+ Scope_Suppress := Saved_SS;
+ Style_Check := Saved_SC;
+
+ Expander_Mode_Restore;
+ Restore_Config_Switches (Saved_CS);
+ Restore_Ghost_Region (Saved_GM, Saved_IGR);
+ Restore_SPARK_Mode (Saved_SM, Saved_SMP);
+ Restore_Warnings (Saved_Warn);
end Instantiate_Subprogram_Body;
----------------------
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab7.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+-- { dg-options "-gnatE -gnatn" }
+
+with Elab7_Pkg1;
+
+procedure Elab7 is
+begin
+ null;
+end Elab7;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab7_pkg1.adb
@@ -0,0 +1,8 @@
+with Elab7_Pkg2;
+
+package body Elab7_Pkg1 is
+ procedure A is
+ begin
+ Elab7_Pkg2.A;
+ end A;
+end Elab7_Pkg1;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab7_pkg1.ads
@@ -0,0 +1,3 @@
+package Elab7_Pkg1 is
+ procedure A;
+end Elab7_Pkg1;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab7_pkg2.adb
@@ -0,0 +1,15 @@
+with Elab7_Pkg1;
+
+package body Elab7_Pkg2 is
+ procedure From_Timerep is
+ Lf1 : Long_Float := 1.0;
+ Lf2 : Long_Float := Long_Float'Floor(Lf1);
+ begin
+ null;
+ end From_Timerep;
+
+ procedure A is
+ begin
+ Elab7_Pkg1.A;
+ end A;
+end Elab7_Pkg2;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab7_pkg2.ads
@@ -0,0 +1,5 @@
+package Elab7_Pkg2 is
+ pragma Elaborate_Body;
+
+ procedure A;
+end Elab7_Pkg2;