diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-08-25 18:27:39 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-08-25 18:27:39 +0200 |
| commit | aa13dc3c9342c5857bdf3d2f6ce6c3af6d4fae9c (patch) | |
| tree | 622a3bfb407021c942c4f703515478d5bc9ece18 /gcc/fortran/trans-expr.c | |
| parent | 241e79cfc4264dec4eaf1e8af890da3527c99193 (diff) | |
| download | gcc-aa13dc3c9342c5857bdf3d2f6ce6c3af6d4fae9c.zip gcc-aa13dc3c9342c5857bdf3d2f6ce6c3af6d4fae9c.tar.gz gcc-aa13dc3c9342c5857bdf3d2f6ce6c3af6d4fae9c.tar.bz2 | |
trans-array.c (gfc_conv_descriptor_token): Add assert.
2011-08-25 Tobias Burnus <burnus@net-b.de>
* trans-array.c (gfc_conv_descriptor_token): Add assert.
* trans-decl.c (gfc_build_qualified_array,
create_function_arglist): Handle assumed-shape arrays.
* trans-expr.c (gfc_conv_procedure_call): Ditto.
* trans-types.c (gfc_get_array_descriptor_base): Ditto, don't
add "caf_token" to assumed-shape descriptors, new akind argument.
(gfc_get_array_type_bounds): Pass akind.
* trans.h (lang_decl): New elements caf_offset and token.
(GFC_DECL_TOKEN, GFC_DECL_CAF_OFFSET): New macros.
2011-08-25 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_token_4.f90: New.
From-SVN: r178069
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 { |