diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-06-12 13:09:10 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-06-12 13:09:10 +0200 |
commit | d3b00ce368f3d32a4db4dac4538a90920f6365ef (patch) | |
tree | 0e78ec06ef2f1c383b601d90512460153a20d376 /gcc | |
parent | 9b168a8bd3854341c48ad5aa1b30ea5bed06ba9e (diff) | |
download | gcc-d3b00ce368f3d32a4db4dac4538a90920f6365ef.zip gcc-d3b00ce368f3d32a4db4dac4538a90920f6365ef.tar.gz gcc-d3b00ce368f3d32a4db4dac4538a90920f6365ef.tar.bz2 |
[multiple changes]
2012-06-12 Robert Dewar <dewar@adacore.com>
* sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb,
sinfo.ads, sem_ch7.adb, exp_alfa.adb, sem_scil.adb, sem_ch12.adb,
sem_util.adb, sem_res.adb, sem_attr.adb, sem_elab.adb, exp_ch6.adb,
sem_ch4.adb, sem_warn.adb, scil_ll.adb, exp_cg.adb: Minor code
reorganization.
2012-06-12 Eric Botcazou <ebotcazou@adacore.com>
* s-tasini.ads: Minor fix in comment.
2012-06-12 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Freeze_Record_Type): Warn on record with
Scalar_Storage_Order if there is no placed component.
2012-06-12 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb: Minor comment fix.
2012-06-12 Vincent Celier <celier@adacore.com>
* ali-util.adb (Time_Stamp_Mismatch): In minimal recompilation
mode, use Stringt Mark and Release to avoid growing the Stringt
internal tables uselessly.
* stringt.adb (Strings_Last): New global variable
(String_Chars_Last): New global variable.
(Mark, Release): New procedures.
* stringt.ads (Mark, Release) New procedures.
From-SVN: r188445
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 31 | ||||
-rw-r--r-- | gcc/ada/ali-util.adb | 7 | ||||
-rw-r--r-- | gcc/ada/exp_alfa.adb | 5 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_cg.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 19 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 28 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 40 | ||||
-rw-r--r-- | gcc/ada/s-tasini.ads | 4 | ||||
-rw-r--r-- | gcc/ada/scil_ll.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 6 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch7.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_dist.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_elab.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 24 | ||||
-rw-r--r-- | gcc/ada/sem_scil.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_type.adb | 11 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 14 | ||||
-rw-r--r-- | gcc/ada/sem_warn.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 12 | ||||
-rw-r--r-- | gcc/ada/stringt.adb | 28 | ||||
-rw-r--r-- | gcc/ada/stringt.ads | 10 |
25 files changed, 171 insertions, 128 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d1494f6..90bb9bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2012-06-12 Robert Dewar <dewar@adacore.com> + + * sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb, + sinfo.ads, sem_ch7.adb, exp_alfa.adb, sem_scil.adb, sem_ch12.adb, + sem_util.adb, sem_res.adb, sem_attr.adb, sem_elab.adb, exp_ch6.adb, + sem_ch4.adb, sem_warn.adb, scil_ll.adb, exp_cg.adb: Minor code + reorganization. + +2012-06-12 Eric Botcazou <ebotcazou@adacore.com> + + * s-tasini.ads: Minor fix in comment. + +2012-06-12 Thomas Quinot <quinot@adacore.com> + + * freeze.adb (Freeze_Record_Type): Warn on record with + Scalar_Storage_Order if there is no placed component. + +2012-06-12 Thomas Quinot <quinot@adacore.com> + + * sem_ch3.adb: Minor comment fix. + +2012-06-12 Vincent Celier <celier@adacore.com> + + * ali-util.adb (Time_Stamp_Mismatch): In minimal recompilation + mode, use Stringt Mark and Release to avoid growing the Stringt + internal tables uselessly. + * stringt.adb (Strings_Last): New global variable + (String_Chars_Last): New global variable. + (Mark, Release): New procedures. + * stringt.ads (Mark, Release) New procedures. + 2012-06-12 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Process_Transient_Objects): Renamed constant diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 0b43200..40cb1d9 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,7 @@ with Scans; use Scans; with Scng; with Sinput.C; with Snames; use Snames; +with Stringt; with Styleg; package body ALI.Util is @@ -476,6 +477,8 @@ package body ALI.Util is -- ??? It is probably worth updating the ALI file with a new -- field to avoid recomputing it each time. + Stringt.Mark; + if Checksums_Match (Get_File_Checksum (Sdep.Table (D).Sfile), Source.Table (Src).Checksum) @@ -491,6 +494,8 @@ package body ALI.Util is Sdep.Table (D).Stamp := Source.Table (Src).Stamp; end if; + Stringt.Release; + end if; if (not Read_Only) or else Source.Table (Src).Source_Found then diff --git a/gcc/ada/exp_alfa.adb b/gcc/ada/exp_alfa.adb index ab0e40f..2a640fd 100644 --- a/gcc/ada/exp_alfa.adb +++ b/gcc/ada/exp_alfa.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -87,8 +87,7 @@ package body Exp_Alfa is N_Subprogram_Body => Qualify_Entity_Names (N); - when N_Function_Call | - N_Procedure_Call_Statement => + when N_Subprogram_Call => Expand_Alfa_Call (N); when N_Expanded_Name | diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 3557701..2bfe692 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -421,7 +421,7 @@ package body Exp_Attr is Par := Parent (Par); end if; - if Nkind_In (Par, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (Par) in N_Subprogram_Call and then Is_Entity_Name (Name (Par)) then Subp := Entity (Name (Par)); diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index e5f618f..076783f 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -122,7 +122,7 @@ package body Exp_CG is for J in Call_Graph_Nodes.First .. Call_Graph_Nodes.Last loop N := Call_Graph_Nodes.Table (J); - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then + if Nkind (N) in N_Subprogram_Call then Write_Call_Info (N); else pragma Assert (Nkind (N) = N_Defining_Identifier); @@ -349,7 +349,7 @@ package body Exp_CG is procedure Register_CG_Node (N : Node_Id) is begin - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then + if Nkind (N) in N_Subprogram_Call then if Current_Scope = Main_Unit_Entity or else Entity_Is_In_Main_Unit (Current_Scope) then diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3cbb790..916e7e7 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -3271,7 +3271,7 @@ package body Exp_Ch6 is -- Ada 2005 (AI-251): If some formal is a class-wide interface, expand -- it to point to the correct secondary virtual table - if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (Call_Node) in N_Subprogram_Call and then CW_Interface_Formals_Present then Expand_Interface_Actuals (Call_Node); @@ -3285,7 +3285,7 @@ package body Exp_Ch6 is -- back-ends directly handle the generation of dispatching calls and -- would have to undo any expansion to an indirect call. - if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (Call_Node) in N_Subprogram_Call and then Present (Controlling_Argument (Call_Node)) then declare @@ -3868,13 +3868,14 @@ package body Exp_Ch6 is -- intermediate result after its use. elsif Is_Build_In_Place_Function_Call (Call_Node) - and then Nkind_In (Parent (Call_Node), N_Attribute_Reference, - N_Function_Call, - N_Indexed_Component, - N_Object_Renaming_Declaration, - N_Procedure_Call_Statement, - N_Selected_Component, - N_Slice) + and then + Nkind_In (Parent (Call_Node), N_Attribute_Reference, + N_Function_Call, + N_Indexed_Component, + N_Object_Renaming_Declaration, + N_Procedure_Call_Statement, + N_Selected_Component, + N_Slice) then Establish_Transient_Scope (Call_Node, Sec_Stack => True); end if; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e9daade..1ffc8ca 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4337,32 +4337,14 @@ package body Exp_Ch7 is ---------------------- function Requires_Hooking return Boolean is - function Is_Subprogram_Call (Nod : Node_Id) return Boolean; - -- Determine whether a particular node is a procedure of function - -- call. - - ------------------------ - -- Is_Subprogram_Call -- - ------------------------ - - function Is_Subprogram_Call (Nod : Node_Id) return Boolean is - begin - return - Nkind_In (Nod, N_Function_Call, N_Procedure_Call_Statement); - end Is_Subprogram_Call; - - -- Start of processing for Requires_Hooking - begin -- The context is either a procedure or function call or an object - -- declaration initialized by such a call. In all these cases, the - -- calls are assumed to raise an exception. + -- declaration initialized by a function call. In all these cases, + -- the calls might raise an exception. - return - Is_Subprogram_Call (N) - or else - (Nkind (N) = N_Object_Declaration - and then Is_Subprogram_Call (Expression (N))); + return Nkind (N) in N_Subprogram_Call + or else (Nkind (N) = N_Object_Declaration + and then Nkind (Expression (N)) = N_Function_Call); end Requires_Hooking; -- Local variables diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index a4588bd..0f20edf 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2129,22 +2129,32 @@ package body Freeze is Next_Entity (Comp); end loop; - -- Check compatibility of Scalar_Storage_Order with Bit_Order, if the - -- former is specified. - ADC := Get_Attribute_Definition_Clause (Rec, Attribute_Scalar_Storage_Order); - if Present (ADC) - and then Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) - then - -- Note: report error on Rec, not on ADC, as ADC may apply to - -- an ancestor type. + if Present (ADC) then - Error_Msg_Sloc := Sloc (ADC); - Error_Msg_N - ("scalar storage order for& specified# inconsistent with " - & "bit order", Rec); + -- Check compatibility of Scalar_Storage_Order with Bit_Order, if + -- the former is specified. + + if Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) then + + -- Note: report error on Rec, not on ADC, as ADC may apply to + -- an ancestor type. + + Error_Msg_Sloc := Sloc (ADC); + Error_Msg_N + ("scalar storage order for& specified# inconsistent with " + & "bit order", Rec); + end if; + + -- Warn if there is a Scalar_Storage_Order but no component clause + + if not Placed_Component then + Error_Msg_N + ("?scalar storage order specified but no component clause", + ADC); + end if; end if; -- Deal with Bit_Order aspect specifying a non-default bit order @@ -2153,7 +2163,7 @@ package body Freeze is if not Placed_Component then ADC := Get_Attribute_Definition_Clause (Rec, Attribute_Bit_Order); - Error_Msg_N ("?Bit_Order specification has no effect", ADC); + Error_Msg_N ("?bit order specification has no effect", ADC); Error_Msg_N ("\?since no component clauses were specified", ADC); @@ -2188,8 +2198,8 @@ package body Freeze is if Is_Base_Type (Rec) and then Convention (Rec) = Convention_Ada then if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V) - or else - (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R) + or else + (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R) then Set_OK_To_Reorder_Components (Rec); end if; diff --git a/gcc/ada/s-tasini.ads b/gcc/ada/s-tasini.ads index 1bf82cc..70dd867 100644 --- a/gcc/ada/s-tasini.ads +++ b/gcc/ada/s-tasini.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,7 +62,7 @@ package System.Tasking.Initialization is -- Abort Defer/Undefer -- ------------------------- - -- Defer_Abort defers the affects of low-level abort and priority change + -- Defer_Abort defers the effects of low-level abort and priority change -- in the calling task until a matching Undefer_Abort call is executed. -- Undefer_Abort DOES MORE than just undo the effects of one call to diff --git a/gcc/ada/scil_ll.adb b/gcc/ada/scil_ll.adb index 4591d8e..470ac98 100644 --- a/gcc/ada/scil_ll.adb +++ b/gcc/ada/scil_ll.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -117,8 +117,7 @@ package body SCIL_LL is null; when N_SCIL_Dispatching_Call => - pragma Assert (Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement)); + pragma Assert (Nkind (N) in N_Subprogram_Call); null; when N_SCIL_Membership_Test => diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 10af9e2..345fdb5 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3849,8 +3849,7 @@ package body Sem_Attr is -- Case of attribute used as actual for subprogram (positional) - elsif Nkind_In (Parnt, N_Procedure_Call_Statement, - N_Function_Call) + elsif Nkind (Parnt) in N_Subprogram_Call and then Is_Entity_Name (Name (Parnt)) then Must_Be_Imported (Entity (Name (Parnt))); @@ -3858,8 +3857,7 @@ package body Sem_Attr is -- Case of attribute used as actual for subprogram (named) elsif Nkind (Parnt) = N_Parameter_Association - and then Nkind_In (GParnt, N_Procedure_Call_Statement, - N_Function_Call) + and then Nkind (GParnt) in N_Subprogram_Call and then Is_Entity_Name (Name (GParnt)) then Must_Be_Imported (Entity (Name (GParnt))); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 159c6e7..edca338 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13578,9 +13578,7 @@ package body Sem_Ch12 is -- information on aggregates in instances. if Nkind (N2) = Nkind (N) - and then - Nkind_In (Parent (N2), N_Procedure_Call_Statement, - N_Function_Call) + and then Nkind (Parent (N2)) in N_Subprogram_Call and then Comes_From_Source (Typ) then if Is_Immediately_Visible (Scope (Typ)) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 1fdf17e..b58c21f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4341,7 +4341,8 @@ package body Sem_Ch3 is when E_Incomplete_Type => if Ada_Version >= Ada_2005 then - -- A subtype of an incomplete type can be explicitly tagged + -- In Ada 2005 an incomplete type can be explicitly tagged: + -- propagate indication. Set_Ekind (Id, E_Incomplete_Subtype); Set_Is_Tagged_Type (Id, Is_Tagged_Type (T)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f1f7c60..563d5b8 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2299,7 +2299,7 @@ package body Sem_Ch4 is Analyze (P); - if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then + if Nkind (N) in N_Subprogram_Call then -- If P is an explicit dereference whose prefix is of a -- remote access-to-subprogram type, then N has already @@ -6736,9 +6736,7 @@ package body Sem_Ch4 is (N : Node_Id; CW_Test_Only : Boolean := False) return Boolean is K : constant Node_Kind := Nkind (Parent (N)); - Is_Subprg_Call : constant Boolean := Nkind_In - (K, N_Procedure_Call_Statement, - N_Function_Call); + Is_Subprg_Call : constant Boolean := K in N_Subprogram_Call; Loc : constant Source_Ptr := Sloc (N); Obj : constant Node_Id := Prefix (N); @@ -7087,8 +7085,7 @@ package body Sem_Ch4 is -- Common case covering 1) Call to a procedure and 2) Call to a -- function that has some additional actuals. - if Nkind_In (Parent_Node, N_Function_Call, - N_Procedure_Call_Statement) + if Nkind (Parent_Node) in N_Subprogram_Call -- N is a selected component node containing the name of the -- subprogram. If N is not the name of the parent node we must diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 2774c2a..326219d 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -533,7 +533,7 @@ package body Sem_Ch7 is begin -- Check name of procedure or function calls - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then return Abandon; diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 072efa2..678a600 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -242,7 +242,7 @@ package body Sem_Dist is Par : Node_Id; begin - if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (N) in N_Subprogram_Call and then Nkind (Name (N)) in N_Has_Entity and then Is_Remote_Call_Interface (Entity (Name (N))) and then Has_All_Calls_Remote (Scope (Entity (Name (N)))) diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index e37056e..4a98db6 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -545,8 +545,7 @@ package body Sem_Elab is -- If the call is known to be within a local Suppress Elaboration -- pragma, nothing to check. This can happen in task bodies. - if (Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement) + if Nkind (N) in N_Subprogram_Call and then No_Elaboration_Check (N) then return; @@ -990,9 +989,7 @@ package body Sem_Elab is -- which can happen if the body enclosing the call appears -- itself in a call whose elaboration check is delayed. - if Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then + if Nkind (N) in N_Subprogram_Call then Set_No_Elaboration_Check (N); end if; end if; @@ -1184,8 +1181,7 @@ package body Sem_Elab is -- Nothing to do if this is not a call or attribute reference (happens -- in some error conditions, and in some cases where rewriting occurs). - elsif Nkind (N) /= N_Function_Call - and then Nkind (N) /= N_Procedure_Call_Statement + elsif Nkind (N) not in N_Subprogram_Call and then Nkind (N) /= N_Attribute_Reference then return; @@ -1510,8 +1506,7 @@ package body Sem_Elab is Func : Entity_Id; begin - if (Nkind (Nod) = N_Function_Call - or else Nkind (Nod) = N_Procedure_Call_Statement) + if Nkind (Nod) in N_Subprogram_Call and then Is_Entity_Name (Name (Nod)) then Func := Entity (Name (Nod)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b33cffe..eda8583 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2144,9 +2144,7 @@ package body Sem_Res is -- of the arguments is Any_Type, and if so, suppress -- the message, since it is a cascaded error. - if Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then + if Nkind (N) in N_Subprogram_Call then declare A : Node_Id; E : Node_Id; @@ -2212,8 +2210,7 @@ package body Sem_Res is ("\\possible interpretation#!", N); end if; - if Nkind_In - (N, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (N) in N_Subprogram_Call and then Present (Parameter_Associations (N)) then Report_Ambiguous_Argument; @@ -2360,7 +2357,7 @@ package body Sem_Res is -- For procedure or function calls, set the type of the name, -- and also the entity pointer for the prefix. - elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) + elsif Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then Set_Etype (Name (N), Expr_Type); @@ -2990,8 +2987,7 @@ package body Sem_Res is if not Warn_On_Parameter_Order or else No (Parameter_Associations (N)) - or else not Nkind_In (Original_Node (N), N_Procedure_Call_Statement, - N_Function_Call) + or else Nkind (Original_Node (N)) not in N_Subprogram_Call or else not Comes_From_Source (N) then return; @@ -4223,11 +4219,9 @@ package body Sem_Res is Par : constant Node_Id := Parent (N); begin - return - Nkind_In (Par, N_Function_Call, - N_Procedure_Call_Statement) - and then Is_Entity_Name (Name (Par)) - and then Is_Dispatching_Operation (Entity (Name (Par))); + return Nkind (Par) in N_Subprogram_Call + and then Is_Entity_Name (Name (Par)) + and then Is_Dispatching_Operation (Entity (Name (Par))); end In_Dispatching_Context; -- Start of processing for Resolve_Allocator @@ -7749,9 +7743,7 @@ package body Sem_Res is -- In the common case of a call which uses an explicitly null value -- for an access parameter, give specialized error message. - if Nkind_In (Parent (N), N_Procedure_Call_Statement, - N_Function_Call) - then + if Nkind (Parent (N)) in N_Subprogram_Call then Error_Msg_N ("null is not allowed as argument for an access parameter", N); diff --git a/gcc/ada/sem_scil.adb b/gcc/ada/sem_scil.adb index a069a0a..b94411a 100644 --- a/gcc/ada/sem_scil.adb +++ b/gcc/ada/sem_scil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,10 +59,7 @@ package body Sem_SCIL is -- Parent of SCIL dispatching call nodes MUST be a subprogram call - if not Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then - pragma Assert (False); + if Nkind (N) not in N_Subprogram_Call then raise Program_Error; -- In simple cases the controlling tag is the tag of the diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 0d10262..ec50247 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -481,7 +481,7 @@ package body Sem_Type is then Add_Entry (Entity (N), Etype (N)); - elsif Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + elsif Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then Add_Entry (Entity (Name (N)), Etype (N)); @@ -1467,9 +1467,7 @@ package body Sem_Type is return It1; else - if Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement - then + if Nkind (N) in N_Subprogram_Call then Act1 := First_Actual (N); if Present (Act1) then @@ -1867,8 +1865,7 @@ package body Sem_Type is elsif In_Instance and then not In_Generic_Actual (N) then - if Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement + if Nkind (N) in N_Subprogram_Call or else (Nkind (N) in N_Has_Entity and then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2dd98f9..3c0e6c4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3747,7 +3747,7 @@ package body Sem_Util is then Call := Parent (Parnt); - elsif Nkind_In (Parnt, N_Procedure_Call_Statement, N_Function_Call) then + elsif Nkind (Parnt) in N_Subprogram_Call then Call := Parnt; else @@ -6604,7 +6604,7 @@ package body Sem_Util is when N_Parameter_Association => return N = Explicit_Actual_Parameter (Parent (N)); - when N_Function_Call | N_Procedure_Call_Statement => + when N_Subprogram_Call => return Is_List_Member (N) and then List_Containing (N) = Parameter_Associations (Parent (N)); @@ -8127,9 +8127,8 @@ package body Sem_Util is function Is_Remote_Call (N : Node_Id) return Boolean is begin - if Nkind (N) /= N_Procedure_Call_Statement - and then Nkind (N) /= N_Function_Call - then + if Nkind (N) not in N_Subprogram_Call then + -- An entry call cannot be remote return False; @@ -9328,9 +9327,8 @@ package body Sem_Util is -- In older versions of Ada function call arguments are never -- lvalues. In Ada 2012 functions can have in-out parameters. - when N_Function_Call | - N_Procedure_Call_Statement | - N_Entry_Call_Statement | + when N_Subprogram_Call | + N_Entry_Call_Statement | N_Accept_Statement => if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 3ba8b91..e41cad4 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -511,9 +511,8 @@ package body Sem_Warn is -- Call to subprogram - elsif Nkind (N) = N_Procedure_Call_Statement - or else Nkind (N) = N_Function_Call - then + elsif Nkind (N) in N_Subprogram_Call then + -- If subprogram is within the scope of the entity we are dealing -- with as the loop variable, then it could modify this parameter, -- so we abandon in this case. In the case of a subprogram that is @@ -3282,7 +3281,7 @@ package body Sem_Warn is -- Exclude calls rewritten as enumeration literals - if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then + if Nkind (N) not in N_Subprogram_Call then return; end if; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 4ece762..22aea5b 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7649,11 +7649,17 @@ package Sinfo is N_Conditional_Expression, N_Explicit_Dereference, N_Expression_With_Actions, + + -- N_Subexpr, N_Has_Etype, N_Subprogram_Call + N_Function_Call, + N_Procedure_Call_Statement, + + -- N_Subexpr, N_Has_Etype + N_Indexed_Component, N_Integer_Literal, N_Null, - N_Procedure_Call_Statement, N_Qualified_Expression, N_Quantified_Expression, @@ -8067,6 +8073,10 @@ package Sinfo is -- (since overloading is possible, so it needs to go through the normal -- overloading resolution for expressions). + subtype N_Subprogram_Call is Node_Kind range + N_Function_Call .. + N_Procedure_Call_Statement; + subtype N_Subprogram_Instantiation is Node_Kind range N_Function_Instantiation .. N_Procedure_Instantiation; diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 89dfe6e..8d3b2da 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -70,6 +70,12 @@ package body Stringt is -- when Start_String is called with a parameter that is the last string -- currently allocated in the table. + Strings_Last : String_Id := First_String_Id; + String_Chars_Last : Int := 0; + -- Strings_Last and String_Chars_Last are used by procedure Mark and + -- Release to get a snapshot of the tables and to restore them to their + -- previous situation. + ------------------------------- -- Add_String_To_Name_Buffer -- ------------------------------- @@ -129,6 +135,26 @@ package body Stringt is Strings.Release; end Lock; + ---------- + -- Mark -- + ---------- + + procedure Mark is + begin + Strings_Last := Strings.Last; + String_Chars_Last := String_Chars.Last; + end Mark; + + ------------- + -- Release -- + ------------- + + procedure Release is + begin + Strings.Set_Last (Strings_Last); + String_Chars.Set_Last (String_Chars_Last); + end Release; + ------------------ -- Start_String -- ------------------ diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 7a84a32..7fb4725 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,6 +62,14 @@ package Stringt is procedure Unlock; -- Unlock internal tables, in case back end needs to modify them + procedure Mark; + -- Take a snapshot of the internal tables + + procedure Release; + -- Restore the internal tables to the situation when Mark was last called. + -- Mark and Release are used when getting checksums of sources in minimal + -- recompilation mode, to reduce memory usage. + procedure Start_String; -- Sets up for storing a new string in the table. To store a string, a -- call is first made to Start_String, then successive calls are |