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

    gcc/ada/
	PR ada/17985
	* sem_aggr.adb (Valid_Ancestor_Type): A type is not an ancestor of
	itself.

    gcc/testsuite/
	PR ada/17985
	* gnat.dg/ancestor_type.ads, gnat.dg/ancestor_type.adb: New test.

From-SVN: r134244

gcc/ada/ChangeLog

+2008-04-13  Samuel Tardieu  <sam@rfc1149.net> 
+
+	PR ada/17985
+	* sem_aggr.adb (Valid_Ancestor_Type): A type is not an ancestor of
+	itself.
+
 2008-04-13  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
 
 	* sfn_scan.adb, sfn_scan.ads, sinfo.ads,

gcc/ada/sem_aggr.adb

@@ -2159,7 +2159,9 @@ package body Sem_Aggr is
             Imm_Type := Etype (Base_Type (Imm_Type));
          end loop;
 
-         if Etype (Imm_Type) /= Base_Type (A_Type) then
+         if Etype (Imm_Type) /= Base_Type (A_Type)
+           or else Base_Type (Typ) = Base_Type (A_Type)
+         then
             Error_Msg_NE ("expect ancestor type of &", A, Typ);
             return False;
          else

gcc/testsuite/ChangeLog

+2008-04-13  Samuel Tardieu  <sam@rfc1149.net> 
+
+	PR ada/17985
+	* gnat.dg/ancestor_type.ads, gnat.dg/ancestor_type.adb: New test.
+
 2008-04-12  Andrew Pinski  <pinskia@gmail.com>
 
 	* gcc.target/powerpc/darwin-save-world-1.c: New test.

gcc/testsuite/gnat.dg/ancestor_type.adb

+-- { dg-do compile }
+
+package body Ancestor_Type is
+
+   package body B is
+      function make return T is
+      begin
+         return (T with n => 0);  -- { dg-error "expect ancestor" }
+      end make;
+
+   end B;
+
+end Ancestor_Type;

gcc/testsuite/gnat.dg/ancestor_type.ads

+package Ancestor_Type is
+
+   type T is tagged private;
+
+   package B is
+      function make return T;
+   end B;
+
+private
+   type T is tagged record
+      n: Natural;
+   end record;
+end Ancestor_Type;