procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
2013-01-04  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb, gnatcmd.adb, exp_util.adb, table.adb, sem_prag.adb,
	freeze.adb, sem_ch4.adb, sem_warn.adb, opt.ads, exp_aggr.adb,
	prj-conf.adb, sem_ch13.adb: Minor reformatting.

From-SVN: r194888
This commit is contained in:
Robert Dewar 2013-01-04 09:12:00 +00:00 • committed by Arnaud Charlet
parent 3a3af4c32c
commit ae05cdd6a5
13 changed files with 99 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/ada/ChangeLog
View file

@ -1,3 +1,9 @@
2013-01-04 Robert Dewar <dewar@adacore.com>
* exp_prag.adb, gnatcmd.adb, exp_util.adb, table.adb, sem_prag.adb,
freeze.adb, sem_ch4.adb, sem_warn.adb, opt.ads, exp_aggr.adb,
prj-conf.adb, sem_ch13.adb: Minor reformatting.
2013-01-04 Thomas Quinot <quinot@adacore.com>
* sinfo.ads: Minor documentation update.

12
gcc/ada/exp_aggr.adb
View file

@ -2962,9 +2962,10 @@ package body Exp_Aggr is
Node_After : Node_Id)
is
Loc : constant Source_Ptr := Sloc (N);
Init_Actions : constant List_Id := New_List;
Init_Node : Node_Id;
EA : Node_Id;
Init_Actions : constant List_Id := New_List;
begin
-- Nothing to do if Obj is already frozen, as in this case we known we
-- won't need to move the initialization statements about later on.
@ -2974,15 +2975,15 @@ package body Exp_Aggr is
end if;
Init_Node := N;
while Next (Init_Node) /= Node_After loop
Append_To (Init_Actions, Remove_Next (Init_Node));
end loop;
if not Is_Empty_List (Init_Actions) then
EA := Make_Expression_With_Actions (Loc,
Actions => Init_Actions,
Expression => Make_Null_Statement (Loc));
EA :=
Make_Expression_With_Actions (Loc,
Actions => Init_Actions,
Expression => Make_Null_Statement (Loc));
Insert_Action_After (Init_Node, EA);
Set_Initialization_Statements (Obj, EA);
end if;
@ -5123,6 +5124,7 @@ package body Exp_Aggr is
if Comes_From_Source (Tmp) then
declare
Node_After : constant Node_Id := Next (Parent_Node);
begin
Insert_Actions_After (Parent_Node, Aggr_Code);

28
gcc/ada/exp_prag.adb
View file

@ -530,16 +530,16 @@ package body Exp_Prag is
-- Expand_Pragma_Import_Or_Interface --
---------------------------------------
-- When applied to a variable, the default initialization must not be
-- done. As it is already done when the pragma is found, we just get rid
-- of the call the initialization procedure which followed the object
-- declaration. The call is inserted after the declaration, but validity
-- checks may also have been inserted and the initialization call does
-- not necessarily appear immediately after the object declaration.
-- When applied to a variable, the default initialization must not be done.
-- As it is already done when the pragma is found, we just get rid of the
-- call the initialization procedure which followed the object declaration.
-- The call is inserted after the declaration, but validity checks may
-- also have been inserted and the initialization call does not necessarily
-- appear immediately after the object declaration.
-- We can't use the freezing mechanism for this purpose, since we
-- have to elaborate the initialization expression when it is first
-- seen (i.e. this elaboration cannot be deferred to the freeze point).
-- We can't use the freezing mechanism for this purpose, since we have to
-- elaborate the initialization expression when it is first seen (i.e. this
-- elaboration cannot be deferred to the freeze point).
procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
Def_Id : Entity_Id;
@ -553,11 +553,11 @@ package body Exp_Prag is
Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
-- Any default initialization expression should be removed
-- (e.g., null defaults for access objects, zero initialization
-- of packed bit arrays). Imported objects aren't allowed to
-- have explicit initialization, so the expression must have
-- been generated by the compiler.
-- Any default initialization expression should be removed (e.g.,
-- null defaults for access objects, zero initialization of packed
-- bit arrays). Imported objects aren't allowed to have explicit
-- initialization, so the expression must have been generated by
-- the compiler.
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);

