From a70de21ffba9c1c8b4c5096bf9faf3deeb054c76 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 11 Dec 2010 23:04:06 +0100 Subject: [PATCH] re PR fortran/46370 ([Coarray] [OOP] ALLOCATE: Error allocating CLASS coarrays) 2010-12-11 Tobias Burnus PR fortran/46370 * primary.c (gfc_match_varspec): Pass information about * codimension to gfc_match_array_ref also for BT_CLASS. * resolve.c (resolve_procedure): Correct check for C612. 2010-12-11 Tobias Burnus PR fortran/46370 * gfortran.dg/coarray_14.f90: New. From-SVN: r167715 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/primary.c | 6 ++- gcc/fortran/resolve.c | 15 ++++--- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/coarray_14.f90 | 55 ++++++++++++++++++++++++ 5 files changed, 80 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 03068e0c6a0..7c3fca8c35c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-12-11 Tobias Burnus + + PR fortran/46370 + * primary.c (gfc_match_varspec): Pass information about codimension + to gfc_match_array_ref also for BT_CLASS. + * resolve.c (resolve_procedure): Correct check for C612. + 2010-12-11 Mikael Morin Jerry DeLisle diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 9632d1c8523..1ec677b287b 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1783,7 +1783,11 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, tail->type = REF_ARRAY; m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as, - equiv_flag, sym->as ? sym->as->corank : 0); + equiv_flag, + sym->ts.type == BT_CLASS + ? (CLASS_DATA (sym)->as + ? CLASS_DATA (sym)->as->corank : 0) + : (sym->as ? sym->as->corank : 0)); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9d8ee23ce80..ab49e93f8fe 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5027,13 +5027,6 @@ resolve_procedure: { gfc_ref *ref, *ref2 = NULL; - if (e->ts.type == BT_CLASS) - { - gfc_error ("Polymorphic subobject of coindexed object at %L", - &e->where); - t = FAILURE; - } - for (ref = e->ref; ref; ref = ref->next) { if (ref->type == REF_COMPONENT) @@ -5046,6 +5039,14 @@ resolve_procedure: if (ref->type == REF_COMPONENT) break; + /* Expression itself is not coindexed object. */ + if (ref && e->ts.type == BT_CLASS) + { + gfc_error ("Polymorphic subobject of coindexed object at %L", + &e->where); + t = FAILURE; + } + /* Expression itself is coindexed object. */ if (ref == NULL) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ed15e1659e7..934212fbddb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-12-11 Tobias Burnus + + PR fortran/46370 + * gfortran.dg/coarray_14.f90: New. + 2010-12-11 Jerry DeLisle PR fortran/46842 diff --git a/gcc/testsuite/gfortran.dg/coarray_14.f90 b/gcc/testsuite/gfortran.dg/coarray_14.f90 new file mode 100644 index 00000000000..9230ad4f32b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_14.f90 @@ -0,0 +1,55 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! PR fortran/46370 +! +! Coarray checks +! + +! Check for C1229: "A data-ref shall not be a polymorphic subobject of a +! coindexed object." which applies to function and subroutine calls. +module m + implicit none + type t + contains + procedure, nopass :: sub=>sub + procedure, nopass :: func=>func + end type t + type t3 + type(t) :: nopoly + end type t3 + type t2 + class(t), allocatable :: poly + class(t3), allocatable :: poly2 + end type t2 +contains + subroutine sub() + end subroutine sub + function func() + integer :: func + end function func +end module m + +subroutine test(x) + use m + type(t2) :: x[*] + integer :: i + call x[1]%poly2%nopoly%sub() ! OK + i = x[1]%poly2%nopoly%func() ! OK + call x[1]%poly%sub() ! { dg-error "Polymorphic subobject of coindexed object" } + i = x[1]%poly%func() ! { dg-error "Polymorphic subobject of coindexed object" } +end subroutine test + + +! Check for C617: "... a data-ref shall not be a polymorphic subobject of a +! coindexed object or ..." +! Before, the second allocate statment was failing - though it is no subobject. +program myTest +type t +end type t +class(t), allocatable :: a[:] + allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" } +allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" } +end program myTest + +! { dg-final { cleanup-modules "m" } }