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-03-15  Robert Dewar  <dewar@adacore.com>

	* errout.ads: Add entry for translating -gnateinn to
	/MAX_INSTANTIATIONS for VMS.
	* hostparm.ads (Max_Instantiations): Moved to Opt.
	* opt.ads (Maximum_Instantiations): Moved from Hostparm, and renamed.
	* sem_ch12.adb (Maximum_Instantiations): New name of
	Max_Instantiations (Analyze_Package_Instantiation): Change error
	msg for too many instantiations (mention -gnateinn switch).
	* switch-c.adb (Scan_Front_End_Switches): Implement -gnateinn switch.
	* switch.ads: Minor comment update.
	* usage.adb (Usage): Output line for -maxeinn switch.
	* vms_data.ads: Add entry for MAX_INSTANTIATIONS (-gnateinn).

2012-03-15  Yannick Moy  <moy@adacore.com>

	* alfa.ads Update the decription of ALI sections.
	(Alfa_File_Record): Add a component Unit_File_Name to store the
	unit file name for subunits.
	* get_alfa.adb, put_alfa.adb Adapt to the possible presence of
	a unit file name.
	* lib-xref-alfa.adb (Add_Alfa_File): For subunits, retrieve the
	file name of the unit.

2012-03-15  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (Check_Subprogram_Contract): Do
	not issue warning on missing 'Result in postcondition if all
	postconditions and contract-cases already get a warning for only
	referring to pre-state.

2012-03-15  Bob Duff  <duff@adacore.com>

	* debug.adb: Add new debug switch -gnatd.U, which disables the
	support added below, in case someone trips over a cycle, and needs
	to disable this.
	* sem_attr.adb (Analyze_Access_Attribute):
	Treat Subp'Access as a call for elaboration purposes.
	* sem_elab.ads, sem_elab.adb (Check_Elab_Call): Add support
	for Subp'Access.

From-SVN: r185422
This commit is contained in:
Arnaud Charlet 2012-03-15 10:15:49 +01:00
parent b3e42de5be
commit 1f163ef7ac
18 changed files with 274 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
2012-03-15 Robert Dewar <dewar@adacore.com>
* errout.ads: Add entry for translating -gnateinn to
/MAX_INSTANTIATIONS for VMS.
* hostparm.ads (Max_Instantiations): Moved to Opt.
* opt.ads (Maximum_Instantiations): Moved from Hostparm, and renamed.
* sem_ch12.adb (Maximum_Instantiations): New name of
Max_Instantiations (Analyze_Package_Instantiation): Change error
msg for too many instantiations (mention -gnateinn switch).
* switch-c.adb (Scan_Front_End_Switches): Implement -gnateinn switch.
* switch.ads: Minor comment update.
* usage.adb (Usage): Output line for -maxeinn switch.
* vms_data.ads: Add entry for MAX_INSTANTIATIONS (-gnateinn).
2012-03-15 Yannick Moy <moy@adacore.com>
* alfa.ads Update the decription of ALI sections.
(Alfa_File_Record): Add a component Unit_File_Name to store the
unit file name for subunits.
* get_alfa.adb, put_alfa.adb Adapt to the possible presence of
a unit file name.
* lib-xref-alfa.adb (Add_Alfa_File): For subunits, retrieve the
file name of the unit.
2012-03-15 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (Check_Subprogram_Contract): Do
not issue warning on missing 'Result in postcondition if all
postconditions and contract-cases already get a warning for only
referring to pre-state.
2012-03-15 Bob Duff <duff@adacore.com>
* debug.adb: Add new debug switch -gnatd.U, which disables the
support added below, in case someone trips over a cycle, and needs
to disable this.
* sem_attr.adb (Analyze_Access_Attribute):
Treat Subp'Access as a call for elaboration purposes.
* sem_elab.ads, sem_elab.adb (Check_Elab_Call): Add support
for Subp'Access.
2012-03-15 Vincent Pucci <pucci@adacore.com>
* sem.ads, sem.adb (Preanalyze): New routine.

