diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 42 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/taft_type4.adb | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/taft_type4_pkg.adb | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/taft_type4_pkg.ads | 13 |
6 files changed, 77 insertions, 16 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 40cc965..61cd24b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2017-09-05 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/trans.c (adjust_for_implicit_deref): New function. + (gnat_to_gnu) <N_Explicit_Dereference>: Translate result type first. + (N_Indexed_Component): Invoke adjust_for_implicit_deref on the prefix. + (N_Slice): Likewise. + (N_Selected_Component): Likewise. Do not try again to translate it. + (N_Free_Statement): Invoke adjust_for_implicit_deref on the expression. + +2017-09-05 Eric Botcazou <ebotcazou@adacore.com> + * repinfo.ads: Document new treatment of dynamic values. (TCode): Bump upper bound to 29. (Dynamic_Val): New constant set to 29. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index eb77703..78d918f 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -242,6 +242,7 @@ static bool addressable_p (tree, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree pos_to_constructor (Node_Id, tree, Entity_Id); static void validate_unchecked_conversion (Node_Id); +static Node_Id adjust_for_implicit_deref (Node_Id); static tree maybe_implicit_deref (tree); static void set_expr_location_from_node (tree, Node_Id, bool = false); static void set_gnu_expr_location_from_node (tree, Node_Id); @@ -6274,8 +6275,9 @@ gnat_to_gnu (Node_Id gnat_node) /*************************************/ case N_Explicit_Dereference: - gnu_result = gnat_to_gnu (Prefix (gnat_node)); + /* Make sure the designated type is complete before dereferencing. */ gnu_result_type = get_unpadded_type (Etype (gnat_node)); + gnu_result = gnat_to_gnu (Prefix (gnat_node)); gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); /* If atomic access is required on the RHS, build the atomic load. */ @@ -6286,7 +6288,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Indexed_Component: { - tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node)); + tree gnu_array_object + = gnat_to_gnu (adjust_for_implicit_deref (Prefix (gnat_node))); tree gnu_type; int ndim; int i; @@ -6399,7 +6402,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Slice: { - tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node)); + tree gnu_array_object + = gnat_to_gnu (adjust_for_implicit_deref (Prefix (gnat_node))); gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -6423,7 +6427,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Selected_Component: { - Entity_Id gnat_prefix = Prefix (gnat_node); + Entity_Id gnat_prefix + = adjust_for_implicit_deref (Prefix (gnat_node)); Entity_Id gnat_field = Entity (Selector_Name (gnat_node)); tree gnu_prefix = gnat_to_gnu (gnat_prefix); @@ -6456,17 +6461,6 @@ gnat_to_gnu (Node_Id gnat_node) { tree gnu_field = gnat_to_gnu_field_decl (gnat_field); - /* If the prefix has incomplete type, try again to translate it. - The idea is that the translation of the field just above may - have completed it through gnat_to_gnu_entity, in case it is - the dereference of an access to Taft Amendment type used in - the instantiation of a generic body from an external unit. */ - if (!COMPLETE_TYPE_P (TREE_TYPE (gnu_prefix))) - { - gnu_prefix = gnat_to_gnu (gnat_prefix); - gnu_prefix = maybe_implicit_deref (gnu_prefix); - } - gnu_result = build_component_ref (gnu_prefix, gnu_field, (Nkind (Parent (gnat_node)) @@ -7725,7 +7719,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Free_Statement: if (!type_annotate_only) { - tree gnu_ptr = gnat_to_gnu (Expression (gnat_node)); + tree gnu_ptr + = gnat_to_gnu (adjust_for_implicit_deref (Expression (gnat_node))); tree gnu_ptr_type = TREE_TYPE (gnu_ptr); tree gnu_obj_type, gnu_actual_obj_type; @@ -9913,6 +9908,21 @@ validate_unchecked_conversion (Node_Id gnat_node) } } +/* EXP is to be used in a context where access objects are implicitly + dereferenced. Handle the cases when it is an access object. */ + +static Node_Id +adjust_for_implicit_deref (Node_Id exp) +{ + Entity_Id type = Underlying_Type (Etype (exp)); + + /* Make sure the designated type is complete before dereferencing. */ + if (Is_Access_Type (type)) + gnat_to_gnu_entity (Designated_Type (type), NULL_TREE, false); + + return exp; +} + /* EXP is to be treated as an array or record. Handle the cases when it is an access object and perform the required dereferences. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a217300..f6210be 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-09-05 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/taft_type4.adb: New test. + * gnat.dg/taft_type4_pkg.ad[sb]: New helper. + 2017-09-05 Richard Biener <rguenther@suse.de> PR tree-optimization/82102 diff --git a/gcc/testsuite/gnat.dg/taft_type4.adb b/gcc/testsuite/gnat.dg/taft_type4.adb new file mode 100644 index 0000000..f675863 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn" } + +with Taft_Type4_Pkg; use Taft_Type4_Pkg; + +procedure Taft_Type4 is + Obj : T; +begin + Proc (Obj); +end; diff --git a/gcc/testsuite/gnat.dg/taft_type4_pkg.adb b/gcc/testsuite/gnat.dg/taft_type4_pkg.adb new file mode 100644 index 0000000..40039c7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4_pkg.adb @@ -0,0 +1,14 @@ +with Unchecked_Deallocation; + +package body Taft_Type4_Pkg is + + type Obj_T is null record; + + procedure Unchecked_Free is new Unchecked_Deallocation (Obj_T, T); + + procedure Proc (L : in out T) is + begin + Unchecked_Free (L); + end; + +end Taft_Type4_Pkg; diff --git a/gcc/testsuite/gnat.dg/taft_type4_pkg.ads b/gcc/testsuite/gnat.dg/taft_type4_pkg.ads new file mode 100644 index 0000000..6b0dc34 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4_pkg.ads @@ -0,0 +1,13 @@ +package Taft_Type4_Pkg is + + type T is private; + + procedure Proc (L : in out T); + pragma Inline (Proc); + +private + + type Obj_T; + type T is access Obj_T; + +end Taft_Type4_Pkg; |