This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] ada: Do not let a type in an aggregate be an ancestor of itself
- From: Samuel Tardieu <sam at rfc1149 dot net>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 29 Nov 2007 11:43:44 +0100
- Subject: [PATCH] ada: Do not let a type in an aggregate be an ancestor of itself
- Organisation: RFC1149 (see http://www.rfc1149.net/)
Regression-tested on i686-pc-linux-gnu.
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.
---
gcc/ada/sem_aggr.adb | 4 +++-
gcc/testsuite/gnat.dg/ancestor_type.adb | 13 +++++++++++++
gcc/testsuite/gnat.dg/ancestor_type.ads | 13 +++++++++++++
3 files changed, 29 insertions(+), 1 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/ancestor_type.adb
create mode 100644 gcc/testsuite/gnat.dg/ancestor_type.ads
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 3d5b62d..5a3103e 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2005,7 +2005,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/gnat.dg/ancestor_type.adb b/gcc/testsuite/gnat.dg/ancestor_type.adb
new file mode 100644
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
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;
--
1.5.3.6