10
gcc/ada/alfa.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-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,7 +70,7 @@ package Alfa is
-- subprogram declaration and body, when both present, define two different
-- scopes.
-- FD dependency-number filename
-- FD dependency-number filename (-> unit-filename)?
-- This header precedes scope information for the unit identified by
-- dependency number and file name. The dependency number is the index
@ -89,6 +89,8 @@ package Alfa is
-- reading of the Alfa information, and means that the Alfa information
-- can stand on its own without needing other parts of the ALI file.
-- The optional unit filename is given only for subunits.
-- FS . scope line type col entity (-> spec-file . spec-scope)?
-- (The ? mark stands for an optional entry in the syntax)
@ -314,6 +316,10 @@ package Alfa is
File_Name : String_Ptr;
-- Pointer to file name in ALI file
Unit_File_Name : String_Ptr;
-- Pointer to file name for unit in ALI file, when File_Name refers to a
-- subunit. Otherwise null.
File_Num : Nat;
-- Dependency number in ALI file

8
gcc/ada/debug.adb
View File

@ -138,7 +138,7 @@ package body Debug is
-- d.R
-- d.S Force Optimize_Alignment (Space)
-- d.T Force Optimize_Alignment (Time)
-- d.U
-- d.U Ignore indirect calls for static elaboration
-- d.V
-- d.W Print out debugging information for Walk_Library_Items
-- d.X Use Expression_With_Actions
@ -642,6 +642,12 @@ package body Debug is
-- d.T Force Optimize_Alignment (Time) mode as the default
-- d.U Ignore indirect calls for static elaboration. The static
-- elaboration model is conservative, especially regarding indirect
-- calls. If you say Proc'Access, it will assume you might call
-- Proc. This can cause elaboration cycles at bind time. This flag
-- reverts to the behavior of earlier compilers.
-- d.W Print out debugging information for Walk_Library_Items, including
-- the order in which units are walked. This is primarily for use in
-- debugging CodePeer mode.

9
gcc/ada/errout.ads
View File

@ -380,6 +380,9 @@ package Errout is
Gname8 : aliased constant String := "gnat2012";
Vname8 : aliased constant String := "2012";
Gname9 : aliased constant String := "gnateinn";
Vname9 : aliased constant String := "MAX_INSTANTIATIONS=nn";
type Cstring_Ptr is access constant String;
Gnames : array (Nat range <>) of Cstring_Ptr :=
@ -390,7 +393,8 @@ package Errout is
Gname5'Access,
Gname6'Access,
Gname7'Access,
Gname8'Access);
Gname8'Access,
Gname9'Access);
Vnames : array (Nat range <>) of Cstring_Ptr :=
(Vname1'Access,
@ -400,7 +404,8 @@ package Errout is
Vname5'Access,
Vname6'Access,
Vname7'Access,
Vname8'Access);
Vname8'Access,
Vname9'Access);
-----------------------------------------------------
-- Global Values Used for Error Message Insertions --

30
gcc/ada/get_alfa.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-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- --
@ -51,6 +51,9 @@ procedure Get_Alfa is
-- Local string used to store name of File/entity scanned as
-- Name_Str (1 .. Name_Len).
File_Name : String_Ptr;
Unit_File_Name : String_Ptr;
-----------------------
-- Local Subprograms --
-----------------------
@ -236,15 +239,32 @@ begin
Skip_Spaces;
Cur_File := Get_Nat;
Skip_Spaces;
Get_Name;
File_Name := new String'(Name_Str (1 .. Name_Len));
Skip_Spaces;
-- Scan out unit file name when present (for subunits)
if Nextc = '-' then
Skipc;
Check ('>');
Skip_Spaces;
Get_Name;
Unit_File_Name := new String'(Name_Str (1 .. Name_Len));
else
Unit_File_Name := null;
end if;
-- Make new File table entry (will fill in To_Scope later)
Alfa_File_Table.Append (
(File_Name => new String'(Name_Str (1 .. Name_Len)),
File_Num => Cur_File,
From_Scope => Alfa_Scope_Table.Last + 1,
To_Scope => 0));
(File_Name => File_Name,
Unit_File_Name => Unit_File_Name,
File_Num => Cur_File,
From_Scope => Alfa_Scope_Table.Last + 1,
To_Scope => 0));
-- Initialize counter for scopes

5
gcc/ada/hostparm.ads
View File

@ -69,11 +69,6 @@ package Hostparm is
-- of file names in the library, must be at least Max_Line_Length, but
-- can be larger.
Max_Instantiations : constant := 8000;
-- Maximum number of instantiations permitted (to stop runaway cases
-- of nested instantiations). These situations probably only occur in
-- specially concocted test cases.
Tag_Errors : constant Boolean := False;
-- If set to true, then brief form error messages will be prefaced by
-- the string "error:". Used as default for Opt.Unique_Error_Tag.

