From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 28 May 2008 13:05:20 +0000 (+0200)
Subject: sem_ch3.adb (Diagnose_Interface): Cleanup error messages involving improper progenito... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6765b310618f5ce2cdd780f06b3653ecff8e355c;p=gcc.git

sem_ch3.adb (Diagnose_Interface): Cleanup error messages involving improper progenitor names...

2008-05-28  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Diagnose_Interface): Cleanup error messages involving
	improper progenitor names, and avoid cascaded errors.

From-SVN: r136077
---

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0c445dbe75d..b67a2ceeb6b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -712,6 +712,10 @@ package body Sem_Ch3 is
    --  E is some record type. This routine computes E's Stored_Constraint
    --  from its Discriminant_Constraint.
 
+   procedure Diagnose_Interface (N : Node_Id;  E : Entity_Id);
+   --  Check that an entity in a list of progenitors is an interface,
+   --  emit error otherwise.
+
    -----------------------
    -- Access_Definition --
    -----------------------
@@ -3098,10 +3102,7 @@ package body Sem_Ch3 is
             while Present (Intf) loop
                T := Find_Type_Of_Subtype_Indic (Intf);
 
-               if not Is_Interface (T) then
-                  Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T);
-               end if;
-
+               Diagnose_Interface (Intf, T);
                Next (Intf);
             end loop;
          end;
@@ -8660,8 +8661,7 @@ package body Sem_Ch3 is
             Iface_Def   := Type_Definition (Parent_Node);
 
             if not Is_Interface (Iface_Typ) then
-               Error_Msg_NE ("(Ada 2005) & must be an interface",
-                          Iface, Iface_Typ);
+               Diagnose_Interface (Iface, Iface_Typ);
 
             else
                Check_Ifaces (Iface_Def, Iface);
@@ -8701,8 +8701,7 @@ package body Sem_Ch3 is
          Iface_Def   := Type_Definition (Parent_Node);
 
          if not Is_Interface (Iface_Typ) then
-            Error_Msg_NE ("(Ada 2005) & must be an interface",
-                          Iface, Iface_Typ);
+            Diagnose_Interface (Iface, Iface_Typ);
 
          else
             --  "The declaration of a specific descendant of an interface
@@ -12443,8 +12442,7 @@ package body Sem_Ch3 is
 
       if Interface_Present (Def) then
          if not Is_Interface (Parent_Type) then
-            Error_Msg_NE
-              ("(Ada 2005) & must be an interface", Indic, Parent_Type);
+            Diagnose_Interface (Indic, Parent_Type);
 
          else
             Parent_Node := Parent (Base_Type (Parent_Type));
@@ -12537,7 +12535,7 @@ package body Sem_Ch3 is
                T := Find_Type_Of_Subtype_Indic (Intf);
 
                if not Is_Interface (T) then
-                  Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T);
+                  Diagnose_Interface (Intf, T);
 
                --  Check the rules of 3.9.4(12/2) and 7.5(2/2) that disallow
                --  a limited type from having a nonlimited progenitor.
@@ -12850,6 +12848,19 @@ package body Sem_Ch3 is
       end if;
    end Derived_Type_Declaration;
 
+   ------------------------
+   -- Diagnose_Interface --
+   ------------------------
+
+   procedure Diagnose_Interface (N : Node_Id;  E : Entity_Id) is
+   begin
+      if not Is_Interface (E)
+        and then  E /= Any_Type
+      then
+         Error_Msg_NE ("(Ada 2005) & must be an interface", N, E);
+      end if;
+   end Diagnose_Interface;
+
    ----------------------------------
    -- Enumeration_Type_Declaration --
    ----------------------------------