From patchwork Tue Jan 27 07:27:07 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 433209 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 0974514012E for ; Tue, 27 Jan 2015 18:27:40 +1100 (AEDT) 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:cc:subject:references :in-reply-to:content-type; q=dns; s=default; b=OZ9QvDaLrtR7OWiFO YYayx9B/1ClymYleoXbolDnCnpR4IQTP3z/cJCh23p1zyUXmyoWqgazKF86/hGHs 7XurA9bFQTAfVh8js9WAxu10T0a4Pa7P5fFW1ojrrxdq+cyWCLIf6eAJa87KwfsP vnA6t5ENfzVio86sb+XF7E26iQ= 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:cc:subject:references :in-reply-to:content-type; s=default; bh=scPoJCyZ+sV4hxNmq5cn4u0 +I84=; b=mbCHDt8ZibYLiBxAoLDX2jRmhNa0CdDfOe74BZn35O+O6u9DRK2DBC1 QbPY/wZlnTp8cYRYaHcJmwymseW+h8Gworq2JiMzlQe1nKoPzNU4GMYQK+D5VJMK TLV72NaW6TKB579qqm9zpP6DxAMl6WbJRT92trw0z+P5of/DlVcU= Received: (qmail 19113 invoked by alias); 27 Jan 2015 07:27:23 -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 19075 invoked by uid 89); 27 Jan 2015 07:27:18 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-0.0 required=5.0 tests=AWL autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx01.qsc.de Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Tue, 27 Jan 2015 07:27:15 +0000 Received: from tux.net-b.de (port-92-194-20-233.dynamic.qsc.de [92.194.20.233]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx01.qsc.de (Postfix) with ESMTPSA id 85F833CD36; Tue, 27 Jan 2015 08:27:08 +0100 (CET) Message-ID: <54C73DCB.8070107@net-b.de> Date: Tue, 27 Jan 2015 08:27:07 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.3.0 MIME-Version: 1.0 To: Jakub Jelinek , Tobias Burnus CC: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org, Cesar Philippidis Subject: Re: [Patch, Fortran] PR63861 - fix OpenMP/ACC's gfc_has_alloc_comps References: <20150126121439.GB19591@physik.fu-berlin.de> <20150126123623.GL1746@tucnak.redhat.com> In-Reply-To: <20150126123623.GL1746@tucnak.redhat.com> Updated patch below. Jakub Jelinek wrote: > On Mon, Jan 26, 2015 at 01:14:39PM +0100, Tobias Burnus wrote: >> The question is why I didn't see the nonsense in the test suite. It >> doesn't seem to be tested for in gcc/testsuite/gfortran.dg/; it might be >> tested in libgomp/testsuite/ - I don't recall whether I retested after >> the (incomplete) change back from "if" to "while" + (wrong) rank check. It does show up in libgomp's alloc-comp-1.f90 – seems I just forgot to re-run libgomp's testsuite :-( (In testsuite/gfortran*, it does not show up.) >> All: Any preference for "if" or "while" + rank != 0? > If it works, fine. But perhaps put there some comment on why > for rank == 0 arrays get_element_type is undesirable. I have now used a simple IF, which also avoids the rank check. (With while one has an endless loop without.) But I added a comment to get_element_type. Augmenting the test case a bit, lead to another related issue for OpenMP's "map". I hope that I got the passed information right. Build and regtested (testsuite + libgomp) on x86-64-gnu-linux. OK for the trunk? There is another issue with reduction, which I defer. [Assignment of "a = 0"; I am not sure whether it goes to the realloc on assignment code, but for coarrays, no automatic reallocation shall happen (on the host).] Tobias 2015-01-27 Tobias Burnus PR fortran/63861 gcc/fortran/ * trans-openmp.c (gfc_has_alloc_comps, gfc_trans_omp_clauses): Fix handling for scalar coarrays. * trans-types.c (gfc_get_element_type): Add comment. gcc/testsuite/ * gfortran.dg/goacc/coarray_2.f90: New. diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index cdd1885..8da55d3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -190,5 +190,5 @@ gfc_has_alloc_comps (tree type, tree decl) } - while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)) + if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)) type = gfc_get_element_type (type); @@ -1990,5 +1990,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, = gfc_conv_descriptor_data_get (decl); OMP_CLAUSE_SIZE (node3) = size_int (0); - if (n->sym->attr.pointer) + + /* We have to check for n->sym->attr.dimension because + of scalar coarrays. */ + if (n->sym->attr.pointer && n->sym->attr.dimension) { stmtblock_t cond_block; @@ -2020,14 +2023,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node) = size; } - else + else if (n->sym->attr.dimension) OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, decl, GFC_TYPE_ARRAY_RANK (type)); - tree elemsz - = TYPE_SIZE_UNIT (gfc_get_element_type (type)); - elemsz = fold_convert (gfc_array_index_type, elemsz); - OMP_CLAUSE_SIZE (node) - = fold_build2 (MULT_EXPR, gfc_array_index_type, - OMP_CLAUSE_SIZE (node), elemsz); + if (n->sym->attr.dimension) + { + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } } else diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 1ee490e..53da053 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1173,4 +1173,8 @@ gfc_conv_array_bound (gfc_expr * expr) } +/* Return the type of an element of the array. Note that scalar coarrays + are special. In particular, for GFC_ARRAY_TYPE_P, the original argument + (with POINTER_TYPE stripped) is returned. */ + tree gfc_get_element_type (tree type) diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 new file mode 100644 index 0000000..f35d4b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/coarray_2.f90 @@ -0,0 +1,108 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=lib" } +! +! PR fortran/63861 + +module test +contains + subroutine oacc1(a) + implicit none + integer :: i + integer, codimension[*] :: a + !$acc declare device_resident (a) + !$acc data copy (a) + !$acc end data + !$acc data deviceptr (a) + !$acc end data + !$acc parallel private (a) + !$acc end parallel + !$acc host_data use_device (a) + !$acc end host_data + !$acc parallel loop reduction(+:a) + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update device (a) + !$acc update host (a) + !$acc update self (a) + end subroutine oacc1 + + subroutine oacc2(a) + implicit none + integer :: i + integer, allocatable, codimension[:] :: a + !$acc declare device_resident (a) + !$acc data copy (a) + !$acc end data + !$acc parallel private (a) + !$acc end parallel +! FIXME: +! !$acc parallel loop reduction(+:a) +! This involves an assignment, which shall not reallocate +! the LHS variable. Version without reduction: + !$acc parallel loop + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update device (a) + !$acc update host (a) + !$acc update self (a) + end subroutine oacc2 + + subroutine oacc3(a) + implicit none + integer :: i + integer, codimension[*] :: a(:) + !$acc declare device_resident (a) + !$acc data copy (a) + !$acc end data + !$acc data deviceptr (a) + !$acc end data + !$acc parallel private (a) + !$acc end parallel + !$acc host_data use_device (a) + !$acc end host_data + !$acc parallel loop reduction(+:a) + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update device (a) + !$acc update host (a) + !$acc update self (a) + end subroutine oacc3 + + subroutine oacc4(a) + implicit none + integer :: i + integer, allocatable, codimension[:] :: a(:) + !$acc declare device_resident (a) + !$acc data copy (a) + !$acc end data + !$acc parallel private (a) + !$acc end parallel + !$acc parallel loop reduction(+:a) + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update device (a) + !$acc update host (a) + !$acc update self (a) + end subroutine oacc4 +end module test +! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }