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 <ging...@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.
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
