[multiple changes]

2012-03-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb (Get_Discriminant_Value): Instead of looking
	at the immediate correcponsing discriminant, traverse a
	potential chain of discriminants produced by type derivations.
	(Root_Corresponding_Discriminant): Traverse a chain of inherited
	discriminants and return the topmost discriminant.

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

	* debug.adb: Minor comment change.
	* gnat_ugn.texi: Update documentation for elaboration regarding
	indirect calls.

2012-03-19  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): In
	the case of an object of a class-wide interface type, where the
	declaration is rewritten as a renaming, call Set_Debug_Info_Needed
	on the renaming entity so that Materialize_Entity will be
	set. Also, change existing call (for other than interface cases)
	to call Set_Debug_Info_Needed rather than Set_Needs_Debug_Info
	(as specified for that flag).

From-SVN: r185526

5 files changed, 78 insertions, 37 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 956ff44..5966f5e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 2012-03-19  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_ch3.adb (Get_Discriminant_Value): Instead of looking
+	at the immediate correcponsing discriminant, traverse a
+	potential chain of discriminants produced by type derivations.
+	(Root_Corresponding_Discriminant): Traverse a chain of inherited
+	discriminants and return the topmost discriminant.
+
+2012-03-19  Bob Duff  <duff@adacore.com>
+
+	* debug.adb: Minor comment change.
+	* gnat_ugn.texi: Update documentation for elaboration regarding
+	indirect calls.
+
+2012-03-19  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): In
+	the case of an object of a class-wide interface type, where the
+	declaration is rewritten as a renaming, call Set_Debug_Info_Needed
+	on the renaming entity so that Materialize_Entity will be
+	set. Also, change existing call (for other than interface cases)
+	to call Set_Debug_Info_Needed rather than Set_Needs_Debug_Info
+	(as specified for that flag).
+
+2012-03-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* sem_ch4.adb (Analyze_Allocator): Detect an allocator generated
 	by the build-in-place machinery where the designated type is
 	indefinite, but the underlying type is not. Do not emit errors
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index a420704..032ba9d 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -646,7 +646,8 @@ package body Debug is
    --       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.
+   --       reverts to the behavior of earlier compilers, which ignored
+   --       indirect calls.
 
    --  d.W  Print out debugging information for Walk_Library_Items, including
    --       the order in which units are walked. This is primarily for use in
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 41fc6f3..9f6e565 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4820,6 +4820,17 @@ package body Exp_Ch3 is
                       Subtype_Mark        => New_Occurrence_Of (Typ, Loc),
                       Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
 
+                  --  If the original entity comes from source, then mark the
+                  --  new entity as needing debug information, even though it's
+                  --  defined by a generated renaming that does not come from
+                  --  source, so that Materialize_Entity will be set on the
+                  --  entity when Debug_Renaming_Declaration is called during
+                  --  analysis.
+
+                  if Comes_From_Source (Def_Id) then
+                     Set_Debug_Info_Needed (Defining_Identifier (N));
+                  end if;
+
                   Analyze (N, Suppress => All_Checks);
 
                   --  Replace internal identifier of rewritten node by the
@@ -5065,7 +5076,7 @@ package body Exp_Ch3 is
             --  renaming that does not come from source.
 
             if Comes_From_Source (Defining_Identifier (N)) then
-               Set_Needs_Debug_Info (Defining_Identifier (N));
+               Set_Debug_Info_Needed (Defining_Identifier (N));
             end if;
 
             --  Now call the routine to generate debug info for the renaming
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b8539f0..9022276 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -601,7 +601,7 @@ Elaboration Order Handling in GNAT
 * Elaboration Issues for Library Tasks::
 * Mixing Elaboration Models::
 * What to Do If the Default Elaboration Behavior Fails::
-* Elaboration for Access-to-Subprogram Values::
+* Elaboration for Dispatching Calls::
 * Summary of Procedures for Elaboration Control::
 * Other Elaboration Order Considerations::
 
@@ -23279,7 +23279,7 @@ elaboration code in your own application).
 * Elaboration Issues for Library Tasks::
 * Mixing Elaboration Models::
 * What to Do If the Default Elaboration Behavior Fails::
-* Elaboration for Access-to-Subprogram Values::
+* Elaboration for Dispatching Calls::
 * Summary of Procedures for Elaboration Control::
 * Other Elaboration Order Considerations::
 @end menu
