aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2018-09-26 09:19:28 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-09-26 09:19:28 +0000
commit1a409f80df7452dbcab228390a2de483bed5b875 (patch)
tree0358e2c62d3402b7a22eb399e9c80779b756d4c1
parenta30a69c1229cbf5270d2048299da5b9ae171e226 (diff)
downloadgcc-1a409f80df7452dbcab228390a2de483bed5b875.zip
gcc-1a409f80df7452dbcab228390a2de483bed5b875.tar.gz
gcc-1a409f80df7452dbcab228390a2de483bed5b875.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/sem_ch12.adb133
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gnat.dg/elab7.adb9
-rw-r--r--gcc/testsuite/gnat.dg/elab7_pkg1.adb8
-rw-r--r--gcc/testsuite/gnat.dg/elab7_pkg1.ads3
-rw-r--r--gcc/testsuite/gnat.dg/elab7_pkg2.adb15
-rw-r--r--gcc/testsuite/gnat.dg/elab7_pkg2.ads5
8 files changed, 132 insertions, 54 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0ba717d..80d119d 100644
--- 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 391d1e3..5e04895 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;
-
<<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 ccebb8a..cf904eb 100644
--- 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
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
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
index 0000000..bb1db2c1
--- /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 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
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;