git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

exp_attr.adb, [...]: Minor reformatting. 

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.

From-SVN: r211622
This commit is contained in:
Robert Dewar 2014-06-13 10:11:54 +00:00 committed by Arnaud Charlet
parent 4de100256a
commit 890f1954ed
7 changed files with 96 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -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> 2014-06-13 Emmanuel Briot <briot@adacore.com>
* g-comlin.adb (Get_Argument): fix expansion * g-comlin.adb (Get_Argument): fix expansion

2
gcc/ada/checks.adb
View File

@ -762,7 +762,7 @@ package body Checks is
Analyze (First (Actions (N)), Suppress => All_Checks); Analyze (First (Actions (N)), Suppress => All_Checks);
-- If the address clause generates an alignment check and we are -- 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. -- the propagation warning that is generated by the check.
if Nkind (First (Actions (N))) = N_Raise_Program_Error if Nkind (First (Actions (N))) = N_Raise_Program_Error

11
gcc/ada/exp_attr.adb
View File

@ -3976,9 +3976,7 @@ package body Exp_Attr is
-- 'Old appears will be checked or disabled according to the -- 'Old appears will be checked or disabled according to the
-- current policy in effect. -- current policy in effect.
if Nkind (Subp) = N_Pragma if Nkind (Subp) = N_Pragma and then not Is_Checked (Subp) then
and then not Is_Checked (Subp)
then
return; return;
end if; end if;
@ -4183,10 +4181,9 @@ package body Exp_Attr is
Analyze (N); Analyze (N);
return; return;
-- For elementary types, we call the W_xxx routine directly. -- For elementary types, we call the W_xxx routine directly. Note
-- Note that the effect of Write and Output is identical for -- that the effect of Write and Output is identical for the case
-- the case of an elementary type, since there are no -- of an elementary type (there are no discriminants or bounds).
-- discriminants or bounds.
elsif Is_Elementary_Type (U_Type) then elsif Is_Elementary_Type (U_Type) then

117
gcc/ada/exp_ch9.adb
View File

