From: Andre Vehreschild Date: Sat, 4 Nov 2017 14:35:45 +0000 (+0100) Subject: trans-expr.c (gfc_trans_assignment_1): Character kind conversion may create a loop... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7c4acac3a0798a62340897eae76da5037467135e;p=gcc.git trans-expr.c (gfc_trans_assignment_1): Character kind conversion may create a loop variant temporary, too. gcc/fortran/ChangeLog: 2017-11-04 Andre Vehreschild * trans-expr.c (gfc_trans_assignment_1): Character kind conversion may create a loop variant temporary, too. * trans-intrinsic.c (conv_caf_send): Treat char arrays as arrays and not as scalars. * trans.c (get_array_span): Take the character kind into account when doing pointer arithmetic. gcc/testsuite/ChangeLog: 2017-11-04 Andre Vehreschild * gfortran.dg/coarray/send_char_array_1.f90: New test. From-SVN: r254407 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0b2ca315605..40c1100833f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2017-11-04 Andre Vehreschild + + * trans-expr.c (gfc_trans_assignment_1): Character kind conversion may + create a loop variant temporary, too. + * trans-intrinsic.c (conv_caf_send): Treat char arrays as arrays and + not as scalars. + * trans.c (get_array_span): Take the character kind into account when + doing pointer arithmetic. + 2017-11-04 Thomas Koenig PR fortran/29600 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1a3e3d45e4c..57b62a6b0c0 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -10084,12 +10084,16 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, NOTE: This relies on having the exact dependence of the length type parameter available to the caller; gfortran saves it in the .mod files. NOTE ALSO: The concatenation operation generates a temporary pointer, - whose allocation must go to the innermost loop. */ + whose allocation must go to the innermost loop. + NOTE ALSO (2): A character conversion may generate a temporary, too. */ if (flag_realloc_lhs && expr2->ts.type == BT_CHARACTER && expr1->ts.deferred && !(lss != gfc_ss_terminator - && expr2->expr_type == EXPR_OP - && expr2->value.op.op == INTRINSIC_CONCAT)) + && ((expr2->expr_type == EXPR_OP + && expr2->value.op.op == INTRINSIC_CONCAT) + || (expr2->expr_type == EXPR_FUNCTION + && expr2->value.function.isym != NULL + && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)))) gfc_add_block_to_block (&block, &rse.pre); /* Nullify the allocatable components corresponding to those of the lhs diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 532d3ab237d..b0f0ab21891 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1871,12 +1871,21 @@ conv_caf_send (gfc_code *code) { gfc_init_se (&lhs_se, NULL); if (lhs_expr->rank == 0) { - symbol_attribute attr; - gfc_clear_attr (&attr); - gfc_conv_expr (&lhs_se, lhs_expr); - lhs_type = TREE_TYPE (lhs_se.expr); - lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr); - lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); + if (lhs_expr->ts.type == BT_CHARACTER && lhs_expr->ts.deferred) + { + lhs_se.expr = gfc_get_tree_for_caf_expr (lhs_expr); + lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); + } + else + { + symbol_attribute attr; + gfc_clear_attr (&attr); + gfc_conv_expr (&lhs_se, lhs_expr); + lhs_type = TREE_TYPE (lhs_se.expr); + lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, + attr); + lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); + } } else if ((lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp) && lhs_caf_attr.codimension) diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 53bc4285c78..411530884de 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -320,8 +320,12 @@ get_array_span (tree type, tree decl) || DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == DECL_CONTEXT (decl))) { - span = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); - span = fold_convert (gfc_array_index_type, span); + span = fold_convert (gfc_array_index_type, + TYPE_MAX_VALUE (TYPE_DOMAIN (type))); + span = fold_build2 (MULT_EXPR, gfc_array_index_type, + fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (TREE_TYPE (type))), + span); } /* Likewise for class array or pointer array references. */ else if (TREE_CODE (decl) == FIELD_DECL diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ef59a71f22..854d9571700 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2017-11-04 Andre Vehreschild + + * gfortran.dg/coarray/send_char_array_1.f90: New test. + 2017-11-04 Thomas Koenig PR fortran/70330 diff --git a/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 new file mode 100644 index 00000000000..800a8acc34c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/send_char_array_1.f90 @@ -0,0 +1,54 @@ +!{ dg-do run } + +program send_convert_char_array + + implicit none + + character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_scal + character(kind=1, len=:), allocatable :: str_k1_scal + character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_scal + character(kind=4, len=:), allocatable :: str_k4_scal + + character(kind=1, len=:), allocatable, codimension[:] :: co_str_k1_arr(:) + character(kind=1, len=:), allocatable :: str_k1_arr(:) + character(kind=4, len=:), allocatable, codimension[:] :: co_str_k4_arr(:) + character(kind=4, len=:), allocatable :: str_k4_arr(:) + + allocate(str_k1_scal, SOURCE='abcdefghij') + allocate(str_k4_scal, SOURCE=4_'abcdefghij') + allocate(character(len=20)::co_str_k1_scal[*]) ! allocate syncs here + allocate(character(kind=4, len=20)::co_str_k4_scal[*]) ! allocate syncs here + + allocate(str_k1_arr, SOURCE=['abc', 'EFG', 'klm', 'NOP']) + allocate(str_k4_arr, SOURCE=[4_'abc', 4_'EFG', 4_'klm', 4_'NOP']) + allocate(character(len=5)::co_str_k1_arr(4)[*]) + allocate(character(kind=4, len=5)::co_str_k4_arr(4)[*]) + + ! First check send/copy to self + co_str_k1_scal[1] = str_k1_scal + if (co_str_k1_scal /= str_k1_scal // ' ') call abort() + + co_str_k4_scal[1] = str_k4_scal + if (co_str_k4_scal /= str_k4_scal // 4_' ') call abort() + + co_str_k4_scal[1] = str_k1_scal + if (co_str_k4_scal /= str_k4_scal // 4_' ') call abort() + + co_str_k1_scal[1] = str_k4_scal + if (co_str_k1_scal /= str_k1_scal // ' ') call abort() + + co_str_k1_arr(:)[1] = str_k1_arr + if (any(co_str_k1_arr /= ['abc ', 'EFG ', 'klm ', 'NOP '])) call abort() + + co_str_k4_arr(:)[1] = [4_'abc', 4_'EFG', 4_'klm', 4_'NOP']! str_k4_arr + if (any(co_str_k4_arr /= [4_'abc ', 4_'EFG ', 4_'klm ', 4_'NOP '])) call abort() + + co_str_k4_arr(:)[1] = str_k1_arr + if (any(co_str_k4_arr /= [ 4_'abc ', 4_'EFG ', 4_'klm ', 4_'NOP '])) call abort() + + co_str_k1_arr(:)[1] = str_k4_arr + if (any(co_str_k1_arr /= ['abc ', 'EFG ', 'klm ', 'NOP '])) call abort() + +end program send_convert_char_array + +! vim:ts=2:sts=2:sw=2: