diff options
Diffstat (limited to 'gcc/fortran/trans-array.cc')
| -rw-r--r-- | gcc/fortran/trans-array.cc | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 9fb0b2b..ea5fff2 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -7882,8 +7882,6 @@ walk_coarray (gfc_expr *e) { gfc_ss *ss; - gcc_assert (gfc_get_corank (e) > 0); - ss = gfc_walk_expr (e); /* Fix scalar coarray. */ @@ -7904,7 +7902,7 @@ walk_coarray (gfc_expr *e) gcc_assert (ref != NULL); if (ref->u.ar.type == AR_ELEMENT) ref->u.ar.type = AR_SECTION; - ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref)); + ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref, false)); } return ss; @@ -8005,7 +8003,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) bool substr = false; gfc_expr *arg, *ss_expr; - if (se->want_coarray) + if (se->want_coarray || expr->rank == 0) ss = walk_coarray (expr); else ss = gfc_walk_expr (expr); @@ -8338,7 +8336,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) { gfc_array_ref *ar = &info->ref->u.ar; - codim = gfc_get_corank (expr); + codim = expr->corank; for (n = 0; n < codim - 1; n++) { /* Make sure we are not lost somehow. */ @@ -8488,6 +8486,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* The 1st element in the section. */ base = gfc_index_zero_node; + if (expr->ts.type == BT_CHARACTER && expr->rank == 0 && codim) + base = gfc_index_one_node; /* The offset from the 1st element in the section. */ offset = gfc_index_zero_node; @@ -8587,6 +8587,23 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_conv_descriptor_offset_set (&loop.pre, parm, offset); + if (flag_coarray == GFC_FCOARRAY_LIB && expr->corank) + { + tmp = INDIRECT_REF_P (desc) ? TREE_OPERAND (desc, 0) : desc; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + { + tmp = gfc_conv_descriptor_token (tmp); + } + else if (DECL_P (tmp) && DECL_LANG_SPECIFIC (tmp) + && GFC_DECL_TOKEN (tmp) != NULL_TREE) + tmp = GFC_DECL_TOKEN (tmp); + else + { + tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp)); + } + + gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp); + } desc = parm; } @@ -12110,9 +12127,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) return gfc_walk_array_ref (ss, expr, ref); } - gfc_ss * -gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) +gfc_walk_array_ref (gfc_ss *ss, gfc_expr *expr, gfc_ref *ref, bool array_only) { gfc_array_ref *ar; gfc_ss *newss; @@ -12128,7 +12144,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) } /* We're only interested in array sections from now on. */ - if (ref->type != REF_ARRAY) + if (ref->type != REF_ARRAY + || (array_only && ref->u.ar.as && ref->u.ar.as->rank == 0)) continue; ar = &ref->u.ar; |