From patchwork Thu Mar 12 07:18:05 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 449419 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 7647514010F for ; Thu, 12 Mar 2015 23:18:14 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=okuoaxEK; dkim-adsp=none (unprotected policy); dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=VJrGw6OziU4is58JdtmHy0QM49FQJMJmSjShC6489BoaHx Bv21O0ygvg+TUSsFVQk+kNyOVYrDgm5/Gk5eEs7urmi3BmSRqCEvzKRwaWxChCar Td72rDTIzCb9lhVsDKVyGn6McMC90zSrVLLBnVm8CORKraxuUK1XxuXhX66Eg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=4pL5jN6rAxCttHtes3YOIWXK4+k=; b=okuoaxEKXdZDiAFg1C1e Zk6Y+7PS/mbc8NpAmh1OZhbwkeWBsuPKazhHAGFXFkBepRbCaZOzhVzwWr/O1kQL PQpmjHTV7CYOALi0pihQt+0WtSw/XK+6wsX3LLXOpLRvZnLqy/uqhPOld6SHWu81 OwhEoeuGNfq7mEbwmNDjxOU= Received: (qmail 8523 invoked by alias); 12 Mar 2015 12:17:33 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 8470 invoked by uid 89); 12 Mar 2015 12:17:32 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.0 required=5.0 tests=AWL, BAYES_00 autolearn=unavailable version=3.3.2 X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (208.118.235.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Thu, 12 Mar 2015 12:17:29 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YVxU0-0006Po-JP for gcc-patches@gcc.gnu.org; Thu, 12 Mar 2015 03:24:45 -0400 Received: from mx02.qsc.de ([213.148.130.14]:54297) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YVxU0-0006GL-3B for gcc-patches@gcc.gnu.org; Thu, 12 Mar 2015 03:24:40 -0400 Received: from tux.net-b.de (port-92-194-228-167.dynamic.qsc.de [92.194.228.167]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id C8EEB27644; Thu, 12 Mar 2015 08:18:06 +0100 (CET) Message-ID: <55013DAD.4070603@net-b.de> Date: Thu, 12 Mar 2015 08:18:05 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.4.0 MIME-Version: 1.0 To: gcc-patches , gfortran Subject: [Patch, Fortran] Reject unsupported coarray communication X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 213.148.130.14 There are two groups of features which are not properly implemented with remote access: * "caf(:)[i]%a" might have a byte stride which is not compatible with the size of "a". (Fix: new array descriptor.) * All access which involves dereferencing pointers in a remote coarray (e.g. "caf[i]%ptr_comp = 5") are not supported. This patch now rejects them - instead of accepting them silently and doing the wrong things at runtime. Build and regtested on x86-64-gnu-linux OK for the trunk? Tobias 2015-03-11 Tobias Burnus * trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented coindexed coarray accesses. * 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. gcc/fortran/trans-expr.c | 57 +++++++++- gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 | 10 +- gcc/testsuite/gfortran.dg/coarray_38.f90 | 124 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/coarray_39.f90 | 124 ++++++++++++++++++++++ 4 files changed, 309 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 353d012..87d3a2d 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/gfortran.dg/coarray/coindexed_3.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 index 46488f3..4642f2c 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 0000000..ea62878 --- /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 0000000..17eacb0 --- /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