diff options
-rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 11 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 117 | ||||
-rw-r--r-- | gcc/ada/g-comlin.adb | 1 | ||||
-rw-r--r-- | gcc/ada/lib-writ.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 68 |
7 files changed, 96 insertions, 112 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0e241e9..b406325 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2014-06-13 Robert Dewar <dewar@adacore.com> + + * exp_attr.adb, exp_ch9.adb, lib-writ.adb, g-comlin.adb: Minor + reformatting. + * sem_attr.adb: Minor code reformatting and simplification. + * checks.adb: Fix minor typo. + 2014-06-13 Emmanuel Briot <briot@adacore.com> * g-comlin.adb (Get_Argument): fix expansion diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 7ec8599..315b076 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -762,7 +762,7 @@ package body Checks is Analyze (First (Actions (N)), Suppress => All_Checks); -- If the address clause generates an alignment check and we are - -- in ZPF or some restricted run-time, add a warning to explain + -- in ZFP or some restricted run-time, add a warning to explain -- the propagation warning that is generated by the check. if Nkind (First (Actions (N))) = N_Raise_Program_Error diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b16e95d..daa6b16 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3976,9 +3976,7 @@ package body Exp_Attr is -- 'Old appears will be checked or disabled according to the -- current policy in effect. - if Nkind (Subp) = N_Pragma - and then not Is_Checked (Subp) - then + if Nkind (Subp) = N_Pragma and then not Is_Checked (Subp) then return; end if; @@ -4183,10 +4181,9 @@ package body Exp_Attr is Analyze (N); return; - -- For elementary types, we call the W_xxx routine directly. - -- Note that the effect of Write and Output is identical for - -- the case of an elementary type, since there are no - -- discriminants or bounds. + -- For elementary types, we call the W_xxx routine directly. Note + -- that the effect of Write and Output is identical for the case + -- of an elementary type (there are no discriminants or bounds). elsif Is_Elementary_Type (U_Type) then diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index f5c6f57..e1a4d0f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -291,10 +291,10 @@ package body Exp_Ch9 is (N : Node_Id; Pid : Node_Id) return Node_Id; -- This routine constructs the unprotected version of a protected - -- subprogram body, which is contains all of the code in the - -- original, unexpanded body. This is the version of the protected - -- subprogram that is called from all protected operations on the same - -- object, including the protected version of the same subprogram. + -- subprogram body, which is contains all of the code in the original, + -- unexpanded body. This is the version of the protected subprogram that is + -- called from all protected operations on the same object, including the + -- protected version of the same subprogram. procedure Build_Wrapper_Bodies (Loc : Source_Ptr; @@ -532,7 +532,7 @@ package body Exp_Ch9 is else B := Make_Selected_Component (Sloc, - Prefix => New_Copy_Tree (Tsk), + Prefix => New_Copy_Tree (Tsk), Selector_Name => New_Occurrence_Of (Entity (Bound), Sloc)); Analyze_And_Resolve (B, Typ); @@ -541,8 +541,8 @@ package body Exp_Ch9 is return Make_Attribute_Reference (Sloc, Attribute_Name => Name_Pos, - Prefix => New_Occurrence_Of (Etype (Bound), Sloc), - Expressions => New_List (B)); + Prefix => New_Occurrence_Of (Etype (Bound), Sloc), + Expressions => New_List (B)); end Actual_Discriminant_Ref; -- Start of processing for Actual_Family_Offset @@ -592,7 +592,6 @@ package body Exp_Ch9 is -- Now add lengths of preceding entries and entry families Prev := First_Entity (Ttyp); - while Chars (Prev) /= Chars (Ent) or else (Ekind (Prev) /= Ekind (Ent)) or else not Sem_Ch6.Type_Conformant (Ent, Prev) @@ -659,7 +658,7 @@ package body Exp_Ch9 is Left_Opnd => Expr, Right_Opnd => Make_Op_Add (Sloc, - Left_Opnd => + Left_Opnd => Actual_Family_Offset (Hi, Lo), Right_Opnd => Make_Integer_Literal (Sloc, 1))); @@ -769,11 +768,9 @@ package body Exp_Ch9 is Decl := Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uObject), - Object_Definition => - New_Occurrence_Of (Obj_Ptr, Loc), - Expression => + Defining_Identifier => Make_Defining_Identifier (Loc, Name_uObject), + Object_Definition => New_Occurrence_Of (Obj_Ptr, Loc), + Expression => Unchecked_Convert_To (Obj_Ptr, Make_Identifier (Loc, Name_uO))); Set_Debug_Info_Needed (Defining_Identifier (Decl)); Prepend_To (Decls, Decl); @@ -863,19 +860,20 @@ package body Exp_Ch9 is Statements => New_List ( Make_Procedure_Call_Statement (Sloc (Stats), - Name => New_Occurrence_Of ( + Name => New_Occurrence_Of ( RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)), Parameter_Associations => New_List ( Make_Function_Call (Sloc (Stats), - Name => New_Occurrence_Of ( - RTE (RE_Get_GNAT_Exception), Sloc (Stats))))))))); + Name => + New_Occurrence_Of + (RTE (RE_Get_GNAT_Exception), Sloc (Stats))))))))); Set_Parent (New_S, Astat); -- temp parent for Analyze call Analyze_Exception_Handlers (Exception_Handlers (New_S)); Expand_Exception_Handlers (New_S); - -- Exceptional_Complete_Rendezvous must be called with abort - -- still deferred, which is the case for a "when all others" handler. + -- Exceptional_Complete_Rendezvous must be called with abort still + -- deferred, which is the case for a "when all others" handler. return New_S; end Build_Accept_Body; @@ -886,8 +884,7 @@ package body Exp_Ch9 is procedure Build_Activation_Chain_Entity (N : Node_Id) is function Has_Activation_Chain (Stmt : Node_Id) return Boolean; - -- Determine whether an extended return statement has an activation - -- chain. + -- Determine whether an extended return statement has activation chain -------------------------- -- Has_Activation_Chain -- @@ -1068,22 +1065,21 @@ package body Exp_Ch9 is Set_Debug_Info_Needed (Def_Id); return Make_Function_Specification (Loc, - Defining_Unit_Name => Def_Id, + Defining_Unit_Name => Def_Id, Parameter_Specifications => New_List ( Make_Parameter_Specification (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO), - Parameter_Type => + Parameter_Type => New_Occurrence_Of (RTE (RE_Address), Loc)), Make_Parameter_Specification (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uE), - Parameter_Type => + Parameter_Type => New_Occurrence_Of (RTE (RE_Protected_Entry_Index), Loc))), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)); + Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc)); end Build_Barrier_Function_Specification; -------------------------- @@ -1098,7 +1094,7 @@ package body Exp_Ch9 is begin return Make_Function_Call (Loc, - Name => New_Occurrence_Of (E, Loc), + Name => New_Occurrence_Of (E, Loc), Parameter_Associations => New_List (Concurrent_Ref (N))); end Build_Call_With_Task; @@ -1121,7 +1117,7 @@ package body Exp_Ch9 is return; end if; - -- Find the declaration that created the access type. It is either a + -- Find the declaration that created the access type, which is either a -- type declaration, or an object declaration with an access definition, -- in which case the type is anonymous. @@ -13785,7 +13781,8 @@ package body Exp_Ch9 is Append_To (L, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (Called_Subp), Loc), + Name => + New_Occurrence_Of (RTE (Called_Subp), Loc), Parameter_Associations => Args)); end; end if; @@ -13846,10 +13843,13 @@ package body Exp_Ch9 is Unchecked_Convert_To (RTE (RE_System_Interrupt_Id), Expr), Make_Attribute_Reference (Loc, - Prefix => Make_Selected_Component (Loc, - Make_Identifier (Loc, Name_uInit), - Duplicate_Subexpr_No_Checks - (Expression (Handler))), + Prefix => + Make_Selected_Component (Loc, + Prefix => + Make_Identifier (Loc, Name_uInit), + Selector_Name => + Duplicate_Subexpr_No_Checks + (Expression (Handler))), Attribute_Name => Name_Access)))); end; end if; @@ -13873,16 +13873,17 @@ package body Exp_Ch9 is Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of - (RTE (RE_Install_Restricted_Handlers), Loc), + (RTE (RE_Install_Restricted_Handlers), Loc), Parameter_Associations => Args)); else if not Uses_Lock_Free (Defining_Identifier (Pdec)) then + -- First, prepends the _object argument Prepend_To (Args, Make_Attribute_Reference (Loc, - Prefix => + Prefix => Make_Selected_Component (Loc, Prefix => Make_Identifier (Loc, Name_uInit), Selector_Name => @@ -13894,7 +13895,8 @@ package body Exp_Ch9 is Append_To (L, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Install_Handlers), Loc), + Name => + New_Occurrence_Of (RTE (RE_Install_Handlers), Loc), Parameter_Associations => Args)); end if; end; @@ -14048,8 +14050,7 @@ package body Exp_Ch9 is then Append_To (Args, Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_uInit), + Prefix => Make_Identifier (Loc, Name_uInit), Selector_Name => Make_Identifier (Loc, Name_uRelative_Deadline))); @@ -14150,8 +14151,7 @@ package body Exp_Ch9 is Subtype_Mark => New_Occurrence_Of (Subp_Ptr_Typ, Loc), Expression => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Body_Proc, Loc), + Prefix => New_Occurrence_Of (Body_Proc, Loc), Attribute_Name => Name_Unrestricted_Access)))); -- For the .NET/JVM cases revert to the original code below ??? @@ -14160,8 +14160,7 @@ package body Exp_Ch9 is Append_To (Args, Unchecked_Convert_To (RTE (RE_Task_Procedure_Access), Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Body_Proc, Loc), + Prefix => New_Occurrence_Of (Body_Proc, Loc), Attribute_Name => Name_Address))); end if; end; @@ -14235,7 +14234,7 @@ package body Exp_Ch9 is return Make_Procedure_Call_Statement (Loc, - Name => Name, + Name => Name, Parameter_Associations => Args); end Make_Task_Create_Call; @@ -14306,7 +14305,6 @@ package body Exp_Ch9 is Actual := First (Actuals); Formal := Defining_Identifier (First (Formals)); Params := New_List; - while Present (Actual) loop if Is_By_Copy_Type (Etype (Actual)) then -- Generate: @@ -14316,11 +14314,9 @@ package body Exp_Ch9 is Append_To (Decls, Make_Object_Declaration (Loc, - Aliased_Present => - True, - Defining_Identifier => - Temp_Nam, - Object_Definition => + Aliased_Present => True, + Defining_Identifier => Temp_Nam, + Object_Definition => New_Occurrence_Of (Etype (Formal), Loc))); if Ekind (Formal) /= E_Out_Parameter then @@ -14335,10 +14331,8 @@ package body Exp_Ch9 is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - Temp_Asn, - Expression => - New_Copy_Tree (Actual))); + Name => Temp_Asn, + Expression => New_Copy_Tree (Actual))); end if; -- Generate: @@ -14346,10 +14340,8 @@ package body Exp_Ch9 is Append_To (Params, Make_Attribute_Reference (Loc, - Attribute_Name => - Name_Unchecked_Access, - Prefix => - New_Occurrence_Of (Temp_Nam, Loc))); + Attribute_Name => Name_Unchecked_Access, + Prefix => New_Occurrence_Of (Temp_Nam, Loc))); Has_Param := True; @@ -14382,12 +14374,9 @@ package body Exp_Ch9 is Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - P, - Object_Definition => - New_Occurrence_Of (Blk_Typ, Loc), - Expression => - Expr)); + Defining_Identifier => P, + Object_Definition => New_Occurrence_Of (Blk_Typ, Loc), + Expression => Expr)); return P; end Parameter_Block_Pack; @@ -14420,7 +14409,7 @@ package body Exp_Ch9 is Asnmt := Make_Assignment_Statement (Loc, - Name => + Name => New_Copy (Actual), Expression => Make_Explicit_Dereference (Loc, diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 4a7c85b..4359294 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -402,6 +402,7 @@ package body GNAT.Command_Line is end if; if Parser.Current_Argument > Parser.Arg_Count then + -- If this is the first time this function is called if Parser.Current_Index = 1 then diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index f030c51..cdddcf3 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1445,7 +1445,7 @@ package body Lib.Writ is Write_Info_Str (Name_Buffer (1 .. Name_Len - 2)); end if; - -- If Source_Reference pragma used output information + -- If Source_Reference pragma used, output information if Num_SRef_Pragmas (Sind) > 0 then Write_Info_Char (' '); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index fa66799..ebbbdc4 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2409,12 +2409,6 @@ package body Sem_Attr is end if; end if; - -- Ada 2005 (AI-345): Ensure that the compiler gives exactly the current - -- output compiling in Ada 95 mode for the case of ambiguous prefixes. - - -- Is this comment right??? What is "the current output"??? If this - -- is only about Ada 95 mode, why no test for Ada 95 at this point??? - if Is_Overloaded (P) and then Aname /= Name_Access and then Aname /= Name_Address @@ -2422,7 +2416,7 @@ package body Sem_Attr is and then Aname /= Name_Result and then Aname /= Name_Unchecked_Access then - -- The prefix must be resolvble by itself, without reference to the + -- The prefix must be resolvable by itself, without reference to the -- attribute. One case that requires special handling is a prefix -- that is a function name, where one interpretation may be a -- parameterless call. Entry attributes are handled specially below. @@ -2433,44 +2427,40 @@ package body Sem_Attr is Check_Parameterless_Call (P); end if; - if Ada_Version < Ada_2005 then - if Is_Overloaded (P) then - - -- Ada 2005 (AI-345): Since protected and task types have - -- primitive entry wrappers, the attributes Count, Caller and - -- AST_Entry require a context check + if Is_Overloaded (P) then - if Nam_In (Aname, Name_Count, Name_Caller, Name_AST_Entry) then - declare - Count : Natural := 0; - I : Interp_Index; - It : Interp; + -- Ada 2005 (AI-345): Since protected and task types have + -- primitive entry wrappers, the attributes Count, Caller and + -- AST_Entry require a context check - begin - Get_First_Interp (P, I, It); - while Present (It.Nam) loop - if Comes_From_Source (It.Nam) then - Count := Count + 1; - else - Remove_Interp (I); - end if; - - Get_Next_Interp (I, It); - end loop; + if Nam_In (Aname, Name_Count, Name_Caller, Name_AST_Entry) then + declare + Count : Natural := 0; + I : Interp_Index; + It : Interp; - if Count > 1 then - Error_Attr ("ambiguous prefix for % attribute", P); + begin + Get_First_Interp (P, I, It); + while Present (It.Nam) loop + if Comes_From_Source (It.Nam) then + Count := Count + 1; else - Set_Is_Overloaded (P, False); + Remove_Interp (I); end if; - end; - else - Error_Attr ("ambiguous prefix for % attribute", P); - end if; - end if; - elsif Is_Overloaded (P) then - Error_Attr ("ambiguous prefix for % attribute", P); + Get_Next_Interp (I, It); + end loop; + + if Count > 1 then + Error_Attr ("ambiguous prefix for % attribute", P); + else + Set_Is_Overloaded (P, False); + end if; + end; + + else + Error_Attr ("ambiguous prefix for % attribute", P); + end if; end if; end if; |