23
gcc/ada/lib-xref-alfa.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-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- --
@ -214,6 +214,8 @@ package body Alfa is
S : constant Source_File_Index := Source_Index (U);
File_Name, Unit_File_Name : String_Ptr;
begin
-- Source file could be inexistant as a result of an error, if option
-- gnatQ is used.
@ -275,12 +277,23 @@ package body Alfa is
-- Make entry for new file in file table
Get_Name_String (Reference_Name (S));
File_Name := new String'(Name_Buffer (1 .. Name_Len));
-- For subunits, also retrieve the file name of the unit
if Present (Cunit (Unit (S)))
and then Nkind (Unit (Cunit (Unit (S)))) = N_Subunit
then
Get_Name_String (Reference_Name (Main_Source_File));
Unit_File_Name := new String'(Name_Buffer (1 .. Name_Len));
end if;
Alfa_File_Table.Append (
(File_Name => new String'(Name_Buffer (1 .. Name_Len)),
File_Num => D,
From_Scope => From,
To_Scope => Alfa_Scope_Table.Last));
(File_Name => File_Name,
Unit_File_Name => Unit_File_Name,
File_Num => D,
From_Scope => From,
To_Scope => Alfa_Scope_Table.Last));
end Add_Alfa_File;
--------------------

20
gcc/ada/opt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -931,6 +931,12 @@ package Opt is
-- extension, as set by the appropriate switch. If no switch is given,
-- then this value is initialized by Osint to the appropriate value.
Maximum_Instantiations : Int := 8000;
-- GNAT
-- Maximum number of instantiations permitted (to stop runaway cases
-- of nested instantiations). These situations probably only occur in
-- specially concocted test cases. Can be modified by -gnateinn switch.
Maximum_Processes : Positive := 1;
-- GNATMAKE, GPRMAKE, GPRBUILD
-- Maximum number of processes that should be spawned to carry out
@ -940,12 +946,6 @@ package Opt is
-- GNATMAKE
-- Set to True if minimal recompilation mode requested
Special_Exception_Package_Used : Boolean := False;
-- GNAT
-- Set to True if either of the unit GNAT.Most_Recent_Exception or
-- GNAT.Exception_Traces is with'ed. Used to inhibit transformation of
-- local raise statements into gotos in the presence of either package.
Multiple_Unit_Index : Int;
-- GNAT
-- This is set non-zero if the current unit is being compiled in multiple
@ -1182,6 +1182,12 @@ package Opt is
-- GNAT
-- Set True if a pragma Short_Descriptors applies to the current unit.
Special_Exception_Package_Used : Boolean := False;
-- GNAT
-- Set to True if either of the unit GNAT.Most_Recent_Exception or
-- GNAT.Exception_Traces is with'ed. Used to inhibit transformation of
-- local raise statements into gotos in the presence of either package.
Sprint_Line_Limit : Nat := 72;
-- GNAT
-- Limit values for chopping long lines in Sprint output, can be reset

14
gcc/ada/put_alfa.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011, Free Software Foundation, Inc. --
-- Copyright (C) 2011-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- --
@ -49,6 +49,18 @@ begin
Write_Info_Char (F.File_Name (N));
end loop;
-- If file is a subunit, print the file name for the unit
if F.Unit_File_Name /= null then
Write_Info_Char (' ');
Write_Info_Char ('-');
Write_Info_Char ('>');
Write_Info_Char (' ');
for N in F.Unit_File_Name'Range loop
Write_Info_Char (F.Unit_File_Name (N));
end loop;
end if;
Write_Info_Terminate;
-- Loop through scope entries for this file

9
gcc/ada/sem_attr.adb
View File

@ -28,6 +28,7 @@ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Atree; use Atree;
with Casing; use Casing;
with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Eval_Fat;
@ -54,6 +55,7 @@ with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Dim; use Sem_Dim;
with Sem_Dist; use Sem_Dist;
with Sem_Elab; use Sem_Elab;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
@ -644,6 +646,13 @@ package body Sem_Attr is
Kill_Current_Values;
end if;
-- Treat as call for elaboration purposes and we are all
-- done. Suppress this treatment under debug flag.
if not Debug_Flag_Dot_UU then
Check_Elab_Call (N);
end if;
return;
-- Component is an operation of a protected type

