[gcc r12-10087] Fix nternal compiler error for Sequential Partition_Elaboration_Policy
Eric Botcazou
ebotcazou@gcc.gnu.org
Tue Jan 9 12:27:10 GMT 2024
https://gcc.gnu.org/g:5b17c2c6cbc34056ae878beed2351bf77a8f57a0
commit r12-10087-g5b17c2c6cbc34056ae878beed2351bf77a8f57a0
Author: Steve Baird <baird@adacore.com>
Date: Wed Nov 16 09:28:22 2022 -0800
Fix nternal compiler error for Sequential Partition_Elaboration_Policy
In some cases, compilation of a function with a limited class-wide result
type could fail with an ICE if a Sequential Partition_Elaboration_Policy is
specified. To prevent this, we really want that specifying a Sequential
Partition_Elaboration_Policy to have the side effect of imposing a
No_Task_Hierarchy restriction. But doing that in a straightforward
way leads to problems with incorrectly accepting violations of H.6(6).
So a new restriction, No_Task_Hierarchy_Implicit, is introduced.
gcc/ada/
PR ada/104354
* libgnat/s-rident.ads: Define a new restriction,
No_Task_Hierarchy_Implicit. This is like the No_Task_Hierarchy
restriction, but with the difference that setting this restriction
does not mean the H.6(6) post-compilation check is satisified.
* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): If it is
known that the function result cannot have tasks, then pass in a
null literal for the activation chain actual parameter. This
avoids generating a reference to an entity that
Build_Activation_Chain_Entity may have chosen not to generate a
declaration for.
* gnatbind.adb (List_Applicable_Restrictions): Do not list the
No_Task_Hierarchy_Implicit restriction.
* restrict.adb: Special treatment for the
No_Task_Hierarchy_Implicit restriction in functions
Get_Restriction_Id and Restriction_Active. The former is needed to
disallow the (unlikely) case that a user tries to explicitly
reference the No_Task_Hierarchy_Implicit restriction.
* sem_prag.adb (Analyze_Pragma): If a Sequential
Partition_Elaboration_Policy is specified (and the
No_Task_Hierarchy restriction is not already enabled), then enable
the No_Task_Hierarchy_Implicit restriction.
Diff:
---
gcc/ada/exp_ch6.adb | 5 ++++-
gcc/ada/gnatbind.adb | 3 +++
gcc/ada/libgnat/s-rident.ads | 7 ++++---
gcc/ada/restrict.adb | 12 ++++++++++--
gcc/ada/sem_prag.adb | 19 +++++++++++++++++++
5 files changed, 40 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 24476194337..35afb95347b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -630,7 +630,10 @@ package body Exp_Ch6 is
-- Create the actual which is a pointer to the current activation chain
- if No (Chain) then
+ if Restriction_Active (No_Task_Hierarchy) then
+ Chain_Actual := Make_Null (Loc);
+
+ elsif No (Chain) then
Chain_Actual :=
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_uChain),
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 4c50e61617d..c30c6353154 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -214,6 +214,9 @@ procedure Gnatbind is
No_Specification_Of_Aspect => False,
-- Requires a parameter value, not a count
+ No_Task_Hierarchy_Implicit => False,
+ -- A compiler implementation artifact, not a documented restriction
+
No_Use_Of_Attribute => False,
-- Requires a parameter value, not a count
diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads
index d3a84e3471a..bf2cf81a525 100644
--- a/gcc/ada/libgnat/s-rident.ads
+++ b/gcc/ada/libgnat/s-rident.ads
@@ -106,7 +106,7 @@ package System.Rident is
No_Dispatching_Calls, -- GNAT
No_Dynamic_Accessibility_Checks, -- GNAT
No_Dynamic_Attachment, -- Ada 2012 (RM E.7(10/3))
- No_Dynamic_CPU_Assignment, -- Ada 202x (RM D.7(10/3))
+ No_Dynamic_CPU_Assignment, -- Ada 2022 (RM D.7(10/3))
No_Dynamic_Priorities, -- (RM D.9(9))
No_Enumeration_Maps, -- GNAT
No_Entry_Calls_In_Elaboration_Code, -- GNAT
@@ -150,8 +150,9 @@ package System.Rident is
No_Task_Attributes_Package, -- GNAT
No_Task_At_Interrupt_Priority, -- GNAT
No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
- No_Task_Termination, -- GNAT (Ravenscar)
- No_Tasks_Unassigned_To_CPU, -- Ada 202x (D.7(10.10/4))
+ No_Task_Hierarchy_Implicit, -- GNAT
+ No_Task_Termination, -- Ada 2005 (D.7(15.1/2))
+ No_Tasks_Unassigned_To_CPU, -- Ada 2022 (D.7(10.10/4))
No_Tasking, -- GNAT
No_Terminate_Alternatives, -- (RM D.7(6))
No_Unchecked_Access, -- (RM H.4(18))
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index d62572ef54b..e707c04eaab 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -886,7 +886,10 @@ package body Restrict is
declare
S : constant String := Restriction_Id'Image (J);
begin
- if S = Name_Buffer (1 .. Name_Len) then
+ if S = Name_Buffer (1 .. Name_Len)
+ -- users cannot name the N_T_H_Implicit restriction
+ and then J /= No_Task_Hierarchy_Implicit
+ then
return J;
end if;
end;
@@ -1093,7 +1096,12 @@ package body Restrict is
function Restriction_Active (R : All_Restrictions) return Boolean is
begin
- return Restrictions.Set (R) and then not Restriction_Warnings (R);
+ if Restrictions.Set (R) and then not Restriction_Warnings (R) then
+ return True;
+ else
+ return R = No_Task_Hierarchy
+ and then Restriction_Active (No_Task_Hierarchy_Implicit);
+ end if;
end Restriction_Active;
--------------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f9169eeedd7..81b09422792 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -21102,6 +21102,25 @@ package body Sem_Prag is
if Partition_Elaboration_Policy_Sloc /= System_Location then
Partition_Elaboration_Policy_Sloc := Loc;
end if;
+
+ if PEP_Val = Name_Sequential
+ and then not Restriction_Active (No_Task_Hierarchy)
+ then
+ -- RM H.6(6) guarantees that No_Task_Hierarchy will be
+ -- set eventually, so take advantage of that knowledge now.
+ -- But we have to do this in a tricky way. If we simply
+ -- set the No_Task_Hierarchy restriction here, then the
+ -- assumption that the restriction will be set eventually
+ -- becomes a self-fulfilling prophecy; the binder can
+ -- then mistakenly conclude that the H.6(6) rule is
+ -- satisified in cases where the post-compilation check
+ -- should fail. So we invent a new restriction,
+ -- No_Task_Hierarchy_Implicit, which is treated specially
+ -- in the function Restriction_Active.
+
+ Set_Restriction (No_Task_Hierarchy_Implicit, N);
+ pragma Assert (Restriction_Active (No_Task_Hierarchy));
+ end if;
end if;
end PEP;
More information about the Gcc-cvs
mailing list