2
gcc/ada/exp_util.adb
View file

@ -6227,9 +6227,9 @@ package body Exp_Util is
function Find_Init_Call_In_List (From : Node_Id) return Node_Id is
Init_Call : Node_Id;
begin
Init_Call := From;
while Present (Init_Call) and then Init_Call /= Rep_Clause loop
if Nkind (Init_Call) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (Init_Call))

9
gcc/ada/freeze.adb
View file

@ -1114,9 +1114,7 @@ package body Freeze is
Attribute_Scalar_Storage_Order);
if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
if Present (Comp)
and then Chars (Comp) = Name_uParent
then
if Present (Comp) and then Chars (Comp) = Name_uParent then
if Reverse_Storage_Order (Encl_Type)
/=
Reverse_Storage_Order (Comp_Type)
@ -3358,9 +3356,8 @@ package body Freeze is
Initialization_Statements (E);
begin
if Present (Init_Stmts)
and then Nkind (Init_Stmts) = N_Expression_With_Actions
and then Nkind (Expression (Init_Stmts))
= N_Null_Statement
and then Nkind (Init_Stmts) = N_Expression_With_Actions
and then Nkind (Expression (Init_Stmts)) = N_Null_Statement
then
Insert_List_Before (Init_Stmts, Actions (Init_Stmts));
Remove (Init_Stmts);

8
gcc/ada/gnatcmd.adb
View file

@ -2001,10 +2001,10 @@ begin
Name_Len := 0;
-- If the single main has been specified as an absolute
-- path, we use only the simple file name. If the
-- absolute path is incorrect, an error will be reported
-- by the underlying tool and it does not make a
-- difference what switches are used.
-- path, use only the simple file name. If the absolute
-- path is incorrect, an error will be reported by the
-- underlying tool and it does not make a difference
-- what switches are used.
if Is_Absolute_Path (Main.all) then
Add_Str_To_Name_Buffer (File_Name (Main.all));

14
gcc/ada/opt.ads
View file

