From 6e03839f3d5a26617da02a5d052451251486ede1 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 31 May 2018 10:47:14 +0000 Subject: [PATCH] [Ada] Fix wrong value returned for unconstrained packed array 2018-05-31 Eric Botcazou gcc/ada/ * gcc-interface/trans.c (Call_to_gnu): In the by-reference case, if the type of the parameter is an unconstrained array type, convert to the type of the actual before the type of the formal only if the conversion was suppressed earlier. Use in_param and gnu_actual_type local variables throughout, and uniform spelling for In Out or Out. Also remove dead code in the component-by-reference case. From-SVN: r261011 --- gcc/ada/ChangeLog | 9 ++++++++ gcc/ada/gcc-interface/trans.c | 41 +++++++++++++++-------------------- 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a68975b4b59..8e7eb118140 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-05-31 Eric Botcazou + + * gcc-interface/trans.c (Call_to_gnu): In the by-reference case, if + the type of the parameter is an unconstrained array type, convert + to the type of the actual before the type of the formal only if the + conversion was suppressed earlier. Use in_param and gnu_actual_type + local variables throughout, and uniform spelling for In Out or Out. + Also remove dead code in the component-by-reference case. + 2018-05-31 Frederic Konrad * tracebak.c (STOP_FRAME): Harden condition. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 1704db2c317..32b5ef1dc75 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4421,13 +4421,14 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree gnu_formal_type = gnat_to_gnu_type (gnat_formal_type); tree gnu_formal = present_gnu_tree (gnat_formal) ? get_gnu_tree (gnat_formal) : NULL_TREE; + const bool in_param = (Ekind (gnat_formal) == E_In_Parameter); const bool is_true_formal_parm = gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL; const bool is_by_ref_formal_parm = is_true_formal_parm && (DECL_BY_REF_P (gnu_formal) || DECL_BY_COMPONENT_PTR_P (gnu_formal)); - /* In the Out or In Out case, we must suppress conversions that yield + /* In the In Out or Out case, we must suppress conversions that yield an lvalue but can nevertheless cause the creation of a temporary, because we need the real object in this case, either to pass its address if it's passed by reference or as target of the back copy @@ -4438,7 +4439,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, test is applied to the real object. */ const bool suppress_type_conversion = ((Nkind (gnat_actual) == N_Unchecked_Type_Conversion - && (Ekind (gnat_formal) != E_In_Parameter + && (!in_param || (Is_Composite_Type (Underlying_Type (gnat_formal_type)) && !Is_Constrained (Underlying_Type (gnat_formal_type))))) || (Nkind (gnat_actual) == N_Type_Conversion @@ -4450,7 +4451,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* If it's possible we may need to use this expression twice, make sure that any side-effects are handled via SAVE_EXPRs; likewise if we need to force side-effects before the call. */ - if (Ekind (gnat_formal) != E_In_Parameter && !is_by_ref_formal_parm) + if (!in_param && !is_by_ref_formal_parm) { tree init = NULL_TREE; gnu_name = gnat_stabilize_reference (gnu_name, true, &init); @@ -4460,13 +4461,12 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* If we are passing a non-addressable parameter by reference, pass the - address of a copy. In the Out or In Out case, set up to copy back + address of a copy. In the In Out or Out case, set up to copy back out after the call. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) && !addressable_p (gnu_name, gnu_name_type)) { - bool in_param = (Ekind (gnat_formal) == E_In_Parameter); tree gnu_orig = gnu_name, gnu_temp, gnu_stmt; /* Do not issue warnings for CONSTRUCTORs since this is not a copy @@ -4616,7 +4616,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* Unless this is an In parameter, we must remove any justified modular building from GNU_NAME to get an lvalue. */ - if (Ekind (gnat_formal) != E_In_Parameter + if (!in_param && TREE_CODE (gnu_name) == CONSTRUCTOR && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name))) @@ -4626,7 +4626,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* First see if the parameter is passed by reference. */ if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal)) { - if (Ekind (gnat_formal) != E_In_Parameter) + if (!in_param) { /* In Out or Out parameters passed by reference don't use the copy-in/copy-out mechanism so the address of the real object @@ -4648,8 +4648,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_actual)) && Is_Constr_Subt_For_UN_Aliased (Etype (gnat_actual)) && Is_Array_Type (Underlying_Type (Etype (gnat_actual)))) - gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)), - gnu_actual); + gnu_actual = convert (gnu_actual_type, gnu_actual); } /* There is no need to convert the actual to the formal's type before @@ -4657,15 +4656,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, types because of the way we build fat pointers. */ if (TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE) { - /* Put back a view conversion for In Out or Out parameters. */ - if (Ekind (gnat_formal) != E_In_Parameter) - gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)), - gnu_actual); + /* Put back the conversion we suppressed above for In Out or Out + parameters, since it may set the bounds of the actual. */ + if (!in_param && suppress_type_conversion) + gnu_actual = convert (gnu_actual_type, gnu_actual); gnu_actual = convert (gnu_formal_type, gnu_actual); } - /* The symmetry of the paths to the type of an entity is broken here - since arguments don't know that they will be passed by ref. */ + /* Take the address of the object and convert to the proper pointer + type. */ gnu_formal_type = TREE_TYPE (gnu_formal); gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); } @@ -4674,22 +4673,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, subprogram. */ else if (is_true_formal_parm && DECL_BY_COMPONENT_PTR_P (gnu_formal)) { - gnu_formal_type = TREE_TYPE (gnu_formal); gnu_actual = maybe_implicit_deref (gnu_actual); gnu_actual = maybe_unconstrained_array (gnu_actual); - if (TYPE_IS_PADDING_P (gnu_formal_type)) - { - gnu_formal_type = TREE_TYPE (TYPE_FIELDS (gnu_formal_type)); - gnu_actual = convert (gnu_formal_type, gnu_actual); - } - /* Take the address of the object and convert to the proper pointer type. We'd like to actually compute the address of the beginning of the array using an ADDR_EXPR of an ARRAY_REF, but there's a possibility that the ARRAY_REF might return a constant and we'd be getting the wrong address. Neither approach is exactly correct, but this is the most likely to work in all cases. */ + gnu_formal_type = TREE_TYPE (gnu_formal); gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual); } @@ -4698,7 +4691,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, { tree gnu_size; - if (Ekind (gnat_formal) != E_In_Parameter) + if (!in_param) gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list); /* If we didn't create a PARM_DECL for the formal, this means that @@ -4803,7 +4796,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, || DECL_BY_COMPONENT_PTR_P (get_gnu_tree (gnat_formal)))) && Ekind (gnat_formal) != E_In_Parameter) { - /* Get the value to assign to this Out or In Out parameter. It is + /* Get the value to assign to this In Out or Out parameter. It is either the result of the function if there is only a single such parameter or the appropriate field from the record returned. */ tree gnu_result -- 2.30.2