From ddcfeaf129d75f4511c5e7d066ad9eeb5124f3f1 Mon Sep 17 00:00:00 2001 From: pault Date: Fri, 15 Jan 2016 20:33:58 +0000 Subject: 2016-01-15 Paul Thomas PR fortran/64324 * resolve.c (check_uop_procedure): Prevent deferred length characters from being trapped by assumed length error. PR fortran/49630 PR fortran/54070 PR fortran/60593 PR fortran/60795 PR fortran/61147 PR fortran/64324 * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for function as well as variable expressions. (gfc_array_init_size): Add 'expr' as an argument. Use this to correctly set the descriptor dtype for deferred characters. (gfc_array_allocate): Add 'expr' to the call to 'gfc_array_init_size'. * trans.c (gfc_build_array_ref): Expand logic for setting span to include indirect references to character lengths. * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred result char lengths that are PARM_DECLs are indirectly referenced both for directly passed and by reference. (create_function_arglist): If the length type is a pointer type then store the length as the 'passed_length' and make the char length an indirect reference to it. (gfc_trans_deferred_vars): If a character length has escaped being set as an indirect reference, return it via the 'passed length'. * trans-expr.c (gfc_conv_procedure_call): The length of deferred character length results is set TREE_STATIC and set to zero. (gfc_trans_assignment_1): Do not fix the rse string_length if it is a variable, a parameter or an indirect reference. Add the code to trap assignment of scalars to unallocated arrays. * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and all references to it. Instead, replicate the code to obtain a explicitly defined string length and provide a value before array allocation so that the dtype is correctly set. trans-types.c (gfc_get_character_type): If the character length is a pointer, use the indirect reference. 2016-01-15 Paul Thomas PR fortran/49630 * gfortran.dg/deferred_character_13.f90: New test for the fix of comment 3 of the PR. PR fortran/54070 * gfortran.dg/deferred_character_8.f90: New test * gfortran.dg/allocate_error_5.f90: New test PR fortran/60593 * gfortran.dg/deferred_character_10.f90: New test PR fortran/60795 * gfortran.dg/deferred_character_14.f90: New test PR fortran/61147 * gfortran.dg/deferred_character_11.f90: New test PR fortran/64324 * gfortran.dg/deferred_character_9.f90: New test git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@232450 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a46f1034777..eeb688c9b91 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3165,7 +3165,8 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) index, info->offset); if (expr && (is_subref_array (expr) - || (expr->ts.deferred && expr->expr_type == EXPR_VARIABLE))) + || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE + || expr->expr_type == EXPR_FUNCTION)))) decl = expr->symtree->n.sym->backend_decl; tmp = build_fold_indirect_ref_loc (input_location, info->data); @@ -5038,7 +5039,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock, stmtblock_t * descriptor_block, tree * overflow, tree expr3_elem_size, tree *nelems, gfc_expr *expr3, - tree expr3_desc, bool e3_is_array_constr) + tree expr3_desc, bool e3_is_array_constr, gfc_expr *expr) { tree type; tree tmp; @@ -5063,8 +5064,19 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, offset = gfc_index_zero_node; /* Set the dtype. */ - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type)); + if (expr->ts.type == BT_CHARACTER && expr->ts.deferred + && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL) + { + type = gfc_typenode_for_spec (&expr->ts); + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (descriptor_block, tmp, + gfc_get_dtype_rank_type (rank, type)); + } + else + { + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type)); + } or_expr = boolean_false_node; @@ -5446,7 +5458,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, ref->u.ar.as->corank, &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, expr3_elem_size, nelems, expr3, e3_arr_desc, - e3_is_array_constr); + e3_is_array_constr, expr); if (dimension) { -- cgit v1.2.1