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
This commit is contained in:
parent
01826160a3
commit
6bb45a6b52
|
@ -1,3 +1,11 @@
|
||||||
|
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-01 Jakub Jelinek <jakub@redhat.com>
|
2019-02-01 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR fortran/83246
|
PR fortran/83246
|
||||||
|
|
|
@ -1072,15 +1072,17 @@ is_subref_array (gfc_expr * e)
|
||||||
if (e->symtree->n.sym->attr.subref_array_pointer)
|
if (e->symtree->n.sym->attr.subref_array_pointer)
|
||||||
return true;
|
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;
|
seen_array = false;
|
||||||
|
|
||||||
for (ref = e->ref; ref; ref = ref->next)
|
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
|
if (ref->type == REF_ARRAY
|
||||||
&& ref->u.ar.type != AR_ELEMENT)
|
&& ref->u.ar.type != AR_ELEMENT)
|
||||||
seen_array = true;
|
seen_array = true;
|
||||||
|
@ -1089,6 +1091,13 @@ is_subref_array (gfc_expr * e)
|
||||||
&& ref->type != REF_ARRAY)
|
&& ref->type != REF_ARRAY)
|
||||||
return seen_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;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
2019-02-02 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/88685
|
||||||
|
* gfortran.dg/pointer_array_component_3.f90 : New test.
|
||||||
|
|
||||||
2019-02-02 Jakub Jelinek <jakub@redhat.com>
|
2019-02-02 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR middle-end/87887
|
PR middle-end/87887
|
||||||
|
|
|
@ -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 <antony@cosmologist.info>
|
||||||
|
!
|
||||||
|
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
|
Loading…
Reference in New Issue