diff options
| author | Tobias Burnus <burnus@net-b.de> | 2014-04-30 21:10:16 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2014-04-30 21:10:16 +0200 |
| commit | 598cc4fada2da6388903a749f33f94c696685b09 (patch) | |
| tree | 6d0d108dfb8d8ecc0f1e634cfbea2ad283bd8327 /gcc/fortran/trans-expr.c | |
| parent | 2c060879af5a92b49c11e70004fcd377f6a5a3ea (diff) | |
| download | gcc-598cc4fada2da6388903a749f33f94c696685b09.zip gcc-598cc4fada2da6388903a749f33f94c696685b09.tar.gz gcc-598cc4fada2da6388903a749f33f94c696685b09.tar.bz2 | |
trans-decl.c (create_function_arglist): Add hidden coarray
2014-04-30 Tobias Burnus <burnus@net-b.de>
* trans-decl.c (create_function_arglist): Add hidden coarray
* arguments
also for polymorphic coarrays.
* trans-expr.c (gfc_conv_procedure_call): Pass hidden coarray
arguments also for polymorphic coarrays.
2014-04-30 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_poly_7.f90
* gfortran.dg/coarray_poly_8.f90
* gfortran.dg/coarray_poly_9.f90
From-SVN: r209953
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 49 |
1 files changed, 31 insertions, 18 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f0e5b7d..6b93537 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4783,19 +4783,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* 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 - && e == NULL) + if (fsym && e == NULL && gfc_option.coarray == GFC_FCOARRAY_LIB + && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension + && !fsym->attr.allocatable) + || (fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->attr.codimension + && !CLASS_DATA (fsym)->attr.allocatable))) { /* Token and offset. */ vec_safe_push (stringargs, null_pointer_node); vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0)); gcc_assert (fsym->attr.optional); } - else if (fsym && fsym->attr.codimension - && !fsym->attr.allocatable - && gfc_option.coarray == GFC_FCOARRAY_LIB) + else if (fsym && gfc_option.coarray == GFC_FCOARRAY_LIB + && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension + && !fsym->attr.allocatable) + || (fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->attr.codimension + && !CLASS_DATA (fsym)->attr.allocatable))) { tree caf_decl, caf_type; tree offset, tmp2; @@ -4837,22 +4842,30 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = caf_decl; } - if (fsym->as->type == AS_ASSUMED_SHAPE - || (fsym->as->type == AS_ASSUMED_RANK && !fsym->attr.pointer - && !fsym->attr.allocatable)) + tmp2 = fsym->ts.type == BT_CLASS + ? gfc_class_data_get (parmse.expr) : parmse.expr; + if ((fsym->ts.type != BT_CLASS + && (fsym->as->type == AS_ASSUMED_SHAPE + || fsym->as->type == AS_ASSUMED_RANK)) + || (fsym->ts.type == BT_CLASS + && (CLASS_DATA (fsym)->as->type == AS_ASSUMED_SHAPE + || CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK))) { - 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); + if (fsym->ts.type == BT_CLASS) + gcc_assert (!POINTER_TYPE_P (TREE_TYPE (tmp2))); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2))); + tmp2 = build_fold_indirect_ref_loc (input_location, tmp2); + } + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2))); 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 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2))) + tmp2 = gfc_conv_descriptor_data_get (tmp2); else { - gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); - tmp2 = parmse.expr; + gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2))); } tmp = fold_build2_loc (input_location, MINUS_EXPR, |