From: Samuel Tardieu <sam@rfc1149.net>
Date: Sun, 13 Apr 2008 18:15:20 +0000 (+0000)
Subject: re PR ada/17985 (GNAT accepts extension aggregate where expexted type is not extension)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=92d4508a7db153423b0572047fa6947af569d4b6;p=gcc.git

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 b6f61398b40..75314119fc6 100644
--- 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 f930ecbf14c..5c7d9bd7dda 100644
--- 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 4c4feb17755..6932bedb8f4 100644
--- 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
index 00000000000..b5e9e2c5c1d
--- /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
index 00000000000..2ed1f19c2c8
--- /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;