From: Samuel Tardieu 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 + + PR ada/17985 + * sem_aggr.adb (Valid_Ancestor_Type): A type is not an ancestor of + itself. + 2008-04-13 Ralf Wildenhues * 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 + + PR ada/17985 + * gnat.dg/ancestor_type.ads, gnat.dg/ancestor_type.adb: New test. + 2008-04-12 Andrew Pinski * 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;