diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2016-11-04 19:23:44 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2016-11-04 19:23:44 +0000 |
| commit | b125dc1e1bb5932a2de833e07bbdc2395097a868 (patch) | |
| tree | c25b7ef2b8fc5fc8d013468b90130d1b2405d8a7 /gcc/fortran/primary.c | |
| parent | 5f4cebba260db0f1b1edf45152be3bad2ed779a8 (diff) | |
| download | gcc-b125dc1e1bb5932a2de833e07bbdc2395097a868.zip gcc-b125dc1e1bb5932a2de833e07bbdc2395097a868.tar.gz gcc-b125dc1e1bb5932a2de833e07bbdc2395097a868.tar.bz2 | |
re PR fortran/64933 (ASSOCIATE on a character variable does not allow substring expressions)
2016-04-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/64933
* primary.c (gfc_match_varspec): If selector expression is
unambiguously an array, make sure that the associate name
is an array and has an array spec. Modify the original
condition for doing this to exclude character types.
2016-04-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/64933
* gfortran.dg/associate_23.f90: New test.
From-SVN: r241860
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 35 |
1 files changed, 28 insertions, 7 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index f26740d..50d7072 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1931,15 +1931,36 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, } /* For associate names, we may not yet know whether they are arrays or not. - Thus if we have one and parentheses follow, we have to assume that it - actually is one for now. The final decision will be made at - resolution time, of course. */ - if (sym->assoc && gfc_peek_ascii_char () == '(' - && !(sym->assoc->dangling && sym->assoc->st + If the selector expression is unambiguously an array; eg. a full array + or an array section, then the associate name must be an array and we can + fix it now. Otherwise, if parentheses follow and it is not a character + type, we have to assume that it actually is one for now. The final + decision will be made at resolution, of course. */ + if (sym->assoc + && gfc_peek_ascii_char () == '(' + && sym->ts.type != BT_CLASS + && !sym->attr.dimension) + { + if ((!sym->assoc->dangling + && sym->assoc->target + && sym->assoc->target->ref + && sym->assoc->target->ref->type == REF_ARRAY + && (sym->assoc->target->ref->u.ar.type == AR_FULL + || sym->assoc->target->ref->u.ar.type == AR_SECTION)) + || + (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER) + && sym->assoc->st && sym->assoc->st->n.sym - && sym->assoc->st->n.sym->attr.dimension == 0) - && sym->ts.type != BT_CLASS) + && sym->assoc->st->n.sym->attr.dimension == 0)) + { sym->attr.dimension = 1; + if (sym->as == NULL && sym->assoc + && sym->assoc->st + && sym->assoc->st->n.sym + && sym->assoc->st->n.sym->as) + sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as); + } + } if ((equiv_flag && gfc_peek_ascii_char () == '(') || gfc_peek_ascii_char () == '[' || sym->attr.codimension |