[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

gcc/ada/ChangeLog

+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.

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
 

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.

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

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
 

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.

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

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

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

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

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;
 

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

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

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

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

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

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

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,