From a684fb6488c58f91d57af7cc754ecbfb2806e731 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 21 Mar 2015 09:29:40 +0100 Subject: [PATCH] trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented coindexed coarray accesses. 2015-03-21 Tobias Burnus * trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented coindexed coarray accesses. 2015-03-21 Tobias Burnus * gfortran.dg/coarray_38.f90: New. * gfortran.dg/coarray_39.f90: New. * gfortran.dg/coarray/coindexed_3.f90: Add dg-error, turn into compile test. From-SVN: r221549 --- gcc/fortran/ChangeLog | 5 + gcc/fortran/trans-expr.c | 57 +++++++- gcc/testsuite/ChangeLog | 7 + .../gfortran.dg/coarray/coindexed_3.f90 | 10 +- gcc/testsuite/gfortran.dg/coarray_38.f90 | 124 ++++++++++++++++++ gcc/testsuite/gfortran.dg/coarray_39.f90 | 124 ++++++++++++++++++ 6 files changed, 321 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_38.f90 create mode 100644 gcc/testsuite/gfortran.dg/coarray_39.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 21a3b35e9a8..a53b5a87be9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2015-03-21 Tobias Burnus + + * trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented + coindexed coarray accesses. + 2014-03-17 Paul Thomas PR fortran/59198 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 8af8be287ee..fd3dd8c2725 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1498,10 +1498,65 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr) { tree caf_decl; bool found = false; - gfc_ref *ref; + gfc_ref *ref, *comp_ref = NULL; gcc_assert (expr && expr->expr_type == EXPR_VARIABLE); + /* Not-implemented diagnostic. */ + for (ref = expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + { + comp_ref = ref; + if ((ref->u.c.component->ts.type == BT_CLASS + && !CLASS_DATA (ref->u.c.component)->attr.codimension + && (CLASS_DATA (ref->u.c.component)->attr.pointer + || CLASS_DATA (ref->u.c.component)->attr.allocatable)) + || (ref->u.c.component->ts.type != BT_CLASS + && !ref->u.c.component->attr.codimension + && (ref->u.c.component->attr.pointer + || ref->u.c.component->attr.allocatable))) + gfc_error ("Sorry, coindexed access to a pointer or allocatable " + "component of the coindexed coarray at %L is not yet " + "supported", &expr->where); + } + if ((!comp_ref + && ((expr->symtree->n.sym->ts.type == BT_CLASS + && CLASS_DATA (expr->symtree->n.sym)->attr.alloc_comp) + || (expr->symtree->n.sym->ts.type == BT_DERIVED + && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp))) + || (comp_ref + && ((comp_ref->u.c.component->ts.type == BT_CLASS + && CLASS_DATA (comp_ref->u.c.component)->attr.alloc_comp) + || (comp_ref->u.c.component->ts.type == BT_DERIVED + && comp_ref->u.c.component->ts.u.derived->attr.alloc_comp)))) + gfc_error ("Sorry, coindexed coarray at %L with allocatable component is " + "not yet supported", &expr->where); + + if (expr->rank) + { + /* Without the new array descriptor, access like "caf[i]%a(:)%b" is in + general not possible as the required stride multiplier might be not + a multiple of c_sizeof(b). In case of noncoindexed access, the + scalarizer often takes care of it - for coarrays, it always fails. */ + for (ref = expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT + && ((ref->u.c.component->ts.type == BT_CLASS + && CLASS_DATA (ref->u.c.component)->attr.codimension) + || (ref->u.c.component->ts.type != BT_CLASS + && ref->u.c.component->attr.codimension))) + break; + if (ref == NULL) + ref = expr->ref; + for ( ; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.dimen) + break; + for ( ; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + gfc_error ("Sorry, coindexed access at %L to a scalar component " + "with an array partref is not yet supported", + &expr->where); + } + caf_decl = expr->symtree->n.sym->backend_decl; gcc_assert (caf_decl); if (expr->symtree->n.sym->ts.type == BT_CLASS) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a62b54c58a6..fd8a81394c6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2015-03-21 Tobias Burnus + + * gfortran.dg/coarray_38.f90: New. + * gfortran.dg/coarray_39.f90: New. + * gfortran.dg/coarray/coindexed_3.f90: Add dg-error, turn into + compile test. + 2015-03-20 Marek Polacek PR c++/65398 diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 index 46488f3855d..4642f2cfcf9 100644 --- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 +++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 @@ -1,4 +1,4 @@ -! { dg-do run } +! { dg-do compile } ! ! Contributed by Reinhold Bader ! @@ -45,8 +45,8 @@ program pmup allocate(t :: a(3)[*]) IF (this_image() == num_images()) THEN SELECT TYPE (a) - TYPE IS (t) - a(:)[1]%a = 4.0 + TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" + a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } END SELECT END IF SYNC ALL @@ -56,8 +56,8 @@ program pmup TYPE IS (real) ii = a(1)[1] call abort() - TYPE IS (t) - IF (ALL(A(:)[1]%a == 4.0)) THEN + TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" + IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } !WRITE(*,*) 'OK' ELSE WRITE(*,*) 'FAIL' diff --git a/gcc/testsuite/gfortran.dg/coarray_38.f90 b/gcc/testsuite/gfortran.dg/coarray_38.f90 new file mode 100644 index 00000000000..6fa0a65edfc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_38.f90 @@ -0,0 +1,124 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib" } +! +! Valid code - but currently not implemented for -fcoarray=lib; single okay +! +subroutine one +implicit none +type t + integer, allocatable :: a + integer :: b +end type t +type t2 + type(t), allocatable :: caf2[:] +end type t2 +type(t), save :: caf[*],x +type(t2) :: y + +x = caf[4] ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" } +x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = caf[4]%b ! OK +x = y%caf2[5] ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" } +x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = y%caf2[4]%b ! OK +end subroutine one + +subroutine two +implicit none +type t + integer, pointer :: a + integer :: b +end type t +type t2 + type(t), allocatable :: caf2[:] +end type t2 +type(t), save :: caf[*],x +type(t2) :: y + +x = caf[4] ! OK +x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = caf[4]%b ! OK +x = y%caf2[5] ! OK +x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = y%caf2[4]%b ! OK +end subroutine two + +subroutine three +implicit none +type t + integer :: b +end type t +type t2 + type(t), allocatable :: caf2(:)[:] +end type t2 +type(t), save :: caf(10)[*] +integer :: x(10) +type(t2) :: y + +x(1) = caf(2)[4]%b ! OK +x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } + +x(1) = y%caf2(2)[4]%b ! OK +x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } +end subroutine three + +subroutine four +implicit none +type t + integer, allocatable :: a + integer :: b +end type t +type t2 + class(t), allocatable :: caf2[:] +end type t2 +class(t), allocatable :: caf[:] +type(t) :: x +type(t2) :: y + +!x = caf[4] ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397 +x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = caf[4]%b ! OK +!x = y%caf2[5] ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397 +x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = y%caf2[4]%b ! OK +end subroutine four + +subroutine five +implicit none +type t + integer, pointer :: a + integer :: b +end type t +type t2 + class(t), allocatable :: caf2[:] +end type t2 +class(t), save, allocatable :: caf[:] +type(t) :: x +type(t2) :: y + +!x = caf[4] ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397 +x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = caf[4]%b ! OK +!x = y%caf2[5] ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397 +x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" } +x%b = y%caf2[4]%b ! OK +end subroutine five + +subroutine six +implicit none +type t + integer :: b +end type t +type t2 + class(t), allocatable :: caf2(:)[:] +end type t2 +class(t), save, allocatable :: caf(:)[:] +integer :: x(10) +type(t2) :: y + +x(1) = caf(2)[4]%b ! OK +x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } + +x(1) = y%caf2(2)[4]%b ! OK +x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } +end subroutine six diff --git a/gcc/testsuite/gfortran.dg/coarray_39.f90 b/gcc/testsuite/gfortran.dg/coarray_39.f90 new file mode 100644 index 00000000000..17eacb0acb8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_39.f90 @@ -0,0 +1,124 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! Valid code - but currently not implemented for -fcoarray=lib; single okay +! +subroutine one +implicit none +type t + integer, allocatable :: a + integer :: b +end type t +type t2 + type(t), allocatable :: caf2[:] +end type t2 +type(t), save :: caf[*],x +type(t2) :: y + +x = caf[4] +x%a = caf[4]%a +x%b = caf[4]%a +x = y%caf2[5] +x%a = y%caf2[4]%a +x%b = y%caf2[4]%b +end subroutine one + +subroutine two +implicit none +type t + integer, pointer :: a + integer :: b +end type t +type t2 + type(t), allocatable :: caf2[:] +end type t2 +type(t), save :: caf[*],x +type(t2) :: y + +x = caf[4] +x%a = caf[4]%a +x%b = caf[4]%b +x = y%caf2[5] +x%a = y%caf2[4]%a +x%b = y%caf2[4]%b +end subroutine two + +subroutine three +implicit none +type t + integer :: b +end type t +type t2 + type(t), allocatable :: caf2(:)[:] +end type t2 +type(t), save :: caf(10)[*] +integer :: x(10) +type(t2) :: y + +x(1) = caf(2)[4]%b +x(:) = caf(:)[4]%b + +x(1) = y%caf2(2)[4]%b +x(:) = y%caf2(:)[4]%b +end subroutine three + +subroutine four +implicit none +type t + integer, allocatable :: a + integer :: b +end type t +type t2 + class(t), allocatable :: caf2[:] +end type t2 +class(t), allocatable :: caf[:] +type(t) :: x +type(t2) :: y + +x = caf[4] +x%a = caf[4]%a +x%b = caf[4]%b +x = y%caf2[5] +x%a = y%caf2[4]%a +x%b = y%caf2[4]%b +end subroutine four + +subroutine five +implicit none +type t + integer, pointer :: a + integer :: b +end type t +type t2 + class(t), allocatable :: caf2[:] +end type t2 +class(t), save, allocatable :: caf[:] +type(t) :: x +type(t2) :: y + +x = caf[4] +x%a = caf[4]%a +x%b = caf[4]%b +x = y%caf2[5] +x%a = y%caf2[4]%a +x%b = y%caf2[4]%b +end subroutine five + +subroutine six +implicit none +type t + integer :: b +end type t +type t2 + class(t), allocatable :: caf2(:)[:] +end type t2 +class(t), save, allocatable :: caf(:)[:] +integer :: x(10) +type(t2) :: y + +x(1) = caf(2)[4]%b +x(:) = caf(:)[4]%b + +x(1) = y%caf2(2)[4]%b +x(:) = y%caf2(:)[4]%b +end subroutine six -- 2.30.2