@@ -24936,39 +24936,22 @@ elaboration switch if your code is correct, and we assume that the
 C-tests are indeed correct (it is less efficient, but efficiency is
 not a factor in running the ACVC tests.)
 
-@node Elaboration for Access-to-Subprogram Values
-@section Elaboration for Access-to-Subprogram Values
-@cindex Access-to-subprogram
-
-@noindent
-Access-to-subprogram types (introduced in Ada 95) complicate
-the handling of elaboration. The trouble is that it becomes
-impossible to tell at compile time which procedure
-is being called. This means that it is not possible for the binder
-to analyze the elaboration requirements in this case.
-
-If at the point at which the access value is created
-(i.e., the evaluation of @code{P'Access} for a subprogram @code{P}),
-the body of the subprogram is
-known to have been elaborated, then the access value is safe, and its use
-does not require a check. This may be achieved by appropriate arrangement
-of the order of declarations if the subprogram is in the current unit,
-or, if the subprogram is in another unit, by using pragma
-@code{Pure}, @code{Preelaborate}, or @code{Elaborate_Body}
-on the referenced unit.
-
-If the referenced body is not known to have been elaborated at the point
-the access value is created, then any use of the access value must do a
-dynamic check, and this dynamic check will fail and raise a
-@code{Program_Error} exception if the body has not been elaborated yet.
-GNAT will generate the necessary checks, and in addition, if the
-@option{-gnatwl}
-switch is set, will generate warnings that such checks are required.
+@node Elaboration for Dispatching Calls
+@section Elaboration for Dispatching Calls
+@cindex Dispatching calls
 
-The use of dynamic dispatching for tagged types similarly generates
-a requirement for dynamic checks, and premature calls to any primitive
+@noindent
+In rare cases, the static elaboration model fails to prevent
+dispatching calls to not-yet-elaborated subprograms. In such cases, we
+fall back to run-time checks; premature calls to any primitive
 operation of a tagged type before the body of the operation has been
-elaborated, will result in the raising of @code{Program_Error}.
+elaborated will raise @code{Program_Error}.
+
+Access-to-subprogram types, however, are handled conservatively, and
+do not require run-time checks. This was not true in earlier versions
+of the compiler; you can use the @option{-gnatd.U} debug switch to
+revert to the old behavior if the new conservative behavior causes
+elaboration cycles.
 
 @node Summary of Procedures for Elaboration Control
 @section Summary of Procedures for Elaboration Control
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 71b1fb4..443c2d1 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -15601,6 +15601,11 @@ package body Sem_Ch3 is
       Typ_For_Constraint : Entity_Id;
       Constraint         : Elist_Id) return Node_Id
    is
+      function Root_Corresponding_Discriminant
+        (Discr : Entity_Id) return Entity_Id;
+      --  Given a discriminant, traverse the chain of inherited discriminants
+      --  and return the topmost discriminant.
+
       function Search_Derivation_Levels
         (Ti                    : Entity_Id;
          Discrim_Values        : Elist_Id;
@@ -15608,6 +15613,23 @@ package body Sem_Ch3 is
       --  This is the routine that performs the recursive search of levels
       --  as described above.
 
+      -------------------------------------
+      -- Root_Corresponding_Discriminant --
+      -------------------------------------
+
+      function Root_Corresponding_Discriminant
+        (Discr : Entity_Id) return Entity_Id
+      is
+         D : Entity_Id := Discr;
+
+      begin
+         while Present (Corresponding_Discriminant (D)) loop
+            D := Corresponding_Discriminant (D);
+         end loop;
+
+         return D;
+      end Root_Corresponding_Discriminant;
+
       ------------------------------
       -- Search_Derivation_Levels --
       ------------------------------
@@ -15782,7 +15804,7 @@ package body Sem_Ch3 is
 
       --  ??? hack to disappear when this routine is gone
 
-      if  Nkind (Result) = N_Defining_Identifier then
+      if Nkind (Result) = N_Defining_Identifier then
          declare
             D : Entity_Id;
             E : Elmt_Id;
@@ -15791,7 +15813,7 @@ package body Sem_Ch3 is
             D := First_Discriminant (Typ_For_Constraint);
             E := First_Elmt (Constraint);
             while Present (D) loop
-               if Corresponding_Discriminant (D) = Discriminant then
+               if Root_Corresponding_Discriminant (D) = Discriminant then
                   return Node (E);
                end if;