diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 30 |
1 files changed, 23 insertions, 7 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 531a135..628930a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3391,11 +3391,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c) VEC_safe_push (tree, gc, stringargs, parmse.string_length); - /* For descriptorless coarrays, we pass the token and the offset - as additional arguments. */ + /* For descriptorless coarrays and assumed-shape coarray dummies, we + pass the token and the offset as additional arguments. */ if (fsym && fsym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB - && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE + && !fsym->attr.allocatable && e == NULL) { /* Token and offset. */ @@ -3405,7 +3405,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gcc_assert (fsym->attr.optional); } else if (fsym && fsym->attr.codimension - && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE + && !fsym->attr.allocatable && gfc_option.coarray == GFC_FCOARRAY_LIB) { tree caf_decl, caf_type; @@ -3414,8 +3414,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, caf_decl = get_tree_for_caf_expr (e); caf_type = TREE_TYPE (caf_decl); - if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + if (GFC_DESCRIPTOR_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) tmp = gfc_conv_descriptor_token (caf_decl); + else if (DECL_LANG_SPECIFIC (caf_decl) + && GFC_DECL_TOKEN (caf_decl) != NULL_TREE) + tmp = GFC_DECL_TOKEN (caf_decl); else { gcc_assert (GFC_ARRAY_TYPE_P (caf_type) @@ -3425,8 +3429,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, VEC_safe_push (tree, gc, stringargs, tmp); - if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + if (GFC_DESCRIPTOR_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) offset = build_int_cst (gfc_array_index_type, 0); + else if (DECL_LANG_SPECIFIC (caf_decl) + && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE) + offset = GFC_DECL_CAF_OFFSET (caf_decl); else if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE) offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type); else @@ -3440,7 +3448,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = caf_decl; } - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) + if (fsym->as->type == AS_ASSUMED_SHAPE) + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE + (TREE_TYPE (parmse.expr)))); + tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr); + tmp2 = gfc_conv_descriptor_data_get (tmp2); + } + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) tmp2 = gfc_conv_descriptor_data_get (parmse.expr); else { |