From 9422c886e9405ea2fe5a5f1a0152b301e8ae1204 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 6 May 2012 11:13:32 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): In the renaming case... * gcc-interface/decl.c (gnat_to_gnu_entity) : In the renaming case, use the padded type if the renamed object has an unconstrained type with default discriminant. From-SVN: r187209 --- gcc/ada/ChangeLog | 10 +++++++-- gcc/ada/gcc-interface/decl.c | 8 +++++++ gcc/testsuite/ChangeLog | 16 +++++++++++--- .../gnat.dg/specs/{renamings.ads => renaming1.ads} | 6 ++++-- gcc/testsuite/gnat.dg/specs/renaming2.ads | 11 ++++++++++ gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads | 17 +++++++++++++++ gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads | 14 ++++++++++++ gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads | 25 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb | 12 +++++++++++ gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads | 25 ++++++++++++++++++++++ 10 files changed, 137 insertions(+), 7 deletions(-) rename gcc/testsuite/gnat.dg/specs/{renamings.ads => renaming1.ads} (85%) create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb create mode 100644 gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 803e97b..856d100 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,9 +1,15 @@ 2012-05-06 Eric Botcazou + * gcc-interface/decl.c (gnat_to_gnu_entity) : In the renaming + case, use the padded type if the renamed object has an unconstrained + type with default discriminant. + +2012-05-06 Eric Botcazou + * gcc-interface/trans.c (Loop_Statement_to_gnu): Also handle invariant conditions with only one bound. - (Raise_Error_to_gnu): Likewise.  New function extracted from... - (gnat_to_gnu) : ...here.  Call above function + (Raise_Error_to_gnu): Likewise. New function extracted from... + (gnat_to_gnu) : ...here. Call above function in regular mode only. 2012-05-06 Eric Botcazou diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ee96dbe..97ade5e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -938,6 +938,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = TREE_TYPE (gnu_expr); } + /* Or else, if the renamed object has an unconstrained type with + default discriminant, use the padded type. */ + else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr)) + && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr))) + == gnu_type + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) + gnu_type = TREE_TYPE (gnu_expr); + /* Case 1: If this is a constant renaming stemming from a function call, treat it as a normal object whose initial value is what is being renamed. RM 3.3 says that the result of evaluating a diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8a988c1..20133aa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,17 @@ -2012-05-04 Eric Botcazou +2012-05-06 Eric Botcazou - * gcc.target/ia64/pr48496.c: New test. - * gcc.target/ia64/pr52657.c: Likewise. + * gnat.dg/specs/renamings.ads: Rename to... + * gnat.dg/specs/renaming1.ads: ...this. + * gnat.dg/specs/renaming2.ads: New test. + * gnat.dg/specs/renaming2_pkg1.ads: New helper. + * gnat.dg/specs/renaming2_pkg2.ads: Likewise. + * gnat.dg/specs/renaming2_pkg3.ads: Likewise. + * gnat.dg/specs/renaming2_pkg4.ad[sb]: Likewise. + +2012-05-06 Eric Botcazou + + * gnat.dg/discr36.ad[sb]: New test. + * gnat.dg/discr36_pkg.ad[sb]: New helper. 2012-05-05 Manuel López-Ibáñez diff --git a/gcc/testsuite/gnat.dg/specs/renamings.ads b/gcc/testsuite/gnat.dg/specs/renaming1.ads similarity index 85% rename from gcc/testsuite/gnat.dg/specs/renamings.ads rename to gcc/testsuite/gnat.dg/specs/renaming1.ads index 7457952..b97605a 100644 --- a/gcc/testsuite/gnat.dg/specs/renamings.ads +++ b/gcc/testsuite/gnat.dg/specs/renaming1.ads @@ -1,4 +1,6 @@ -package Renamings is +-- { dg-do compile } + +package Renaming1 is package Inner is procedure PI (X : Integer); @@ -11,4 +13,4 @@ package Renamings is procedure Q (X : Float); procedure Q (X : Integer) renames Inner.PI; pragma Convention (C, Q); -- { dg-error "non-local entity" } -end Renamings; +end Renaming1; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2.ads b/gcc/testsuite/gnat.dg/specs/renaming2.ads new file mode 100644 index 0000000..5f199c6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } + +with Renaming2_Pkg1; + +package Renaming2 is + + type T is null record; + + package Iter is new Renaming2_Pkg1.GP.Inner (T); + +end Renaming2; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads new file mode 100644 index 0000000..45d5436 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads @@ -0,0 +1,17 @@ +-- { dg-excess-errors "no code generated" } + +with Renaming2_Pkg2; +with Renaming2_Pkg3; +with Renaming2_Pkg4; + +package Renaming2_Pkg1 is + + package Impl is new + Renaming2_Pkg3 (Base_Index_T => Positive, Value_T => Renaming2_Pkg2.Root); + + use Impl; + + package GP is new + Renaming2_Pkg4 (Length_T => Impl.Length_T, Value_T => Renaming2_Pkg2.Root); + +end Renaming2_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads new file mode 100644 index 0000000..38e0189 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads @@ -0,0 +1,14 @@ +package Renaming2_Pkg2 is + + type Root is private; + +private + + type Root (D : Boolean := False) is record + case D is + when True => N : Natural; + when False => null; + end case; + end record; + +end Renaming2_Pkg2; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads new file mode 100644 index 0000000..93ec0df --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads @@ -0,0 +1,25 @@ +-- { dg-excess-errors "no code generated" } + +generic + + type Base_Index_T is range <>; + + type Value_T is private; + +package Renaming2_Pkg3 is + + type T is private; + + subtype Length_T is Base_Index_T range 0 .. Base_Index_T'Last; + + function Value (L : Length_T) return Value_T; + + function Next return Length_T; + +private + + type Obj_T is null record; + + type T is access Obj_T; + +end Renaming2_Pkg3; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb new file mode 100644 index 0000000..50dd536 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb @@ -0,0 +1,12 @@ +package body Renaming2_Pkg4 is + + package body Inner is + + function Next_Value return Value_T is + Next_Value : Value_T renames Value (Next); + begin + return Next_Value; + end Next_Value; + + end Inner; +end Renaming2_Pkg4; diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads new file mode 100644 index 0000000..abeffcc --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads @@ -0,0 +1,25 @@ +-- { dg-excess-errors "no code generated" } + +generic + + type Length_T is range <>; + + with function Next return Length_T is <>; + + type Value_T is private; + + with function Value (L : Length_T) return Value_T is <>; + +package Renaming2_Pkg4 is + + generic + type T is private; + package Inner is + + type Slave_T is tagged null record; + + function Next_Value return Value_T; + + end Inner; + +end Renaming2_Pkg4; -- 2.7.4