From: Javier Miranda <miranda@adacore.com>
Date: Wed, 28 May 2008 12:36:07 +0000 (+0000)
Subject: sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support for user-defined... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8c3dd7a8feca9a952b4438eafff304c2c838f3d4;p=gcc.git

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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 411f7fc149f..98ca2499251 100644
--- 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 4f618213fcd..0c445dbe75d 100644
--- 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 f8bd8d49853..afd6451e7ea 100644
--- 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 895491e302b..26470b61a37 100644
--- 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.