From 6bb45a6b52046f51193c34bbd026a13bf48b4b49 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 2 Feb 2019 09:10:58 +0000 Subject: [PATCH] re PR fortran/88685 (pointer class array argument indexing) 2019-02-02 Paul Thomas 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 PR fortran/88685 * gfortran.dg/pointer_array_component_3.f90 : New test. From-SVN: r268472 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/expr.c | 21 +++++++---- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/pointer_array_component_3.f90 | 36 +++++++++++++++++++ 4 files changed, 64 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0a5da36a601..1dc007d1a2e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2019-02-02 Paul Thomas + + 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-01 Jakub Jelinek PR fortran/83246 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a9e7f36c491..a0eb94fbbcc 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4687a662dfb..bc9ca4c289c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-02-02 Paul Thomas + + PR fortran/88685 + * gfortran.dg/pointer_array_component_3.f90 : New test. + 2019-02-02 Jakub Jelinek PR middle-end/87887 diff --git a/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 b/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 new file mode 100644 index 00000000000..8ef205bc14f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_array_component_3.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! +! Test the fix for PR88685, in which the component array references in 'doit' +! were being ascribed to the class pointer 'Cls' itself so that the stride +! measure between elements was wrong. +! +! Contributed by Antony Lewis +! +program tester + implicit none + Type TArr + integer, allocatable :: CL(:) + end Type TArr + + type(TArr), allocatable, target :: arr(:,:) + class(TArr), pointer:: Cls(:,:) + integer i + + allocate(arr(1,1)) + allocate(arr(1,1)%CL(3)) + arr(1,1)%CL=-1 + cls => arr + call doit(cls) + if (any (arr(1,1)%cl .ne. [3,2,1])) stop 3 +contains + subroutine doit(cls) + class(TArr), pointer :: Cls(:,:) + + cls(1,1)%CL(1) = 3 + cls(1,1)%CL(2:3) = [2,1] + + if (any (Cls(1,1)%CL .ne. [3,2,1])) stop 1 + if (Cls(1,1)%CL(2) .ne. 2) stop 2 + + end subroutine doit +end program tester -- 2.30.2