sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support for user-defined…

sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support for user-defined predefined primitives.

2008-05-28  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support
	for user-defined predefined primitives.
	
	* sem_util.adb (Matches_Prefixed_View_Profile): Ditto.
	(Find_Overridden_Synchronized_Primitive): Ditto.

	* sem_ch6.adb (Check_Synchronized_Overriding): Ditto.

From-SVN: r136072

gcc/ada/ChangeLog

+2008-05-28  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support
+	for user-defined predefined primitives.
+	
+	* sem_util.adb (Matches_Prefixed_View_Profile): Ditto.
+	(Find_Overridden_Synchronized_Primitive): Ditto.
+
+	* sem_ch6.adb (Check_Synchronized_Overriding): Ditto.
+
 2008-05-27  Arnaud Charlet  <charlet@adacore.com>
 
 	* a-ststio.adb, s-direio.adb:

gcc/ada/sem_ch3.adb

@@ -11391,7 +11391,9 @@ package body Sem_Ch3 is
             while Present (Prim_Elmt) loop
                Iface_Subp := Node (Prim_Elmt);
 
-               if not Is_Predefined_Dispatching_Operation (Iface_Subp) then
+               if not Is_Predefined_Dispatching_Operation (Iface_Subp)
+                 or else Comes_From_Source (Iface_Subp)
+               then
                   E := Find_Primitive_Covering_Interface
                          (Tagged_Type => Tagged_Type,
                           Iface_Prim  => Iface_Subp);

gcc/ada/sem_ch6.adb

@@ -6434,6 +6434,10 @@ package body Sem_Ch6 is
          elsif Present (First_Formal (Def_Id)) then
             Formal_Typ := Etype (First_Formal (Def_Id));
 
+            if Is_Access_Type (Formal_Typ) then
+               Formal_Typ := Directly_Designated_Type (Formal_Typ);
+            end if;
+
             if Is_Concurrent_Type (Formal_Typ)
               and then not Is_Generic_Actual_Type (Formal_Typ)
             then

gcc/ada/sem_util.adb

@@ -3034,9 +3034,18 @@ package body Sem_Util is
          while Present (Iface_Param) and then Present (Prim_Param) loop
             Iface_Id  := Defining_Identifier (Iface_Param);
             Iface_Typ := Find_Parameter_Type (Iface_Param);
+
+            if Is_Access_Type (Iface_Typ) then
+               Iface_Typ := Directly_Designated_Type (Iface_Typ);
+            end if;
+
             Prim_Id   := Defining_Identifier (Prim_Param);
             Prim_Typ  := Find_Parameter_Type (Prim_Param);
 
+            if Is_Access_Type (Prim_Typ) then
+               Prim_Typ := Directly_Designated_Type (Prim_Typ);
+            end if;
+
             --  Case of multiple interface types inside a parameter profile
 
             --     (Obj_Param : in out Iface; ...; Param : Iface)
@@ -3099,6 +3108,10 @@ package body Sem_Util is
          return Empty;
       end if;
 
+      if Is_Access_Type (Tag_Typ) then
+         Tag_Typ := Directly_Designated_Type (Tag_Typ);
+      end if;
+
       --  Traverse the homonym chain, looking at a potentially overridden
       --  subprogram that belongs to an implemented interface.