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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 411f7fc149fcdc9b585db0608bf889ede4e3081c..98ca249925115c3424c39f9e169a342b35d2cb96 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+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:

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 4f618213fcd16dd5c5aecfc919e5976d04aa714d..0c445dbe75d306a2cd8c2fd772efeeb9dd6ab838 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/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);

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index f8bd8d4985346cd4d634b6094d9b56bfd1ba34cf..afd6451e7ea618b29f9c197c7c8545503ea16d95 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/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

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 895491e302b1a4075fd4ea53b907b90f2595c179..26470b61a3716bbbbc27c655912d1096166bf3fa 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/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.