+2015-03-21 Tobias Burnus <burnus@net-b.de>
+
+ * trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented
+ coindexed coarray accesses.
+
2014-03-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/59198
{
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)
+2015-03-21 Tobias Burnus <burnus@net-b.de>
+
+ * 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 <polacek@redhat.com>
PR c++/65398
-! { dg-do run }
+! { dg-do compile }
!
! Contributed by Reinhold Bader
!
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
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'
--- /dev/null
+! { 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
--- /dev/null
+! { 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
projects / gcc.git / commitdiff