diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 32 |
5 files changed, 33 insertions, 29 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d402de49e2e..e5539734efc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2011-09-02 Robert Dewar <dewar@adacore.com> + + * exp_util.adb, exp_ch9.adb, sem_attr.adb, sem_ch6.adb: Minor + reformatting. + 2011-09-02 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch9.adb (Install_Private_Data_Declarations): Add guards diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index babda09a470..ad7f6b1d06c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -12481,11 +12481,11 @@ package body Exp_Ch9 is or else Has_Interfaces (Protect_Rec) or else ((Has_Attach_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp)) - and then not Restriction_Active (No_Dynamic_Attachment)) + and then not Restriction_Active (No_Dynamic_Attachment)) then declare - Pkg_Id : constant RTU_Id := - Corresponding_Runtime_Package (Ptyp); + Pkg_Id : constant RTU_Id := Corresponding_Runtime_Package (Ptyp); + Called_Subp : RE_Id; begin @@ -12536,8 +12536,7 @@ package body Exp_Ch9 is Append_To (Args, Make_Attribute_Reference (Loc, - Prefix => - New_Reference_To (P_Arr, Loc), + Prefix => New_Reference_To (P_Arr, Loc), Attribute_Name => Name_Unrestricted_Access)); -- Build_Entry_Names generation flag. When set to true, the diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index dd1432dc327..f3d4c9a2346 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1526,14 +1526,14 @@ package body Exp_Util is or else Present (Interface_List (Parent (Typ))) or else (((Has_Attach_Handler (Typ) and then not Restricted_Profile) - or else Has_Interrupt_Handler (Typ)) + or else Has_Interrupt_Handler (Typ)) and then not Restriction_Active (No_Dynamic_Attachment)) then if Abort_Allowed or else Restriction_Active (No_Entry_Queue) = False or else Number_Entries (Typ) > 1 or else (Has_Attach_Handler (Typ) - and then not Restricted_Profile) + and then not Restricted_Profile) then Pkg_Id := System_Tasking_Protected_Objects_Entries; else @@ -1560,10 +1560,8 @@ package body Exp_Util is if Act_ST = Etype (Exp) then return; - else - Rewrite (Exp, - Convert_To (Act_ST, Relocate_Node (Exp))); + Rewrite (Exp, Convert_To (Act_ST, Relocate_Node (Exp))); Analyze_And_Resolve (Exp, Act_ST); end if; end Convert_To_Actual_Subtype; @@ -1644,7 +1642,6 @@ package body Exp_Util is Name_Req : Boolean := False) return Node_Id is New_Exp : Node_Id; - begin Remove_Side_Effects (Exp, Name_Req); New_Exp := New_Copy_Tree (Exp); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 5efa6896370..789cb4763d4 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4939,12 +4939,15 @@ package body Sem_Attr is -- all scope checks and checks for aliased views are omitted. when Attribute_Unrestricted_Access => + + -- If from source, deal with relevant restrictions + if Comes_From_Source (N) then Check_Restriction (No_Unchecked_Access, N); if Nkind (P) in N_Has_Entity - and then Present (Entity (P)) - and then Is_Object (Entity (P)) + and then Present (Entity (P)) + and then Is_Object (Entity (P)) then Check_Restriction (No_Implicit_Aliasing, N); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 648cdcb2e50..9133046523b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5462,23 +5462,25 @@ package body Sem_Ch6 is -- Inherited : constant Subprogram_List := -- Inherited_Subprograms (Spec_Id); - -- List of subprograms inherited by this subprogram +-- -- List of subprograms inherited by this subprogram + -- Code is currently commented out as, in some cases, it causes crashes + -- because Direct_Primitive_Operations is not available for a private + -- type??? - Last_Postcondition : Node_Id := Empty; + Last_Postcondition : Node_Id := Empty; -- Last postcondition on the subprogram, or else Empty if either no -- postcondition or only inherited postconditions. Attribute_Result_Mentioned : Boolean := False; -- Whether attribute 'Result is mentioned in a postcondition - Post_State_Mentioned : Boolean := False; + Post_State_Mentioned : Boolean := False; -- Whether some expression mentioned in a postcondition can have a -- different value in the post-state than in the pre-state. function Check_Attr_Result (N : Node_Id) return Traverse_Result; - -- Check whether N is a reference to the attribute 'Result, and if so - -- set Attribute_Result_Mentioned and return Abandon. Otherwise return - -- OK. + -- Check if N is a reference to the attribute 'Result, and if so set + -- Attribute_Result_Mentioned and return Abandon. Otherwise return OK. function Check_Post_State (N : Node_Id) return Traverse_Result; -- Check whether the value of evaluating N can be different in the @@ -5487,9 +5489,7 @@ package body Sem_Ch6 is -- reference to attribute 'Old, in order to ignore its prefix, which -- is precisely evaluated in the pre-state. Otherwise return OK. - procedure Process_Post_Conditions - (Spec : Node_Id; - Class : Boolean); + procedure Process_Post_Conditions (Spec : Node_Id; Class : Boolean); -- This processes the Spec_PPC_List from Spec, processing any -- postconditions from the list. If Class is True, then only -- postconditions marked with Class_Present are considered. The @@ -5506,8 +5506,7 @@ package body Sem_Ch6 is function Check_Attr_Result (N : Node_Id) return Traverse_Result is begin if Nkind (N) = N_Attribute_Reference - and then - Get_Attribute_Id (Attribute_Name (N)) = Attribute_Result + and then Get_Attribute_Id (Attribute_Name (N)) = Attribute_Result then Attribute_Result_Mentioned := True; return Abandon; @@ -5531,6 +5530,7 @@ package body Sem_Ch6 is when N_Identifier | N_Expanded_Name => + declare E : constant Entity_Id := Entity (N); begin @@ -5583,7 +5583,7 @@ package body Sem_Ch6 is loop Arg := First (Pragma_Argument_Associations (Prag)); - -- Since pre- and postconditions are listed in reverse order, the + -- Since pre- and post-conditions are listed in reverse order, the -- first postcondition in the list is the last in the source. if Pragma_Name (Prag) = Name_Postcondition @@ -5607,7 +5607,7 @@ package body Sem_Ch6 is and then not Class then Post_State_Mentioned := False; - Ignored := Find_Post_State (Arg); + Ignored := Find_Post_State (Arg); if not Post_State_Mentioned then Error_Msg_N ("?postcondition only refers to pre-state", @@ -5635,7 +5635,7 @@ package body Sem_Ch6 is -- Code is currently commented out as, in some cases, it causes crashes -- because Direct_Primitive_Operations is not available for a private - -- type. This may cause more warnings to be issued than necessary. + -- type. This may cause more warnings to be issued than necessary. ??? -- for J in Inherited'Range loop -- if Present (Spec_PPC_List (Contract (Inherited (J)))) then @@ -5662,8 +5662,8 @@ package body Sem_Ch6 is procedure Check_Subprogram_Order (N : Node_Id) is function Subprogram_Name_Greater (S1, S2 : String) return Boolean; - -- This is used to check if S1 > S2 in the sense required by this - -- test, for example nameab < namec, but name2 < name10. + -- This is used to check if S1 > S2 in the sense required by this test, + -- for example nameab < namec, but name2 < name10. ----------------------------- -- Subprogram_Name_Greater -- |
