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

[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
This commit is contained in:
Arnaud Charlet 2012-06-12 13:09:10 +02:00
parent 9b168a8bd3
commit d3b00ce368
25 changed files with 171 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -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

7
gcc/ada/ali-util.adb
View File

@ -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

5
gcc/ada/exp_alfa.adb
View File

@ -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 |

2
gcc/ada/exp_attr.adb
View File

@ -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));

6
gcc/ada/exp_cg.adb
View File

@ -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

19
gcc/ada/exp_ch6.adb
View File

@ -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;

28
gcc/ada/exp_ch7.adb
View File

@ -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

40
gcc/ada/freeze.adb
View File

@ -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;

4
gcc/ada/s-tasini.ads
View File

@ -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

5
gcc/ada/scil_ll.adb
View File

@ -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 =>

6
gcc/ada/sem_attr.adb
View File

@ -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)));

4
gcc/ada/sem_ch12.adb
View File

@ -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

3
gcc/ada/sem_ch3.adb
View File

@ -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));

9
gcc/ada/sem_ch4.adb
View File

@ -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

2
gcc/ada/sem_ch7.adb
View File

@ -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;

2
gcc/ada/sem_dist.adb
View File

@ -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))))

13
gcc/ada/sem_elab.adb
View File

@ -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));

24
gcc/ada/sem_res.adb
View File

@ -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);

7
gcc/ada/sem_scil.adb
View File

@ -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

11
gcc/ada/sem_type.adb
View File

@ -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

14
gcc/ada/sem_util.adb
View File

@ -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

7
gcc/ada/sem_warn.adb
View File

@ -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;

12
gcc/ada/sinfo.ads
View File

@ -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;

28
gcc/ada/stringt.adb
View File

@ -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 --
------------------

10
gcc/ada/stringt.ads
View File

@ -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