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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134244 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b6f6139..7531411 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 f930ecb..5c7d9bd 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 4c4feb1..6932bed 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;