procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/46370 ([Coarray] [OOP] ALLOCATE: Error allocating CLASS coarrays)

Browse source 
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  Tobias Burnus  <burnus@net-b.de>

        PR fortran/46370
        * gfortran.dg/coarray_14.f90: New.

From-SVN: r167715
This commit is contained in:
Tobias Burnus 2010-12-11 23:04:06 +01:00 • committed by Tobias Burnus
parent 1dbe5c7838
commit a70de21ffb
5 changed files with 80 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -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>

6
gcc/fortran/primary.c
View file

@ -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;

15
gcc/fortran/resolve.c
View file

@ -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)
{

5
gcc/testsuite/ChangeLog
View file

@ -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

55
gcc/testsuite/gfortran.dg/coarray_14.f90 Normal file
View file

@ -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" } }