ada: Internal 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 internal error if a Sequential
Partition_Elaboration_Policy is specified. To prevent this, we want 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/

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

1 files changed, 10 insertions, 2 deletions

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 9ef923b..9965321 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -897,7 +897,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;
@@ -1104,7 +1107,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;
 
    --------------------------------