2008-04-08 Ed Schonberg <schonberg@adacore.com>

	    Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* lib-xref.adb (Is_On_LHS): Remove dead code
	(Output_Overriden_Op): If the overridden operation is itself inherited,
	list the ancestor operation, which is the one whose body or absstract
	specification is actually being overridden.

	* sem_ch7.adb (Is_Primitive_Of): use base type to determine whether
	operation is primitive for the type.
	(Declare_Inherited_Private_Subprograms): If the new operation overrides
	an inherited private subprogram, set properly the Overridden_Operation
	attribute, for better cross-reference information.
	(Analyze_Package_Specification): Do late analysis of spec PPCs
	(Install_Private_Declaration, Uninstall_Declarations): Save/restore
	properly the full view and underlying full views of a private type in a
	child unit, whose full view is derived from a private type in a parent
	unit, and whose own full view becomes visible in the child body.

	* sem_disp.adb (Check_Dispatching_Operation): When a body declares a
	primitive operation after the type has been frozen, add an explicit
	reference to the type and the operation, because other primitive
	references have been emitted already.
	(Expand_Call, Propagate_Tag): Call Kill_Current_Values when processing a
	dispatching call on VM targets.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134038 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 14 insertions, 0 deletions

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 1652a82fc67..c990800ac56 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -31,6 +31,7 @@ with Exp_Disp; use Exp_Disp;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Tss;  use Exp_Tss;
 with Errout;   use Errout;
+with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -790,6 +791,9 @@ package body Sem_Disp is
                      --  if the subprogram is already frozen, we must update
                      --  its dispatching information explicitly here. The
                      --  information is taken from the overridden subprogram.
+                     --  We must also generate a cross-reference entry because
+                     --  references to other primitives were already created
+                     --  when type was frozen.
 
                      Body_Is_Last_Primitive := True;
 
@@ -819,6 +823,8 @@ package body Sem_Disp is
                                 Prim    => Subp,
                                 Ins_Nod => Subp_Body);
                            end if;
+
+                           Generate_Reference (Tagged_Type, Subp, 'p', False);
                         end if;
                      end if;
                   end if;
@@ -1543,6 +1549,14 @@ package body Sem_Disp is
 
       if VM_Target = No_VM then
          Expand_Dispatching_Call (Call_Node);
+
+      --  Expansion of a dispatching call results in an indirect call, which in
+      --  turn causes current values to be killed (see Resolve_Call), so on VM
+      --  targets we do the call here to ensure consistent warnings between VM
+      --  and non-VM targets.
+
+      else
+         Kill_Current_Values;
       end if;
    end Propagate_Tag;