re PR ada/17985 (GNAT accepts extension aggregate where expexted type is not extension)

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

	* sem_aggr.adb: Update comments.
	Improve previous change for PR ada/17985

From-SVN: r135636

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 051a650f9c26943e20288ec240ad0cb6bb61ea1d..21d620716f0437869de348f692a868a5bdc36e1e 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2113,7 +2113,7 @@ package body Sem_Aggr is
 
       function Valid_Ancestor_Type return Boolean;
       --  Verify that the type of the ancestor part is a non-private ancestor
-      --  of the expected type.
+      --  of the expected type, which must be a type extension.
 
       ----------------------------
       -- Valid_Limited_Ancestor --
@@ -2159,8 +2159,8 @@ package body Sem_Aggr is
             Imm_Type := Etype (Base_Type (Imm_Type));
          end loop;
 
-         if Etype (Imm_Type) /= Base_Type (A_Type)
-           or else Base_Type (Typ) = Base_Type (A_Type)
+         if not Is_Derived_Type (Base_Type (Typ))
+           or else Etype (Imm_Type) /= Base_Type (A_Type)
          then
             Error_Msg_NE ("expect ancestor type of &", A, Typ);
             return False;