diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2009-06-03 10:52:40 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2009-06-03 10:52:40 +0000 |
commit | cdaa0e0b8c1cd7569b50ab50819401f7d399983b (patch) | |
tree | 814533141d2c4d825ded89a4f5223f2bb99676da | |
parent | a6a29d0c39e207cf1ec8ad94ec44744ae9814660 (diff) | |
download | gcc-cdaa0e0b8c1cd7569b50ab50819401f7d399983b.zip gcc-cdaa0e0b8c1cd7569b50ab50819401f7d399983b.tar.gz gcc-cdaa0e0b8c1cd7569b50ab50819401f7d399983b.tar.bz2 |
decl.c (gnat_to_gnu_entity): When adjusting the discriminant nodes in an extension...
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When
adjusting the discriminant nodes in an extension, use the full view
of the parent subtype if it is of a private kind.
From-SVN: r148125
-rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 37 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads | 7 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/root-level_1.ads | 14 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/root-level_2.ads | 9 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/root.ads | 9 |
7 files changed, 76 insertions, 13 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4bce612..d439a19 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2009-06-03 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When + adjusting the discriminant nodes in an extension, use the full view + of the parent subtype if it is of a private kind. + +2009-06-03 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: Add the _Parent field, if any, to the record before adding the other fields. <E_Record_Subtype>: Put the _Controller field before the other fields diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index befb4f5..d32ddad 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2899,22 +2899,33 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) of the parent subtype and not those of its base type for the placeholder machinery to properly work. */ if (Has_Discriminants (gnat_entity)) - for (gnat_field = First_Stored_Discriminant (gnat_entity); - Present (gnat_field); - gnat_field = Next_Stored_Discriminant (gnat_field)) - if (Present (Corresponding_Discriminant (gnat_field))) + { + /* The actual parent subtype is the full view. */ + if (IN (Ekind (gnat_parent), Private_Kind)) { - Entity_Id field = Empty; - for (field = First_Stored_Discriminant (gnat_parent); - Present (field); - field = Next_Stored_Discriminant (field)) - if (same_discriminant_p (gnat_field, field)) - break; - gcc_assert (Present (field)); - TREE_OPERAND (get_gnu_tree (gnat_field), 1) - = gnat_to_gnu_field_decl (field); + if (Present (Full_View (gnat_parent))) + gnat_parent = Full_View (gnat_parent); + else + gnat_parent = Underlying_Full_View (gnat_parent); } + for (gnat_field = First_Stored_Discriminant (gnat_entity); + Present (gnat_field); + gnat_field = Next_Stored_Discriminant (gnat_field)) + if (Present (Corresponding_Discriminant (gnat_field))) + { + Entity_Id field = Empty; + for (field = First_Stored_Discriminant (gnat_parent); + Present (field); + field = Next_Stored_Discriminant (field)) + if (same_discriminant_p (gnat_field, field)) + break; + gcc_assert (Present (field)); + TREE_OPERAND (get_gnu_tree (gnat_field), 1) + = gnat_to_gnu_field_decl (field); + } + } + /* The "get to the parent" COMPONENT_REF must be given its proper type... */ TREE_TYPE (gnu_get_parent) = gnu_parent; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dcab467..981a891 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-06-03 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/specs/root.ads: New test. + * gnat.dg/specs/root-level_1.ads: Likewise. + * gnat.dg/specs/root-level_2.ads: Likewise. + * gnat.dg/specs/root-level_1-level_2.ads: Likewise. + 2009-06-02 Mark Mitchell <mark@codesourcery.com> * g++.dg/init/ref15.C: Require unwrapped targets. diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads new file mode 100644 index 0000000..9687208 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads @@ -0,0 +1,7 @@ +package Root.Level_1.Level_2 is + + type Level_2_Type (First : Natural; + Second : Natural) is new + Level_1.Level_1_Type (First => First, Second => Second) with null record; + +end Root.Level_1.Level_2; diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1.ads b/gcc/testsuite/gnat.dg/specs/root-level_1.ads new file mode 100644 index 0000000..6bcb125 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_1.ads @@ -0,0 +1,14 @@ +package Root.Level_1 is + + type Level_1_Type (First : Natural; + Second : Natural) is new Root_Type with private; + +private + + type Level_1_Type (First : Natural; + Second : Natural) is new Root_Type (First => First) + with record + Buffer_1 : Buffer_Type (1 .. Second); + end record; + +end Root.Level_1; diff --git a/gcc/testsuite/gnat.dg/specs/root-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_2.ads new file mode 100644 index 0000000..c4f812e --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root-level_2.ads @@ -0,0 +1,9 @@ +with Root.Level_1; + +package Root.Level_2 is + + type Level_2_Type (First : Natural; + Second : Natural) is new + Level_1.Level_1_Type (First => First, Second => Second) with null record; + +end Root.Level_2; diff --git a/gcc/testsuite/gnat.dg/specs/root.ads b/gcc/testsuite/gnat.dg/specs/root.ads new file mode 100644 index 0000000..e80ab88 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/root.ads @@ -0,0 +1,9 @@ +package Root is + + type Buffer_Type is array (Positive range <>) of Natural; + + type Root_Type (First : Natural) is abstract tagged record + Buffer_Root : Buffer_Type (1 .. First); + end record; + +end Root; |