@ -291,10 +291,10 @@ package body Exp_Ch9 is
(N : Node_Id; (N : Node_Id;
Pid : Node_Id) return Node_Id; Pid : Node_Id) return Node_Id;
-- This routine constructs the unprotected version of a protected -- This routine constructs the unprotected version of a protected
-- subprogram body, which is contains all of the code in the -- subprogram body, which is contains all of the code in the original,
-- original, unexpanded body. This is the version of the protected -- unexpanded body. This is the version of the protected subprogram that is
-- subprogram that is called from all protected operations on the same -- called from all protected operations on the same object, including the
-- object, including the protected version of the same subprogram. -- protected version of the same subprogram.
procedure Build_Wrapper_Bodies procedure Build_Wrapper_Bodies
(Loc : Source_Ptr; (Loc : Source_Ptr;
@ -532,7 +532,7 @@ package body Exp_Ch9 is
else else
B := B :=
Make_Selected_Component (Sloc, Make_Selected_Component (Sloc,
Prefix => New_Copy_Tree (Tsk), Prefix => New_Copy_Tree (Tsk),
Selector_Name => New_Occurrence_Of (Entity (Bound), Sloc)); Selector_Name => New_Occurrence_Of (Entity (Bound), Sloc));
Analyze_And_Resolve (B, Typ); Analyze_And_Resolve (B, Typ);
@ -541,8 +541,8 @@ package body Exp_Ch9 is
return return
Make_Attribute_Reference (Sloc, Make_Attribute_Reference (Sloc,
Attribute_Name => Name_Pos, Attribute_Name => Name_Pos,
Prefix => New_Occurrence_Of (Etype (Bound), Sloc), Prefix => New_Occurrence_Of (Etype (Bound), Sloc),
Expressions => New_List (B)); Expressions => New_List (B));
end Actual_Discriminant_Ref; end Actual_Discriminant_Ref;
-- Start of processing for Actual_Family_Offset -- 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 -- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp); Prev := First_Entity (Ttyp);
while Chars (Prev) /= Chars (Ent) while Chars (Prev) /= Chars (Ent)
or else (Ekind (Prev) /= Ekind (Ent)) or else (Ekind (Prev) /= Ekind (Ent))
or else not Sem_Ch6.Type_Conformant (Ent, Prev) or else not Sem_Ch6.Type_Conformant (Ent, Prev)
@ -659,7 +658,7 @@ package body Exp_Ch9 is
Left_Opnd => Expr, Left_Opnd => Expr,
Right_Opnd => Right_Opnd =>
Make_Op_Add (Sloc, Make_Op_Add (Sloc,
Left_Opnd => Left_Opnd =>
Actual_Family_Offset (Hi, Lo), Actual_Family_Offset (Hi, Lo),
Right_Opnd => Right_Opnd =>
Make_Integer_Literal (Sloc, 1))); Make_Integer_Literal (Sloc, 1)));
@ -769,11 +768,9 @@ package body Exp_Ch9 is
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Defining_Identifier => Make_Defining_Identifier (Loc, Name_uObject),
Make_Defining_Identifier (Loc, Name_uObject), Object_Definition => New_Occurrence_Of (Obj_Ptr, Loc),
Object_Definition => Expression =>
New_Occurrence_Of (Obj_Ptr, Loc),
Expression =>
Unchecked_Convert_To (Obj_Ptr, Make_Identifier (Loc, Name_uO))); Unchecked_Convert_To (Obj_Ptr, Make_Identifier (Loc, Name_uO)));
Set_Debug_Info_Needed (Defining_Identifier (Decl)); Set_Debug_Info_Needed (Defining_Identifier (Decl));
Prepend_To (Decls, Decl); Prepend_To (Decls, Decl);
@ -863,19 +860,20 @@ package body Exp_Ch9 is
Statements => New_List ( Statements => New_List (
Make_Procedure_Call_Statement (Sloc (Stats), Make_Procedure_Call_Statement (Sloc (Stats),
Name => New_Occurrence_Of ( Name => New_Occurrence_Of (
RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)), RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Make_Function_Call (Sloc (Stats), Make_Function_Call (Sloc (Stats),
Name => New_Occurrence_Of ( Name =>
RTE (RE_Get_GNAT_Exception), Sloc (Stats))))))))); New_Occurrence_Of
(RTE (RE_Get_GNAT_Exception), Sloc (Stats)))))))));
Set_Parent (New_S, Astat); -- temp parent for Analyze call Set_Parent (New_S, Astat); -- temp parent for Analyze call
Analyze_Exception_Handlers (Exception_Handlers (New_S)); Analyze_Exception_Handlers (Exception_Handlers (New_S));
Expand_Exception_Handlers (New_S); Expand_Exception_Handlers (New_S);
-- Exceptional_Complete_Rendezvous must be called with abort -- Exceptional_Complete_Rendezvous must be called with abort still
-- still deferred, which is the case for a "when all others" handler. -- deferred, which is the case for a "when all others" handler.
return New_S; return New_S;
end Build_Accept_Body; end Build_Accept_Body;
@ -886,8 +884,7 @@ package body Exp_Ch9 is
procedure Build_Activation_Chain_Entity (N : Node_Id) is procedure Build_Activation_Chain_Entity (N : Node_Id) is
function Has_Activation_Chain (Stmt : Node_Id) return Boolean; function Has_Activation_Chain (Stmt : Node_Id) return Boolean;
-- Determine whether an extended return statement has an activation -- Determine whether an extended return statement has activation chain
-- chain.
-------------------------- --------------------------
-- Has_Activation_Chain -- -- Has_Activation_Chain --
@ -1068,22 +1065,21 @@ package body Exp_Ch9 is
Set_Debug_Info_Needed (Def_Id); Set_Debug_Info_Needed (Def_Id);
return Make_Function_Specification (Loc, return Make_Function_Specification (Loc,
Defining_Unit_Name => Def_Id, Defining_Unit_Name => Def_Id,
Parameter_Specifications => New_List ( Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uO), Make_Defining_Identifier (Loc, Name_uO),
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (RTE (RE_Address), Loc)), New_Occurrence_Of (RTE (RE_Address), Loc)),
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uE), Make_Defining_Identifier (Loc, Name_uE),
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (RTE (RE_Protected_Entry_Index), Loc))), New_Occurrence_Of (RTE (RE_Protected_Entry_Index), Loc))),
Result_Definition => Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc));
New_Occurrence_Of (Standard_Boolean, Loc));
end Build_Barrier_Function_Specification; end Build_Barrier_Function_Specification;
-------------------------- --------------------------
@ -1098,7 +1094,7 @@ package body Exp_Ch9 is
begin begin
return return
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (E, Loc), Name => New_Occurrence_Of (E, Loc),
Parameter_Associations => New_List (Concurrent_Ref (N))); Parameter_Associations => New_List (Concurrent_Ref (N)));
end Build_Call_With_Task; end Build_Call_With_Task;
@ -1121,7 +1117,7 @@ package body Exp_Ch9 is
return; return;
end if; 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, -- type declaration, or an object declaration with an access definition,
-- in which case the type is anonymous. -- in which case the type is anonymous.
@ -13785,7 +13781,8 @@ package body Exp_Ch9 is
Append_To (L, Append_To (L,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (Called_Subp), Loc), Name =>
New_Occurrence_Of (RTE (Called_Subp), Loc),
Parameter_Associations => Args)); Parameter_Associations => Args));
end; end;
end if; end if;
@ -13846,10 +13843,13 @@ package body Exp_Ch9 is
Unchecked_Convert_To Unchecked_Convert_To
(RTE (RE_System_Interrupt_Id), Expr), (RTE (RE_System_Interrupt_Id), Expr),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Make_Selected_Component (Loc, Prefix =>
Make_Identifier (Loc, Name_uInit), Make_Selected_Component (Loc,
Duplicate_Subexpr_No_Checks Prefix =>
(Expression (Handler))), Make_Identifier (Loc, Name_uInit),
Selector_Name =>
Duplicate_Subexpr_No_Checks
(Expression (Handler))),
Attribute_Name => Name_Access)))); Attribute_Name => Name_Access))));
end; end;
end if; end if;
@ -13873,16 +13873,17 @@ package body Exp_Ch9 is
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Occurrence_Of New_Occurrence_Of
(RTE (RE_Install_Restricted_Handlers), Loc), (RTE (RE_Install_Restricted_Handlers), Loc),
Parameter_Associations => Args)); Parameter_Associations => Args));
else else
if not Uses_Lock_Free (Defining_Identifier (Pdec)) then if not Uses_Lock_Free (Defining_Identifier (Pdec)) then
-- First, prepends the _object argument -- First, prepends the _object argument
Prepend_To (Args, Prepend_To (Args,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Make_Identifier (Loc, Name_uInit), Prefix => Make_Identifier (Loc, Name_uInit),
Selector_Name => Selector_Name =>
@ -13894,7 +13895,8 @@ package body Exp_Ch9 is
Append_To (L, Append_To (L,
Make_Procedure_Call_Statement (Loc, 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)); Parameter_Associations => Args));
end if; end if;
end; end;
@ -14048,8 +14050,7 @@ package body Exp_Ch9 is
then then
Append_To (Args, Append_To (Args,
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix => Make_Identifier (Loc, Name_uInit),
Make_Identifier (Loc, Name_uInit),
Selector_Name => Selector_Name =>
Make_Identifier (Loc, Name_uRelative_Deadline))); Make_Identifier (Loc, Name_uRelative_Deadline)));
@ -14150,8 +14151,7 @@ package body Exp_Ch9 is
Subtype_Mark => New_Occurrence_Of (Subp_Ptr_Typ, Loc), Subtype_Mark => New_Occurrence_Of (Subp_Ptr_Typ, Loc),
Expression => Expression =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix => New_Occurrence_Of (Body_Proc, Loc),
New_Occurrence_Of (Body_Proc, Loc),
Attribute_Name => Name_Unrestricted_Access)))); Attribute_Name => Name_Unrestricted_Access))));
-- For the .NET/JVM cases revert to the original code below ??? -- For the .NET/JVM cases revert to the original code below ???
@ -14160,8 +14160,7 @@ package body Exp_Ch9 is
Append_To (Args, Append_To (Args,
Unchecked_Convert_To (RTE (RE_Task_Procedure_Access), Unchecked_Convert_To (RTE (RE_Task_Procedure_Access),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix => New_Occurrence_Of (Body_Proc, Loc),
New_Occurrence_Of (Body_Proc, Loc),
Attribute_Name => Name_Address))); Attribute_Name => Name_Address)));
end if; end if;
end; end;
@ -14235,7 +14234,7 @@ package body Exp_Ch9 is
return return
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name, Name => Name,
Parameter_Associations => Args); Parameter_Associations => Args);
end Make_Task_Create_Call; end Make_Task_Create_Call;
@ -14306,7 +14305,6 @@ package body Exp_Ch9 is
Actual := First (Actuals); Actual := First (Actuals);
Formal := Defining_Identifier (First (Formals)); Formal := Defining_Identifier (First (Formals));
Params := New_List; Params := New_List;
while Present (Actual) loop while Present (Actual) loop
if Is_By_Copy_Type (Etype (Actual)) then if Is_By_Copy_Type (Etype (Actual)) then
-- Generate: -- Generate:
@ -14316,11 +14314,9 @@ package body Exp_Ch9 is
Append_To (Decls, Append_To (Decls,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Aliased_Present => Aliased_Present => True,
True, Defining_Identifier => Temp_Nam,
Defining_Identifier => Object_Definition =>
Temp_Nam,
Object_Definition =>
New_Occurrence_Of (Etype (Formal), Loc))); New_Occurrence_Of (Etype (Formal), Loc)));
if Ekind (Formal) /= E_Out_Parameter then if Ekind (Formal) /= E_Out_Parameter then
@ -14335,10 +14331,8 @@ package body Exp_Ch9 is
Append_To (Stmts, Append_To (Stmts,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Name => Temp_Asn,
Temp_Asn, Expression => New_Copy_Tree (Actual)));
Expression =>
New_Copy_Tree (Actual)));
end if; end if;
-- Generate: -- Generate:
@ -14346,10 +14340,8 @@ package body Exp_Ch9 is
Append_To (Params, Append_To (Params,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Attribute_Name => Attribute_Name => Name_Unchecked_Access,
Name_Unchecked_Access, Prefix => New_Occurrence_Of (Temp_Nam, Loc)));
Prefix =>
New_Occurrence_Of (Temp_Nam, Loc)));
Has_Param := True; Has_Param := True;
@ -14382,12 +14374,9 @@ package body Exp_Ch9 is
Append_To (Decls, Append_To (Decls,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Defining_Identifier => P,
P, Object_Definition => New_Occurrence_Of (Blk_Typ, Loc),
Object_Definition => Expression => Expr));
New_Occurrence_Of (Blk_Typ, Loc),
Expression =>
Expr));
return P; return P;
end Parameter_Block_Pack; end Parameter_Block_Pack;
@ -14420,7 +14409,7 @@ package body Exp_Ch9 is
Asnmt := Asnmt :=
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Name =>
New_Copy (Actual), New_Copy (Actual),
Expression => Expression =>
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,

