This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] ada: Do not let a type in an aggregate be an ancestor of itself


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]