diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2018-05-20 09:59:54 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2018-05-20 09:59:54 +0000 |
commit | 7c71e79664fbc04c3eb1d8b0307b33e502488664 (patch) | |
tree | 37d3d79d63b181d1efcb204fd84191266809ecda /gcc/fortran/match.c | |
parent | 69e7672a3bc8b1b40b92277437947f2778c51b96 (diff) | |
download | gcc-7c71e79664fbc04c3eb1d8b0307b33e502488664.zip gcc-7c71e79664fbc04c3eb1d8b0307b33e502488664.tar.gz gcc-7c71e79664fbc04c3eb1d8b0307b33e502488664.tar.bz2 |
re PR fortran/82923 (Automatic allocation of deferred length character using function result)
2018-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82923
PR fortran/66694
PR fortran/82617
* trans-array.c (gfc_alloc_allocatable_for_assignment): Set the
charlen backend_decl of the rhs expr to ss->info->string_length
so that the value in the current scope is used.
2018-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82923
* gfortran.dg/allocate_assumed_charlen_4.f90: New test. Note
that the patch fixes PR66694 & PR82617, although the testcases
are not explicitly included.
From-SVN: r260413
Diffstat (limited to 'gcc/fortran/match.c')
-rw-r--r-- | gcc/fortran/match.c | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 8f3a027..0931edd 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2118,7 +2118,7 @@ gfc_match_type_spec (gfc_typespec *ts) or list item in a type-list of an OpenMP reduction clause. Need to differentiate REAL([KIND]=scalar-int-initialization-expr) from REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was - written the use of LOGICAL as a type-spec or intrinsic subprogram + written the use of LOGICAL as a type-spec or intrinsic subprogram was overlooked. */ m = gfc_match (" %n", name); @@ -5935,6 +5935,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) { gfc_ref *ref; gfc_symbol *assoc_sym; + int rank = 0; assoc_sym = associate->symtree->n.sym; @@ -5971,14 +5972,28 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) selector->rank = ref->u.ar.dimen; else selector->rank = 0; + + rank = selector->rank; } - if (selector->rank) + if (rank) { - assoc_sym->attr.dimension = 1; - assoc_sym->as = gfc_get_array_spec (); - assoc_sym->as->rank = selector->rank; - assoc_sym->as->type = AS_DEFERRED; + for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT + || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN + && ref->u.ar.end[i] == NULL + && ref->u.ar.stride[i] == NULL)) + rank--; + + if (rank) + { + assoc_sym->attr.dimension = 1; + assoc_sym->as = gfc_get_array_spec (); + assoc_sym->as->rank = rank; + assoc_sym->as->type = AS_DEFERRED; + } + else + assoc_sym->as = NULL; } else assoc_sym->as = NULL; |