summaryrefslogtreecommitdiffstats
path: root/gcc/ada
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-03-15 09:15:49 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-03-15 09:15:49 +0000
commitde2e64645bc50b7f6715db7d7494a476974acf10 (patch)
treec43cf174da633a8771c76dd0a61ddba4871bb105 /gcc/ada
parent239fc533cb12020656298cba912ac9e31bf9cf96 (diff)
downloadppe42-gcc-de2e64645bc50b7f6715db7d7494a476974acf10.tar.gz
ppe42-gcc-de2e64645bc50b7f6715db7d7494a476974acf10.zip
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@185422 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog41
-rw-r--r--gcc/ada/alfa.ads10
-rw-r--r--gcc/ada/debug.adb8
-rw-r--r--gcc/ada/errout.ads9
-rw-r--r--gcc/ada/get_alfa.adb30
-rw-r--r--gcc/ada/hostparm.ads5
-rw-r--r--gcc/ada/lib-xref-alfa.adb23
-rw-r--r--gcc/ada/opt.ads20
-rw-r--r--gcc/ada/put_alfa.adb14
-rw-r--r--gcc/ada/sem_attr.adb9
-rw-r--r--gcc/ada/sem_ch12.adb7
-rw-r--r--gcc/ada/sem_ch6.adb17
-rw-r--r--gcc/ada/sem_elab.adb131
-rw-r--r--gcc/ada/sem_elab.ads7
-rw-r--r--gcc/ada/switch-c.adb9
-rw-r--r--gcc/ada/switch.ads7
-rw-r--r--gcc/ada/usage.adb7
-rw-r--r--gcc/ada/vms_data.ads20
18 files changed, 274 insertions, 100 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1617c1a3e09..9fa56eb335b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads
index 7531f9e4b34..26c8247ccc6 100644
--- a/gcc/ada/alfa.ads
+++ b/gcc/ada/alfa.ads
@@ -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
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 3fd2d645115..a4207044297 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -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.
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index dc444f04b81..13ce3ac42e0 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -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 --
diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb
index 8c90f754d9a..a10637cd360 100644
--- a/gcc/ada/get_alfa.adb
+++ b/gcc/ada/get_alfa.adb
@@ -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
diff --git a/gcc/ada/hostparm.ads b/gcc/ada/hostparm.ads
index 67a7f1d4c3c..ebecd5ceeff 100644
--- a/gcc/ada/hostparm.ads
+++ b/gcc/ada/hostparm.ads
@@ -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.
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index cc0aa3ac84d..c1c6b25ca9c 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -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;
--------------------
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 555283c6278..5fcd0bf3119 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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
diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb
index 49dfac87df1..a5580a8018c 100644
--- a/gcc/ada/put_alfa.adb
+++ b/gcc/ada/put_alfa.adb
@@ -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
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f007a9dafe6..084e621dad7 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5ab842d3673..054772964ef 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d9be307600d..a2d729c72cf 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 6df8c3249b4..2656f46de5b 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -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 --
----------------------
diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads
index 2bea37dbe5f..abae4dd56c6 100644
--- a/gcc/ada/sem_elab.ads
+++ b/gcc/ada/sem_elab.ads
@@ -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
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index e900faa4bd2..cece29465c8 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -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' =>
diff --git a/gcc/ada/switch.ads b/gcc/ada/switch.ads
index b55e2fcf0de..5f02ba2a164 100644
--- a/gcc/ada/switch.ads
+++ b/gcc/ada/switch.ads
@@ -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);
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index c4e7176875b..637097bf5b6 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.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- --
@@ -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");
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 12eca51a7b0..f89ab630449 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -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,
OpenPOWER on IntegriCloud