From 1a409f80df7452dbcab228390a2de483bed5b875 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Wed, 26 Sep 2018 09:19:28 +0000 Subject: [PATCH] [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. 2018-09-26 Hristian Kirtchev 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. From-SVN: r264630 --- gcc/ada/ChangeLog | 7 ++ gcc/ada/sem_ch12.adb | 133 ++++++++++++++++----------- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gnat.dg/elab7.adb | 9 ++ gcc/testsuite/gnat.dg/elab7_pkg1.adb | 8 ++ gcc/testsuite/gnat.dg/elab7_pkg1.ads | 3 + gcc/testsuite/gnat.dg/elab7_pkg2.adb | 15 +++ gcc/testsuite/gnat.dg/elab7_pkg2.ads | 5 + 8 files changed, 132 insertions(+), 54 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/elab7.adb create mode 100644 gcc/testsuite/gnat.dg/elab7_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/elab7_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/elab7_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/elab7_pkg2.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0ba717d977a..80d119d87c7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-09-26 Hristian Kirtchev + + * sem_ch12.adb (Instantiate_Package_Body): Capture and restore + the full compilation context. + (Instantiate_Subprogram_Body): Capture and restore the full + compilation context. + 2018-09-26 Yannick Moy * debug.adb: Add use for -gnatd_f switch. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 391d1e3ae7c..5e04895b579 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; - <> + + -- 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; - <> + + -- 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; ---------------------- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ccebb8a56be..cf904eb8466 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-09-26 Hristian Kirtchev + + * 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. + 2018-09-26 Javier Miranda * gnat.dg/interface8.adb, gnat.dg/interface8.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/elab7.adb b/gcc/testsuite/gnat.dg/elab7.adb new file mode 100644 index 00000000000..b5b52f170ec --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/elab7_pkg1.adb b/gcc/testsuite/gnat.dg/elab7_pkg1.adb new file mode 100644 index 00000000000..e9af99fba10 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/elab7_pkg1.ads b/gcc/testsuite/gnat.dg/elab7_pkg1.ads new file mode 100644 index 00000000000..bb1db2c1317 --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab7_pkg1.ads @@ -0,0 +1,3 @@ +package Elab7_Pkg1 is + procedure A; +end Elab7_Pkg1; diff --git a/gcc/testsuite/gnat.dg/elab7_pkg2.adb b/gcc/testsuite/gnat.dg/elab7_pkg2.adb new file mode 100644 index 00000000000..97a9ba6d376 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/elab7_pkg2.ads b/gcc/testsuite/gnat.dg/elab7_pkg2.ads new file mode 100644 index 00000000000..8eceb2cce4e --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab7_pkg2.ads @@ -0,0 +1,5 @@ +package Elab7_Pkg2 is + pragma Elaborate_Body; + + procedure A; +end Elab7_Pkg2; -- 2.30.2