[Ada] Exclude private protected type defined in the runtime for restrictions

Arnaud Charlet charlet@adacore.com
Thu Jun 16 09:44:00 GMT 2016

This is preliminary work to allow an implementation change in the runtime.
Does not affect users.

Tested on x86_64-pc-linux-gnu, committed on trunk

2016-06-16  Tristan Gingold  <gingold@adacore.com>

	* einfo.ads (Has_Protected): Clarify comment.
	* sem_ch9.adb (Analyze_Protected_Type_Declaration): Do not
	consider private protected types declared in the runtime for
	the No_Local_Protected_Types restriction.

-------------- next part --------------
Index: sem_ch9.adb
--- sem_ch9.adb	(revision 237439)
+++ sem_ch9.adb	(working copy)
@@ -32,8 +32,10 @@
 with Errout;    use Errout;
 with Exp_Ch9;   use Exp_Ch9;
 with Elists;    use Elists;
+with Fname;     use Fname;
 with Freeze;    use Freeze;
 with Layout;    use Layout;
+with Lib;       use Lib;
 with Lib.Xref;  use Lib.Xref;
 with Namet;     use Namet;
 with Nlists;    use Nlists;
@@ -1985,12 +1987,27 @@
       Set_Ekind              (T, E_Protected_Type);
       Set_Is_First_Subtype   (T, True);
-      Set_Has_Protected      (T, True);
       Init_Size_Align        (T);
       Set_Etype              (T, T);
       Set_Has_Delayed_Freeze (T, True);
       Set_Stored_Constraint  (T, No_Elist);
+      --  Mark this type as a protected type for the sake of restrictions,
+      --  unless the protected type is declared in a private part of a package
+      --  of the runtime. With this exception, the Suspension_Object from
+      --  Ada.Synchronous_Task_Control can be implemented using a protected
+      --  without triggering violations of No_Local_Protected_Objects when the
+      --  user locally declares such an object. This may look like a trick but
+      --  the user doesn't have to know how Suspension_Object is implemented.
+      if In_Private_Part (Current_Scope)
+        and then Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
+      then
+         Set_Has_Protected   (T, False);
+      else
+         Set_Has_Protected   (T, True);
+      end if;
       --  Set the SPARK_Mode from the current context (may be overwritten later
       --  with an explicit pragma).
Index: einfo.ads
--- einfo.ads	(revision 237436)
+++ einfo.ads	(working copy)
@@ -1936,10 +1936,10 @@
 --    Has_Protected (Flag271) [base type only]
 --       Defined in all type entities. Set on protected types themselves, and
 --       also (recursively) on any composite type which has a component for
---       which Has_Protected is set. The meaning is that an allocator for
---       or declaration of such an object must create the required protected
---       objects. Note: the flag is not set on access types, even if they
---       designate an object that Has_Protected.
+--       which Has_Protected is set, unless the protected type is declared in
+--       the private part of an internal unit. The meaning is that restrictions
+--       for protected types apply to this type. Note: the flag is not set on
+--       access types, even if they designate an object that Has_Protected.
 --    Has_Qualified_Name (Flag161)
 --       Defined in all entities. Set if the name in the Chars field has

More information about the Gcc-patches mailing list