7
gcc/ada/sem_ch12.adb
View File

@ -34,7 +34,6 @@ with Exp_Disp; use Exp_Disp;
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Freeze; use Freeze;
with Hostparm;
with Itypes; use Itypes;
with Lib; use Lib;
with Lib.Load; use Lib.Load;
@ -3784,8 +3783,10 @@ package body Sem_Ch12 is
-- Here is a defence against a ludicrous number of instantiations
-- caused by a circular set of instantiation attempts.
if Pending_Instantiations.Last > Hostparm.Max_Instantiations then
Error_Msg_N ("too many instantiations", N);
if Pending_Instantiations.Last > Maximum_Instantiations then
Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations);
Error_Msg_N ("too many instantiations, exceeds max of^", N);
Error_Msg_N ("\limit can be changed using -gnateinn switch", N);
raise Unrecoverable_Error;
end if;

17
gcc/ada/sem_ch6.adb
View File

@ -6937,6 +6937,10 @@ package body Sem_Ch6 is
Attribute_Result_Mentioned : Boolean := False;
-- Whether attribute 'Result is mentioned in a postcondition
No_Warning_On_Some_Postcondition : Boolean := False;
-- Whether there exists a postcondition or a contract-case without a
-- corresponding warning.
Post_State_Mentioned : Boolean := False;
-- Whether some expression mentioned in a postcondition can have a
-- different value in the post-state than in the pre-state.
@ -7081,7 +7085,9 @@ package body Sem_Ch6 is
Post_State_Mentioned := False;
Ignored := Find_Post_State (Arg);
if not Post_State_Mentioned then
if Post_State_Mentioned then
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N ("?`Ensures` component refers only to pre-state",
Prag);
end if;
@ -7133,7 +7139,9 @@ package body Sem_Ch6 is
Post_State_Mentioned := False;
Ignored := Find_Post_State (Arg);
if not Post_State_Mentioned then
if Post_State_Mentioned then
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N
("?postcondition refers only to pre-state", Prag);
end if;
@ -7177,12 +7185,15 @@ package body Sem_Ch6 is
end if;
-- Issue warning for functions whose postcondition does not mention
-- 'Result after all postconditions have been processed.
-- 'Result after all postconditions have been processed, and provided
-- all postconditions do not already get a warning that they only refer
-- to pre-state.
if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
and then (Present (Last_Postcondition)
or else Present (Last_Contract_Case))
and then not Attribute_Result_Mentioned
and then No_Warning_On_Some_Postcondition
then
if Present (Last_Postcondition) then
if Present (Last_Contract_Case) then

