+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.
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.
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;
if Comes_From_Source (Tmp) then
declare
Node_After : constant Node_Id := Next (Parent_Node);
+
begin
Insert_Actions_After (Parent_Node, Aggr_Code);
-- 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;
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);
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))
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)
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);
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));
-- 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 :=
declare
Variable : Variable_Value;
- Proj : Project_Id;
+ Proj : Project_Id;
Tgt_Name : Name_Id := No_Name;
+
begin
Proj := Project;
Project_Loop :
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;
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);
declare
Init_Call : constant Node_Id :=
Remove_Init_Call (U_Ent, N);
+
begin
if Present (Init_Call) then
-- 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));
("& 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
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
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);
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);
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
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
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
-- 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
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;
---------------------------------
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
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
-- 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);
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;
& "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
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;
procedure Reallocate is
New_Size : Memory.size_t;
- New_Length : Long_Integer;
+ New_Length : Long_Long_Integer;
begin
if Max < Last_Val then
-- 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;
projects / platform / upstream / gcc.git / commitdiff