diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/primary.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 15 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_14.f90 | 55 |
5 files changed, 80 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 03068e0..7c3fca8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-12-11 Tobias Burnus <burnus@net-b.de> + + 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 <mikael@gcc.gnu.org> Jerry DeLisle <jvdelisle@gcc.gnu.org> diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 9632d1c..1ec677b 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 9d8ee23..ab49e93 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 ed15e16..934212f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-12-11 Tobias Burnus <burnus@net-b.de> + + PR fortran/46370 + * gfortran.dg/coarray_14.f90: New. + 2010-12-11 Jerry DeLisle <jvdelisle@gcc.gnu.org> 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 0000000..9230ad4 --- /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" } } |