From 5b17c2c6cbc34056ae878beed2351bf77a8f57a0 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Wed, 16 Nov 2022 09:28:22 -0800 Subject: [PATCH] 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. --- 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 24476194337a..35afb95347be 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 4c50e61617da..c30c63531541 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 d3a84e3471ab..bf2cf81a525d 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 d62572ef54b5..e707c04eaabd 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 f9169eeedd7d..81b094227928 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; -- 2.47.2