diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 25 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/aliased2.adb | 23 |
4 files changed, 52 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b975bd..fc08a02 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2019-05-27 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/trans.c (Identifier_to_gnu): Minor tweaks. + (gnat_to_gnu): Do not convert the result if it is a reference to an + unconstrained array used as the prefix of an attribute reference that + requires an lvalue. + +2019-05-27 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/trans.c (Gigi_Types_Compatible): New predicate. (Identifier_to_gnu): Use it to assert that the type of the identifier and that of its entity are compatible for gigi. Rename a couple of diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3af5eee..2efc800 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1110,11 +1110,12 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) } else { - /* We want to use the Actual_Subtype if it has already been elaborated, - otherwise the Etype. Avoid using Actual_Subtype for packed arrays to - simplify things. */ + /* We use the Actual_Subtype only if it has already been elaborated, + as we may be invoked precisely during its elaboration, otherwise + the Etype. Avoid using it for packed arrays to simplify things. */ if ((Ekind (gnat_entity) == E_Constant - || Ekind (gnat_entity) == E_Variable || Is_Formal (gnat_entity)) + || Ekind (gnat_entity) == E_Variable + || Is_Formal (gnat_entity)) && !(Is_Array_Type (Etype (gnat_entity)) && Present (Packed_Array_Impl_Type (Etype (gnat_entity)))) && Present (Actual_Subtype (gnat_entity)) @@ -8685,7 +8686,11 @@ gnat_to_gnu (Node_Id gnat_node) declaration, return the result unmodified because we want to use the return slot optimization in this case. - 5. Finally, if the type of the result is already correct. */ + 5. If this is a reference to an unconstrained array which is used as the + prefix of an attribute reference that requires an lvalue, return the + result unmodified because we want return the original bounds. + + 6. Finally, if the type of the result is already correct. */ if (Present (Parent (gnat_node)) && (lhs_or_actual_p (gnat_node) @@ -8734,13 +8739,19 @@ gnat_to_gnu (Node_Id gnat_node) else if (gnu_result == error_mark_node || gnu_result_type == void_type_node) gnu_result = error_mark_node; - else if (Present (Parent (gnat_node)) + else if (TREE_CODE (gnu_result) == CALL_EXPR + && Present (Parent (gnat_node)) && (Nkind (Parent (gnat_node)) == N_Object_Declaration || Nkind (Parent (gnat_node)) == N_Object_Renaming_Declaration) - && TREE_CODE (gnu_result) == CALL_EXPR && return_type_with_variable_size_p (TREE_TYPE (gnu_result))) ; + else if (TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF + && Present (Parent (gnat_node)) + && Nkind (Parent (gnat_node)) == N_Attribute_Reference + && lvalue_required_for_attribute_p (Parent (gnat_node))) + ; + else if (TREE_TYPE (gnu_result) != gnu_result_type) gnu_result = convert (gnu_result_type, gnu_result); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a75cdb7..56084cc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2019-05-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/aliased2.adb: New test. + +2019-05-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/limited_with7.ad[sb]: New test. * gnat.dg/limited_with7_pkg.ads: New helper. diff --git a/gcc/testsuite/gnat.dg/aliased2.adb b/gcc/testsuite/gnat.dg/aliased2.adb new file mode 100644 index 0000000..0e1adac --- /dev/null +++ b/gcc/testsuite/gnat.dg/aliased2.adb @@ -0,0 +1,23 @@ +-- { dg-do run } + +procedure Aliased2 is + + type Rec is record + Data : access constant String; + end record; + + function Get (S : aliased String) return Rec is + R : Rec := (Data => S'Unchecked_Access); + begin + return R; + end; + + S : aliased String := "Hello"; + + R : Rec := Get (S); + +begin + if R.Data'Length /= S'Length then + raise Program_Error; + end if; +end; |