This patch permits the use of type conversions and components of objects subject to the following conditions: type conversions cannot potentially raise contraint errors and access types cannot be dereferenced. These additions provide greater functionality to users while respecting the aims of the Pure_Barrier restriction: side effects, exceptions, and recursion cannot occur during the evaluation of the barriers.
In practise this patch allows users to compare the result of the Count attribute with a literal or named number, and reference components of array or record types in barriers. The following must compile quietly: --- package Test_PO is type BooT is record Far : Integer; end record; type FooT is record Bar : BooT; end record; protected PO is entry A; entry B; private Foo : FooT; end PO; end Test_PO; --- pragma Restrictions (Pure_Barriers); package body Test_PO is protected body PO is entry A when A'Count > 5 is begin null; end A; entry B when Foo.Bar.Far = 5 is begin null; end B; end PO; end Test_PO; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-08 Patrick Bernardi <berna...@adacore.com> * exp_ch9.adb (Is_Pure_Barrier): Allow type conversions and components of objects. Simplified the detection of the Count attribute by identifying the corresponding run-time calls.
Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 251863) +++ exp_ch9.adb (working copy) @@ -5999,8 +5999,9 @@ Renamed : Node_Id; begin - -- Check for case of _object.all.field (note that the explicit - -- dereference gets inserted by analyze/expand of _object.field). + -- Check if the name is a component of the protected object. If + -- the expander is active, the component has been transformed into + -- a renaming of _object.all.component. if Expander_Active then Renamed := Renamed_Object (Entity (N)); @@ -6010,7 +6011,7 @@ and then Nkind (Renamed) = N_Selected_Component and then Chars (Prefix (Prefix (Renamed))) = Name_uObject; else - return Scope (Entity (N)) = Current_Scope; + return Is_Protected_Component (Entity (N)); end if; end Is_Simple_Barrier_Name; @@ -6019,25 +6020,6 @@ --------------------- function Is_Pure_Barrier (N : Node_Id) return Traverse_Result is - function Is_Count_Attribute (N : Node_Id) return Boolean; - -- Check whether N is part of an expansion of the Count attribute. - -- Return True if N represents the expanded function call. - - ------------------------ - -- Is_Count_Attribute -- - ------------------------ - - function Is_Count_Attribute (N : Node_Id) return Boolean is - begin - return - Nkind (N) = N_Function_Call - and then Present (Original_Node (N)) - and then Nkind (Original_Node (N)) = N_Attribute_Reference - and then Attribute_Name (Original_Node (N)) = Name_Count; - end Is_Count_Attribute; - - -- Start of processing for Is_Pure_Barrier - begin case Nkind (N) is when N_Expanded_Name @@ -6045,11 +6027,8 @@ => if No (Entity (N)) then return Abandon; - end if; - if Present (Parent (N)) - and then Is_Count_Attribute (Parent (N)) - then + elsif Is_Universal_Numeric_Type (Entity (N)) then return OK; end if; @@ -6062,25 +6041,36 @@ => return OK; - when E_Component - | E_Variable - => - -- A variable in the protected type is expanded as a - -- component. + when E_Component => + return OK; + when E_Variable => if Is_Simple_Barrier_Name (N) then return OK; end if; + when E_Function => + + -- The count attribute has been transformed into run-time + -- calls. + + if Is_RTE (Entity (N), RE_Protected_Count) + or else Is_RTE (Entity (N), RE_Protected_Count_Entry) + then + return OK; + end if; + when others => null; end case; when N_Function_Call => - if Is_Count_Attribute (N) then - return OK; - end if; + -- Function call checks are carried out as part of the analysis + -- of the function call name. + + return OK; + when N_Character_Literal | N_Integer_Literal | N_Real_Literal @@ -6097,6 +6087,27 @@ when N_Short_Circuit => return OK; + when N_Indexed_Component + | N_Selected_Component + => + if not Is_Access_Type (Etype (Prefix (N))) then + return OK; + end if; + + when N_Type_Conversion => + + -- Conversions to Universal_Integer will not raise constraint + -- errors. + + if Cannot_Raise_Constraint_Error (N) + or else Etype (N) = Universal_Integer + then + return OK; + end if; + + when N_Unchecked_Type_Conversion => + return OK; + when others => null; end case;