diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2019-02-02 09:10:58 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2019-02-02 09:10:58 +0000 |
commit | 6bb45a6b52046f51193c34bbd026a13bf48b4b49 (patch) | |
tree | 3f7e9bb398c6c762970d432172a8abfebe6e0d64 /gcc/fortran/expr.c | |
parent | 01826160a3b2ab2f0c68c13b47d3467cf9618fbb (diff) | |
download | gcc-6bb45a6b52046f51193c34bbd026a13bf48b4b49.zip gcc-6bb45a6b52046f51193c34bbd026a13bf48b4b49.tar.gz gcc-6bb45a6b52046f51193c34bbd026a13bf48b4b49.tar.bz2 |
re PR fortran/88685 (pointer class array argument indexing)
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88685
* expr.c (is_subref_array): Move the check for class pointer
dummy arrays to after the reference check. If we haven't seen
an array reference other than an element and a component is not
class or derived, return false.
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88685
* gfortran.dg/pointer_array_component_3.f90 : New test.
From-SVN: r268472
Diffstat (limited to 'gcc/fortran/expr.c')
-rw-r--r-- | gcc/fortran/expr.c | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a9e7f36..a0eb94f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1072,15 +1072,17 @@ is_subref_array (gfc_expr * e) if (e->symtree->n.sym->attr.subref_array_pointer) return true; - if (e->symtree->n.sym->ts.type == BT_CLASS - && e->symtree->n.sym->attr.dummy - && CLASS_DATA (e->symtree->n.sym)->attr.dimension - && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer) - return true; - seen_array = false; + for (ref = e->ref; ref; ref = ref->next) { + /* If we haven't seen the array reference and this is an intrinsic, + what follows cannot be a subreference array. */ + if (!seen_array && ref->type == REF_COMPONENT + && ref->u.c.component->ts.type != BT_CLASS + && !gfc_bt_struct (ref->u.c.component->ts.type)) + return false; + if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) seen_array = true; @@ -1089,6 +1091,13 @@ is_subref_array (gfc_expr * e) && ref->type != REF_ARRAY) return seen_array; } + + if (e->symtree->n.sym->ts.type == BT_CLASS + && e->symtree->n.sym->attr.dummy + && CLASS_DATA (e->symtree->n.sym)->attr.dimension + && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer) + return true; + return false; } |