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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b6f61398b4079b4be6ddbccd1c466c1ff5b97bff..75314119fc6115347c6251f7632c70c94c745020 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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,

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index f930ecbf14c4aadc172af413c363385f28d70bb2..5c7d9bd7dda04586475f87032508fc0e14952bb4 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4c4feb177559a9d20c1f9ebed388549b61a9c6f5..6932bedb8f47100e6e5350a0a26d05971084aa91 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/ancestor_type.adb b/gcc/testsuite/gnat.dg/ancestor_type.adb
new file mode 100644 (file)
index 0000000..b5e9e2c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/ancestor_type.adb
@@ -0,0 +1,13 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/ancestor_type.ads b/gcc/testsuite/gnat.dg/ancestor_type.ads
new file mode 100644 (file)
index 0000000..2ed1f19
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/ancestor_type.ads
@@ -0,0 +1,13 @@
+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;