2010-10-05 Robert Dewar <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.
	* a-direct.ads: Minor comment update.

2010-10-05  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Removing code that is
	no longer required after change in New_Overloaded_Entity.
	* sem_ch6.adb (New_Overloaded_Entity): Code reorganization to isolate
	the fragment of code that handles derivations of interface primitives.
	Add missing dependence on global variable Inside_Freezing_Actions to
	ensure the correct management of internal interface entities.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing increase/decrease
	of the global variable Inside_Freezing_Actions to ensure that internal
	interface entities are well handled by New_Overloaded_Entity.
	* sem_disp.adb (Find_Primitive_Covering_Interface): Add documentation
	and complete the algorithm to catch hidden primitives derived of
	private type that covers the interface.
	* sem_disp.ads (Find_Primitive_Covering_Interface): Add missing
	documentation.



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

1 files changed, 31 insertions, 6 deletions

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 0cec5546faa..3c295f94ca3 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1661,7 +1661,9 @@ package body Sem_Disp is
                      Is_Interface
                        (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
 
-      --  Search in the homonym chain
+      --  Search in the homonym chain. Done to speed up locating visible
+      --  entities and required to catch primitives associated with the partial
+      --  view of private types when processing the corresponding full view.
 
       E := Current_Entity (Iface_Prim);
       while Present (E) loop
@@ -1675,16 +1677,39 @@ package body Sem_Disp is
          E := Homonym (E);
       end loop;
 
-      --  Search in the list of primitives of the type
+      --  Search in the list of primitives of the type. Required to locate the
+      --  covering primitive if the covering primitive is not visible (for
+      --  example, non-visible inherited primitive of private type).
 
       El := First_Elmt (Primitive_Operations (Tagged_Type));
       while Present (El) loop
          E := Node (El);
 
-         if No (Interface_Alias (E))
-           and then Alias (E) = Iface_Prim
-         then
-            return Node (El);
+         --  Keep separate the management of internal entities that link
+         --  primitives with interface primitives from tagged type primitives.
+
+         if No (Interface_Alias (E)) then
+            if Present (Alias (E)) then
+
+               --  This interface primitive has not been covered yet
+
+               if Alias (E) = Iface_Prim then
+                  return E;
+
+               --  The covering primitive was inherited
+
+               elsif Overridden_Operation (Ultimate_Alias (E))
+                       = Iface_Prim
+               then
+                  return E;
+               end if;
+            end if;
+
+         --  Use the internal entity that links the interface primitive with
+         --  the covering primitive to locate the entity
+
+         elsif Interface_Alias (E) = Iface_Prim then
+            return Alias (E);
          end if;
 
          Next_Elmt (El);