1
gcc/ada/g-comlin.adb
View File

@ -402,6 +402,7 @@ package body GNAT.Command_Line is
end if; end if;
if Parser.Current_Argument > Parser.Arg_Count then if Parser.Current_Argument > Parser.Arg_Count then
-- If this is the first time this function is called -- If this is the first time this function is called
if Parser.Current_Index = 1 then if Parser.Current_Index = 1 then

2
gcc/ada/lib-writ.adb
View File

@ -1445,7 +1445,7 @@ package body Lib.Writ is
Write_Info_Str (Name_Buffer (1 .. Name_Len - 2)); Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
end if; end if;
-- If Source_Reference pragma used output information -- If Source_Reference pragma used, output information
if Num_SRef_Pragmas (Sind) > 0 then if Num_SRef_Pragmas (Sind) > 0 then
Write_Info_Char (' '); Write_Info_Char (' ');

68
gcc/ada/sem_attr.adb
View File

@ -2409,12 +2409,6 @@ package body Sem_Attr is
end if; end if;
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) if Is_Overloaded (P)
and then Aname /= Name_Access and then Aname /= Name_Access
and then Aname /= Name_Address and then Aname /= Name_Address
@ -2422,7 +2416,7 @@ package body Sem_Attr is
and then Aname /= Name_Result and then Aname /= Name_Result
and then Aname /= Name_Unchecked_Access and then Aname /= Name_Unchecked_Access
then 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 -- attribute. One case that requires special handling is a prefix
-- that is a function name, where one interpretation may be a -- that is a function name, where one interpretation may be a
-- parameterless call. Entry attributes are handled specially below. -- parameterless call. Entry attributes are handled specially below.
@ -2433,44 +2427,40 @@ package body Sem_Attr is
Check_Parameterless_Call (P); Check_Parameterless_Call (P);
end if; end if;
if Ada_Version < Ada_2005 then if Is_Overloaded (P) then
if Is_Overloaded (P) then
-- Ada 2005 (AI-345): Since protected and task types have -- Ada 2005 (AI-345): Since protected and task types have
-- primitive entry wrappers, the attributes Count, Caller and -- primitive entry wrappers, the attributes Count, Caller and
-- AST_Entry require a context check -- AST_Entry require a context check
if Nam_In (Aname, Name_Count, Name_Caller, Name_AST_Entry) then if Nam_In (Aname, Name_Count, Name_Caller, Name_AST_Entry) then
declare declare
Count : Natural := 0; Count : Natural := 0;
I : Interp_Index; I : Interp_Index;
It : Interp; It : Interp;
begin begin
Get_First_Interp (P, I, It); Get_First_Interp (P, I, It);
while Present (It.Nam) loop while Present (It.Nam) loop
if Comes_From_Source (It.Nam) then if Comes_From_Source (It.Nam) then
Count := Count + 1; Count := Count + 1;
else
Remove_Interp (I);
end if;
Get_Next_Interp (I, It);
end loop;
if Count > 1 then
Error_Attr ("ambiguous prefix for % attribute", P);
else else
Set_Is_Overloaded (P, False); Remove_Interp (I);
end if; end if;
end;
else
Error_Attr ("ambiguous prefix for % attribute", P);
end if;
end if;
elsif Is_Overloaded (P) then Get_Next_Interp (I, It);
Error_Attr ("ambiguous prefix for % attribute", P); 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;
end if; end if;