131
gcc/ada/sem_elab.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1997-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- --
@ -180,7 +180,7 @@ package body Sem_Elab is
Inter_Unit_Only : Boolean;
Generate_Warnings : Boolean := True;
In_Init_Proc : Boolean := False);
-- This is the internal recursive routine that is called to check for a
-- This is the internal recursive routine that is called to check for
-- possible elaboration error. The argument N is a subprogram call or
-- generic instantiation to be checked, and E is the entity of the called
-- subprogram, or instantiated generic unit. The flag Outer_Scope is the
@ -188,8 +188,11 @@ package body Sem_Elab is
-- call is only to be checked in the case where it is to another unit (and
-- skipped if within a unit). Generate_Warnings is set to False to suppress
-- warning messages about missing pragma Elaborate_All's. These messages
-- are not wanted for inner calls in the dynamic model. Flag In_Init_Proc
-- should be set whenever the current context is a type init proc.
-- are not wanted for inner calls in the dynamic model. Note that an
-- instance of the Access attribute applied to a subprogram also generates
-- a call to this procedure (since the referenced subprogram may be called
-- later indirectly). Flag In_Init_Proc should be set whenever the current
-- context is a type init proc.
procedure Check_Bad_Instantiation (N : Node_Id);
-- N is a node for an instantiation (if called with any other node kind,
@ -270,6 +273,13 @@ package body Sem_Elab is
-- On entry C_Scope is set to some scope. On return, C_Scope is reset
-- to be the enclosing compilation unit of this scope.
function Get_Referenced_Ent (N : Node_Id) return Entity_Id;
-- N is either a function or procedure call or an access attribute that
-- references a subprogram. This call retrieves the relevant entity. If
-- this is a call to a protected subprogram, the entity is a selected
-- component. The callable entity may be absent, in which case Empty is
-- returned. This happens with non-analyzed calls in nested generics.
procedure Set_Elaboration_Constraint
(Call : Node_Id;
Subp : Entity_Id;
@ -827,14 +837,19 @@ package body Sem_Elab is
-- the init proc is in the root package, and we start from the entity
-- of the name in the call.
if Is_Entity_Name (Name (N))
and then Is_Init_Proc (Entity (Name (N)))
and then not In_Same_Extended_Unit (N, Entity (Name (N)))
then
W_Scope := Scope (Entity (Name (N)));
else
W_Scope := E;
end if;
declare
Ent : constant Entity_Id := Get_Referenced_Ent (N);
begin
if Is_Init_Proc (Ent)
and then not In_Same_Extended_Unit (N, Ent)
then
W_Scope := Scope (Ent);
else
W_Scope := E;
end if;
end;
-- Now loop through scopes to get to the enclosing compilation unit
while not Is_Compilation_Unit (W_Scope) loop
W_Scope := Scope (W_Scope);
@ -1126,36 +1141,6 @@ package body Sem_Elab is
Ent : Entity_Id;
P : Node_Id;
function Get_Called_Ent return Entity_Id;
-- Retrieve called entity. If this is a call to a protected subprogram,
-- entity is a selected component. The callable entity may be absent,
-- in which case there is no check to perform. This happens with
-- non-analyzed calls in nested generics.
--------------------
-- Get_Called_Ent --
--------------------
function Get_Called_Ent return Entity_Id is
Nam : Node_Id;
begin
Nam := Name (N);
if No (Nam) then
return Empty;
elsif Nkind (Nam) = N_Selected_Component then
return Entity (Selector_Name (Nam));
elsif not Is_Entity_Name (Nam) then
return Empty;
else
return Entity (Nam);
end if;
end Get_Called_Ent;
-- Start of processing for Check_Elab_Call
begin
@ -1174,11 +1159,12 @@ package body Sem_Elab is
then
Check_Restriction (No_Entry_Calls_In_Elaboration_Code, N);
-- Nothing to do if this is not a call (happens in some error
-- conditions, and in some cases where rewriting occurs).
-- 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
and then Nkind (N) /= N_Attribute_Reference
then
return;
@ -1267,6 +1253,7 @@ package body Sem_Elab is
if Comes_From_Source (N)
and then In_Preelaborated_Unit
and then not In_Inlined_Body
and then Nkind (N) /= N_Attribute_Reference
then
-- This is a warning in GNAT mode allowing such calls to be
-- used in the predefined library with appropriate care.
@ -1352,12 +1339,10 @@ package body Sem_Elab is
elsif Dynamic_Elaboration_Checks then
-- This is a rather new check, going into version
-- 3.14a1 for the first time (V1.80 of this unit), so
-- we provide a debug flag to enable it. That way we
-- have an easy work around for regressions that are
-- caused by this new check. This debug flag can be
-- removed later.
-- We provide a debug flag to disable this check. That
-- way we have an easy work around for regressions
-- that are caused by this new check. This debug flag
-- can be removed later.
if Debug_Flag_DD then
return;
@ -1373,7 +1358,7 @@ package body Sem_Elab is
-- but we need to capture local suppress pragmas
-- that may inhibit checks on this call.
Ent := Get_Called_Ent;
Ent := Get_Referenced_Ent (N);
if No (Ent) then
return;
@ -1400,7 +1385,7 @@ package body Sem_Elab is
end if;
end if;
Ent := Get_Called_Ent;
Ent := Get_Referenced_Ent (N);
if No (Ent) then
return;
@ -2012,6 +1997,20 @@ package body Sem_Elab is
return OK;
-- If we have an access attribute for a subprogram, check
-- it. Suppress this behavior under debug flag.
elsif not Debug_Flag_Dot_UU
and then Nkind (N) = N_Attribute_Reference
and then (Attribute_Name (N) = Name_Access
or else
Attribute_Name (N) = Name_Unrestricted_Access)
and then Is_Entity_Name (Prefix (N))
and then Is_Subprogram (Entity (Prefix (N)))
then
Check_Elab_Call (N, Outer_Scope);
return OK;
-- If we have a generic instantiation, check it
elsif Nkind (N) in N_Generic_Instantiation then
@ -2605,6 +2604,34 @@ package body Sem_Elab is
Set_Suppress_Elaboration_Warnings (Elab_Unit, True);
end Set_Elaboration_Constraint;
------------------------
-- Get_Referenced_Ent --
------------------------
function Get_Referenced_Ent (N : Node_Id) return Entity_Id is
Nam : Node_Id;
begin
if Nkind (N) = N_Attribute_Reference then
Nam := Prefix (N);
else
Nam := Name (N);
end if;
if No (Nam) then
return Empty;
elsif Nkind (Nam) = N_Selected_Component then
return Entity (Selector_Name (Nam));
elsif not Is_Entity_Name (Nam) then
return Empty;
else
return Entity (Nam);
end if;
end Get_Referenced_Ent;
----------------------
-- Has_Generic_Body --
----------------------

7
gcc/ada/sem_elab.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1997-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,8 +122,9 @@ package Sem_Elab is
(N : Node_Id;
Outer_Scope : Entity_Id := Empty;
In_Init_Proc : Boolean := False);
-- Check a call for possible elaboration problems. The node N is either
-- an N_Function_Call or N_Procedure_Call_Statement node. The Outer_Scope
-- Check a call for possible elaboration problems. The node N is either an
-- N_Function_Call or N_Procedure_Call_Statement node or an access
-- attribute reference whose prefix is a subprogram. The Outer_Scope
-- argument indicates whether this is an outer level call from Sem_Res
-- (Outer_Scope set to Empty), or an internal recursive call (Outer_Scope
-- set to entity of outermost call, see body). Flag In_Init_Proc should be

9
gcc/ada/switch-c.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -482,6 +482,13 @@ package body Switch.C is
Generate_Processed_File := True;
Ptr := Ptr + 1;
-- -gnatei (max number of instantiations)
when 'i' =>
Ptr := Ptr + 1;
Scan_Pos
(Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
-- -gnateI (index of unit in multi-unit source)
when 'I' =>

7
gcc/ada/switch.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -123,9 +123,8 @@ private
Ptr : in out Integer;
Result : out Pos;
Switch : Character);
-- Scan positive integer parameter for switch. On entry, Ptr points just
-- past the switch character, on exit it points past the last digit of the
-- integer value.
-- Scan positive integer parameter for switch. Identical to Scan_Nat with
-- same parameters except that zero is considered out of range.
procedure Bad_Switch (Switch : Character);
procedure Bad_Switch (Switch : String);

7
gcc/ada/usage.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- --
@ -197,6 +197,11 @@ begin
Write_Switch_Char ("eG");
Write_Line ("Generate preprocessed source");
-- Line for -gnatei switch
Write_Switch_Char ("einn");
Write_Line ("Set maximumum number of instantiations to nn");
-- Line for -gnateI switch
Write_Switch_Char ("eInn");

20
gcc/ada/vms_data.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
@ -1926,11 +1926,14 @@ package VMS_Data is
-- When using a project file, GNAT MAKE creates a temporary mapping file
-- and communicates it to the compiler using this switch.
S_GCC_Multi : aliased constant S := "/MULTI_UNIT_INDEX=#" &
"-gnateI#";
-- /MULTI_UNIT_INDEX=nnn
S_GCC_MaxI : aliased constant S := "/MAX_INSTANTIATIONS=#" &
"-gnatei#";
-- /MAX_INSTANTIATIONS=nnn
--
-- Specify the index of the unit to compile in a multi-unit source file.
-- Specify the maximum number of instantiations permitted. The default
-- value is 8000, which is probably enough for all programs except those
-- containing some kind of runaway unintended instantiation loop.
S_GCC_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
@ -1951,6 +1954,12 @@ package VMS_Data is
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_GCC_Multi : aliased constant S := "/MULTI_UNIT_INDEX=#" &
"-gnateI#";
-- /MULTI_UNIT_INDEX=nnn
--
-- Specify the index of the unit to compile in a multi-unit source file.
S_GCC_Nesting : aliased constant S := "/MAX_NESTING=#" &
"-gnatyL#";
-- /MAX_NESTING=nnn
@ -3585,6 +3594,7 @@ package VMS_Data is
S_GCC_Output 'Access,
S_GCC_Machine 'Access,
S_GCC_Mapping 'Access,
S_GCC_MaxI 'Access,
S_GCC_Multi 'Access,
S_GCC_Mess 'Access,
S_GCC_Nesting 'Access,