@ -537,16 +537,16 @@ package Opt is
-- Determines the handling of exceptions. See Exp_Ch11 for details
--
(Front_End_Setjmp_Longjmp_Exceptions,
-- Exceptions use setjmp/longjmp generated explicitly by the
-- front end (this includes gigi or other equivalent parts of
-- the code generator). AT END handlers are converted into
-- exception handlers by the front end in this mode.
-- Exceptions use setjmp/longjmp generated explicitly by the front end
-- (this includes gigi or other equivalent parts of the code generator).
-- AT END handlers are converted into exception handlers by the front
-- end in this mode.
Back_End_Exceptions);
-- Exceptions are handled by the back end. The front end simply
-- generates the handlers as they appear in the source, and AT
-- END handlers are left untouched (they are not converted into
-- exception handlers when operating in this mode.
-- generates the handlers as they appear in the source, and AT END
-- handlers are left untouched (they are not converted into exception
-- handlers when operating in this mode.
pragma Convention (C, Exception_Mechanism_Type);
Exception_Mechanism : Exception_Mechanism_Type :=

9
gcc/ada/prj-conf.adb
View file

@ -1187,8 +1187,9 @@ package body Prj.Conf is
declare
Variable : Variable_Value;
Proj : Project_Id;
Proj : Project_Id;
Tgt_Name : Name_Id := No_Name;
begin
Proj := Project;
Project_Loop :
@ -1196,9 +1197,9 @@ package body Prj.Conf is
Variable :=
Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
if Variable /= Nil_Variable_Value and then
not Variable.Default and then
Variable.Value /= No_Name
if Variable /= Nil_Variable_Value
and then not Variable.Default
and then Variable.Value /= No_Name
then
Tgt_Name := Variable.Value;
exit Project_Loop;

46
gcc/ada/sem_ch13.adb
View file

@ -1318,14 +1318,16 @@ package body Sem_Ch13 is
P_Name := A_Name;
elsif A_Name = Name_Link_Name then
L_Assoc := Make_Pragma_Argument_Association (Loc,
Chars => A_Name,
Expression => Relocate_Node (Expression (A)));
L_Assoc :=
Make_Pragma_Argument_Association (Loc,
Chars => A_Name,
Expression => Relocate_Node (Expression (A)));
elsif A_Name = Name_External_Name then
E_Assoc := Make_Pragma_Argument_Association (Loc,
Chars => A_Name,
Expression => Relocate_Node (Expression (A)));
E_Assoc :=
Make_Pragma_Argument_Association (Loc,
Chars => A_Name,
Expression => Relocate_Node (Expression (A)));
end if;
Next (A);
@ -2905,6 +2907,7 @@ package body Sem_Ch13 is
declare
Init_Call : constant Node_Id :=
Remove_Init_Call (U_Ent, N);
begin
if Present (Init_Call) then
@ -2912,8 +2915,8 @@ package body Sem_Ch13 is
-- null expression, just extract the actions.
if Nkind (Init_Call) = N_Expression_With_Actions
and then Nkind (Expression (Init_Call))
= N_Null_Statement
and then
Nkind (Expression (Init_Call)) = N_Null_Statement
then
Append_Freeze_Actions (U_Ent, Actions (Init_Call));
@ -2930,9 +2933,8 @@ package body Sem_Ch13 is
("& cannot be exported if an address clause is given",
Nam);
Error_Msg_N
("\define and export a variable " &
"that holds its address instead",
Nam);
("\define and export a variable "
& "that holds its address instead", Nam);
end if;
-- Entity has delayed freeze, so we will generate an
@ -4698,15 +4700,19 @@ package body Sem_Ch13 is
function Is_Inherited (Comp : Entity_Id) return Boolean is
Comp_Base : Entity_Id;
begin
if Ekind (Rectype) = E_Record_Subtype then
Comp_Base := Original_Record_Component (Comp);
else
Comp_Base := Comp;
end if;
return Comp_Base /= Original_Record_Component (Comp_Base);
end Is_Inherited;
-- Local variables
Is_Record_Extension : Boolean;
-- True if Rectype is a record extension
@ -4723,9 +4729,7 @@ package body Sem_Ch13 is
Find_Type (Ident);
Rectype := Entity (Ident);
if Rectype = Any_Type
or else Rep_Item_Too_Early (Rectype, N)
then
if Rectype = Any_Type or else Rep_Item_Too_Early (Rectype, N) then
return;
else
Rectype := Underlying_Type (Rectype);
@ -5155,8 +5159,9 @@ package body Sem_Ch13 is
return Empty;
end if;
SId := Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Invariant"));
SId :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Invariant"));
Set_Has_Invariants (SId);
Set_Has_Invariants (Typ);
Set_Ekind (SId, E_Procedure);
@ -8779,10 +8784,11 @@ package body Sem_Ch13 is
Designated_Type (Etype (F)), Loc))));
if Nam = TSS_Stream_Input then
Spec := Make_Function_Specification (Loc,
Defining_Unit_Name => Subp_Id,
Parameter_Specifications => Formals,
Result_Definition => T_Ref);
Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => Subp_Id,
Parameter_Specifications => Formals,
Result_Definition => T_Ref);
else
-- V : [out] T

2
gcc/ada/sem_ch4.adb
View file

@ -1902,6 +1902,8 @@ package body Sem_Ch4 is
exit when No (A);
end loop;
-- This test needs a comment ???
if Nkind (Expression (N)) = N_Null_Statement then
Set_Etype (N, Standard_Void_Type);
else

4
gcc/ada/sem_prag.adb
View file

@ -6775,7 +6775,7 @@ package body Sem_Prag is
if Volatile_Seen
and then
((Input_Seen and then Output_Seen) -- both
or else
or else
(not Input_Seen and then not Output_Seen)) -- none
then
Error_Msg_N
@ -6785,7 +6785,7 @@ package body Sem_Prag is
-- Either Input or Output require Volatile
if (Input_Seen or else Output_Seen)
if (Input_Seen or Output_Seen)
and then not Volatile_Seen
then
Error_Msg_N

35
gcc/ada/sem_warn.adb
View file

