[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  <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.

From-SVN: r264630

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0ba717d977ab5a1099bf9365227e4cb30fda8641..80d119d87c798c4833e5579959b990afd6713a3f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <moy@adacore.com>
 
        * debug.adb: Add use for -gnatd_f switch.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 391d1e3ae7c299452e659d8685cf31a30fb9d6f1..5e04895b57976294f8aad3d5eff707dd433482ab 100644 (file)
--- 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;
-
    <<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;
 
    ----------------------

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ccebb8a56be176392460422d84603ca77d869167..cf904eb8466834218e07e88d2378b372e175f8c4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <miranda@adacore.com>
 
        * 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 (file)
index 0000000..b5b52f1
--- /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 (file)
index 0000000..e9af99f
--- /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 (file)
index 0000000..bb1db2c
--- /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 (file)
index 0000000..97a9ba6
--- /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 (file)
index 0000000..8eceb2c
--- /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;