From patchwork Thu Sep 29 12:03:35 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 676615 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 3slCsj5DWHz9s3v for ; Thu, 29 Sep 2016 22:04:09 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=t3intLmN; 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:date :from:to:subject:message-id:mime-version:content-type; q=dns; s= default; b=gEc/geTtkAfmVXMuYEiR4Hd3ps2Pfhaz3w2sOvz9LKuzq79k6tr13 j9GnRdG/uDCmPOWJ+0IkpD2U35wQo7VgFAloia9KxFRJ4HRuk7BL0bEivXM4qnBw UBkdf5dzR5UqKw5fKcsKOs5pvxJC5H2DAaW0OoyNw9xVUvfB1LFMH4= 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:date :from:to:subject:message-id:mime-version:content-type; s= default; bh=HrmmvMYGu7qYbFkgTWa8ZFrbWGY=; b=t3intLmNUzkDWZUXOO0Y dHzTO8VgaPeMNSS3OmO7FrheVoS1lnecW60J2PU0al0Jyd/XsC05GO0d/dkSK9z/ KwkEB2JTNydR6BYRiPhqISAtMMm5fPqgsWAMv3lonTBkSNr5mbyzSsMQ04cWOW6S E7t1egO3xXX67d02zINo+w4= Received: (qmail 114883 invoked by alias); 29 Sep 2016 12:03:53 -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 114863 invoked by uid 89); 29 Sep 2016 12:03:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.0 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:gfc_con, gfc_expr, Andre, sk:GFC_FCO X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.20) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 29 Sep 2016 12:03:46 +0000 Received: from vepi2 ([84.63.206.51]) by mail.gmx.com (mrgmx102) with ESMTPSA (Nemesis) id 0MNw0t-1bs4tX1woV-007T85; Thu, 29 Sep 2016 14:03:36 +0200 Date: Thu, 29 Sep 2016 14:03:35 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML , Damian Rouson , Paul Richard Thomas Subject: [accaf, Fortran, patch, v1] Generate caf-reference chains only from the first coarray reference on, and more. Message-ID: <20160929140335.49237ec4@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:xzdnmb084MI=:/JecxY6nrO0BW1A8fA5BFw ihFZxQFcp9o5XRuzYMo2BW3fgEIljeax/Uwm/iGtzGmqmK2EeyAb7Kqyb2BBII0qc1nmRvHmk GQyGORY8+696Jssv9poZyIOPaR9z8/9OP0a+FxBC8Z7E2GiX74qs/5j0xAzEG7RMhDFxTQAcZ vG3mZNTV5aT0Z9N/jIyoYW20gpfwV/BGLQWCaPuiLQoB03GVn42FOLXurKi2hMyRzzRJGeN+u y/8bYraHQrx5xomwDlk+aGQc8sO7vh572kYfeMluONlgzgqvQZ2TvB1KRhfpbuwxYdyv4IEmp eU5MmiVFjGgBkdUzqb+nz7B+5LOxwmstVqslmYj1qY7Ls60ErJivWcFIcLJEM3h4cPK1LoviP bhgfFw0M65h24J4/mt/MhSc7XY9CRjqKoaHBNf9BQbF2IwA+NeRpfwwOZ+s0s+TIkraohzt/r sLnGcE0KtBeoNF1wLEEdWCpnlP9OcIOT4GHs63U3/p5kPfQzfkxf9ySF/dCwFtE6W0sr7xdpT +yp0uRtBl29CJVY2Pm6Ul5JObeT3Gi6KmgCyUcSOnb6qmDLX8qO1BQnBQhWpTQNcO9O317Rer fP4oG/YrwhkjcnVwOYr6qBCdngKXiT0kQR2HKJcv/YjDFOAqnEITJI8cOac7CIdCBvi6VyOau wfFvSA/6CISAV8bcIQ1xGNNkffAZilnv9eDLw1U/FCnE9Ie4ZGfe9EDD2Wl6pU0BKtfRxMa9p G+nz17qHYu5Vbf7d2ZifESxb56h3NsWE+EBme6PeHMu7Le8+ZS7lcns+Irw= Hi all, attached patch fixes an addressing issue for coarrays *in* derived types. Before the patch the caf runtime reference chain was generated from the start of the symbol to the last reference *and* the reference chain upto the coarray in the derived type was used to call the caf_*_by_ref () functions. The patch fixes this by skipping the generation of unnecessary caf runtime references. The second part fixes finding the token for coarrayed arrays. The new semantic is, that each allocatable array has the coarray token in its .token member, which the allocate_array now makes use of. Bootstrapped and regtested ok on x86_64-linux/F23. Ok for trunk? Regards, Andre diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0b97760..50312fe 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5406,7 +5406,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_expr **lower; gfc_expr **upper; gfc_ref *ref, *prev_ref = NULL, *coref; - gfc_se caf_se; bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false; ref = expr->ref; @@ -5531,7 +5530,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, } } - gfc_init_se (&caf_se, NULL); gfc_start_block (&elseblock); /* Allocate memory to store the data. */ @@ -5543,9 +5541,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (coarray && flag_coarray == GFC_FCOARRAY_LIB) { - tmp = gfc_get_tree_for_caf_expr (expr); - gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE, expr); - gfc_add_block_to_block (&elseblock, &caf_se.pre); + token = gfc_conv_descriptor_token (se->expr); token = gfc_build_addr_expr (NULL_TREE, token); } @@ -5557,7 +5553,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, else gfc_allocate_using_malloc (&elseblock, pointer, size, status); - gfc_add_block_to_block (&elseblock, &caf_se.post); if (dimension) { cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 954f7b3..a499c32 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1110,7 +1110,7 @@ compute_component_offset (tree field, tree type) static tree conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) { - gfc_ref *ref = expr->ref; + gfc_ref *ref = expr->ref, *last_comp_ref; tree caf_ref = NULL_TREE, prev_caf_ref = NULL_TREE, reference_type, tmp, tmp2, field, last_type, inner_struct, mode, mode_rhs, dim_array, dim, dim_type, start, end, stride, vector, nvec; @@ -1127,8 +1127,29 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) /* Prevent uninit-warning. */ reference_type = NULL_TREE; - last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts); - last_type_n = expr->symtree->n.sym->ts.type; + + /* Skip refs upto the first coarray-ref. */ + last_comp_ref = NULL; + while (ref && (ref->type != REF_ARRAY || ref->u.ar.codimen == 0)) + { + /* Remember the type of components skipped. */ + if (ref->type == REF_COMPONENT) + last_comp_ref = ref; + ref = ref->next; + } + /* When a component was skipped, get the type information of the last + component ref, else get the type from the symbol. */ + if (last_comp_ref) + { + last_type = gfc_typenode_for_spec (&last_comp_ref->u.c.component->ts); + last_type_n = last_comp_ref->u.c.component->ts.type; + } + else + { + last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts); + last_type_n = expr->symtree->n.sym->ts.type; + } + while (ref) { if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 27a6bab..05122d9 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2565,7 +2565,8 @@ gfc_get_derived_type (gfc_symbol * derived, bool in_coarray) if ((!c->attr.pointer && !c->attr.proc_pointer) || c->ts.u.derived->backend_decl == NULL) c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived, - in_coarray); + in_coarray + || c->attr.codimension); if (c->ts.u.derived->attr.is_iso_c) { diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 new file mode 100644 index 0000000..30ee216 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 @@ -0,0 +1,39 @@ +! { dg-do run } +! { dg-options "-fcoarray=lib -lcaf_single" } + +program alloc_comp + implicit none + + type coords + integer,allocatable :: x(:) + end type + + type outerT + type(coords),allocatable :: coo[:] + end type + integer :: me,np,n,i + type(outerT) :: o + + ! with caf_single num_images is always == 1 + me = this_image(); np = num_images() + n = 100 + + allocate(o%coo[*]) + allocate(o%coo%x(n)) + + o%coo%x = me + + do i=1, n + o%coo%x(i) = o%coo%x(i) + i + end do + + sync all + + if(me == 1 .and. o%coo[np]%x(10) /= 11 ) call abort() + + ! Check the whole array is correct. + if (me == 1 .and. any( o%coo[np]%x /= [(i, i=2, 101)] ) ) call abort() + + deallocate(o%coo%x) + +end program diff --git a/gcc/testsuite/gfortran.dg/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coindexed_1.f90 index b25f2f8..932442c 100644 --- a/gcc/testsuite/gfortran.dg/coindexed_1.f90 +++ b/gcc/testsuite/gfortran.dg/coindexed_1.f90 @@ -1,5 +1,5 @@ -! { dg-do compile } -! { dg-options "-fcoarray=lib" } +! { dg-do run } +! { dg-options "-fcoarray=lib -lcaf_single" } ! ! Contributed by Reinhold Bader ! @@ -14,7 +14,7 @@ program pmup integer :: ii !! --- ONE --- - allocate(real :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" } + allocate(real :: a(3)[*]) IF (this_image() == num_images()) THEN SELECT TYPE (a) TYPE IS (real) @@ -43,7 +43,7 @@ program pmup !! --- TWO --- deallocate(a) - allocate(t :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" } + allocate(t :: a(3)[*]) IF (this_image() == num_images()) THEN SELECT TYPE (a) TYPE IS (t)