@ -3281,7 +3281,7 @@ package body Sem_Warn is
begin
return
(Warn_On_Modified_Unread and then Is_Only_Out_Parameter (E))
or else Warn_On_All_Unread_Out_Parameters;
or else Warn_On_All_Unread_Out_Parameters;
end Warn_On_Modified_As_Out_Parameter;
---------------------------------
@ -3293,7 +3293,7 @@ package body Sem_Warn is
Form1, Form2 : Entity_Id;
function Is_Covered_Formal (Formal : Node_Id) return Boolean;
-- Return True if Formal is covered by the rule.
-- Return True if Formal is covered by the rule
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean;
-- Two names are known to refer to the same object if the two names
@ -3321,11 +3321,10 @@ package body Sem_Warn is
function Is_Covered_Formal (Formal : Node_Id) return Boolean is
begin
return
Ekind_In (Formal, E_Out_Parameter,
E_In_Out_Parameter)
Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter)
and then (Is_Elementary_Type (Etype (Formal))
or else Is_Record_Type (Etype (Formal))
or else Is_Array_Type (Etype (Formal)));
or else Is_Record_Type (Etype (Formal))
or else Is_Array_Type (Etype (Formal)));
end Is_Covered_Formal;
begin
@ -3347,13 +3346,12 @@ package body Sem_Warn is
-- there is no other name among the other parameters of mode in out or
-- out to C that is known to denote the same object (RM 6.4.1(6.15/3))
-- Compiling under -gnatw.i we also report warnings on overlapping
-- parameters that are record types or array types.
-- If appropriate warning switch is set, we also report warnings on
-- overlapping parameters that are record types or array types.
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
if Is_Covered_Formal (Form1) then
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
@ -3376,25 +3374,24 @@ package body Sem_Warn is
elsif Nkind (Act2) = N_Function_Call then
null;
-- If type is not by-copy we can assume that the aliasing is
-- intended.
-- If type is not by-copy, assume that aliasing is intended
elsif
Present (Underlying_Type (Etype (Form1)))
and then
(Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
or else
Convention (Underlying_Type (Etype (Form1)))
= Convention_Ada_Pass_By_Reference)
Convention (Underlying_Type (Etype (Form1))) =
Convention_Ada_Pass_By_Reference)
then
null;
-- Under Ada 2012 we only report warnings on overlapping
-- arrays and record types if compiling under -gnatw.i
-- arrays and record types if switch is set.
elsif Ada_Version >= Ada_2012
and then not Is_Elementary_Type (Etype (Form1))
and then not Warn_On_Overlap
and then not Is_Elementary_Type (Etype (Form1))
and then not Warn_On_Overlap
then
null;
@ -3449,7 +3446,7 @@ package body Sem_Warn is
& "actual for&?I?", Act1, Form);
else
-- For greater clarity, give name of formal.
-- For greater clarity, give name of formal
Error_Msg_Node_2 := Form;
Error_Msg_FE
@ -3460,8 +3457,8 @@ package body Sem_Warn is
else
Error_Msg_Node_2 := Form;
Error_Msg_FE
("writable actual for & overlaps with"
& " actual for&?I?", Act1, Form1);
("writable actual for & overlaps with "
& "actual for&?I?", Act1, Form1);
end if;
end;
end if;

10
gcc/ada/table.adb
View file

@ -172,7 +172,7 @@ package body Table is
procedure Reallocate is
New_Size : Memory.size_t;
New_Length : Long_Integer;
New_Length : Long_Long_Integer;
begin
if Max < Last_Val then
@ -188,12 +188,14 @@ package body Table is
-- for the use of 10 here is to ensure that the table does really
-- increase in size (which would not be the case for a table of
-- length 10 increased by 3% for instance). Do the intermediate
-- calculation in Long_Integer to avoid overflow.
-- calculation in Long_Long_Integer to avoid overflow. Note that
-- Long_Integer has the same range as Integer on Windows, so we
-- need Long_Long_.
while Max < Last_Val loop
New_Length :=
Long_Integer (Length) *
(100 + Long_Integer (Table_Increment))
Long_Long_Integer (Length) *
(100 + Long_Long_Integer (Table_Increment))
/ 100;
Length := Int'Max (Int (New_Length), Length + 10);
Max := Min + Length - 1;