From patchwork Sat Nov 22 14:14:53 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 413297 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 1BF4E14011E for ; Sun, 23 Nov 2014 01:15:07 +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=m1wgeu2Ew3Cscsrz6 GqdX7Hz7vmP9XnL+8nRAN5Q6xQCBoqNIE2FK4wiyD68emkwolJEeinIXb3JPD93b 54T65rdcu5bUYIFVRnRhQtSmFgaRJjtUIZXuju5bZ10DEeG8pvBxpaBqxY9R0bDM JAO/520iLhO4et62l/6knqAlB0= 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=S057ZG89FEtHkSGToyknGXF Hg9Y=; b=TgBX3OHwqwnllr66FLgc3B/lu+j2/LfrJGYRk9G7gRsIK1J5ubPyk9V QAb+kXQmuWXIvD4Y0kveUP/xJ8qwL7Op2P6H/10rqHkxL793BIQEHdsHiYrOH94e 37wXzYxC3udNtvY7KhuUgQ9d0gAWJN2sF7Uzv3fFfDgnaYCIXST0= Received: (qmail 6546 invoked by alias); 22 Nov 2014 14:14:59 -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 6529 invoked by uid 89); 22 Nov 2014 14:14:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx02.qsc.de Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Sat, 22 Nov 2014 14:14:57 +0000 Received: from tux.net-b.de (port-92-194-114-130.dynamic.qsc.de [92.194.114.130]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id BC7A62774F; Sat, 22 Nov 2014 15:14:53 +0100 (CET) Message-ID: <54709A5D.5070604@net-b.de> Date: Sat, 22 Nov 2014 15:14:53 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.2.0 MIME-Version: 1.0 To: Alessandro Fanfarillo , gfortran CC: gcc-patches Subject: [Patch, Fortran,committed] Re: Cosubscript issue References: <546D17A9.6060609@net-b.de> In-Reply-To: <546D17A9.6060609@net-b.de> On 19 November 2014 at 23:20, Tobias Burnus wrote: > Alessandro Fanfarillo wrote: >> The sum of the three indexes, k, j and i returns a wrong image index. > Fixed as confirmed off list by the attached patch. > > I intent to commit it as obvious once building and regtesting has > finally finished. > Comments are nontheless welcome. Took a while longer as it turned out that the test case didn't work for odd number of images. As testing showed, other compilers behave the same and codewise, I didn't understand: + if (MOD(num_images(),((P+1)*(Q+2))) .ge. 1) then + dim3_max = dim3_max+1 + end if And indeed, removing that code from the test case, it worked – and also the test program makes sense to me. Hence, I have now committed the patch together with the fixed test case as Rev. 217966. Tobias Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 217965) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,7 @@ +2014-11-22 Tobias Burnus + + * trans-expr.c (gfc_caf_get_image_index): Fix image calculation. + 2014-11-15 Tobias Burnus * error.c (gfc_fatal_error_1): Renamed from gfc_fatal_error. Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 217965) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1518,8 +1518,8 @@ gfc_get_caf_token_offset (tree *token, tree *offse /* Convert the coindex of a coarray into an image index; the result is - image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2)+1)*extent(1) - + (idx(3)-lcobound(3)+1)*extent(2) + ... */ + image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2))*extent(1) + + (idx(3)-lcobound(3))*extend(1)*extent(2) + ... */ tree gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc) @@ -1553,8 +1553,10 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_e if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1) { ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]); - extent = gfc_conv_array_extent_dim (lbound, ubound, NULL); - extent = fold_convert (integer_type_node, extent); + tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL); + tmp = fold_convert (integer_type_node, tmp); + extent = fold_build2_loc (input_location, MULT_EXPR, + integer_type_node, extent, tmp); } } else @@ -1575,10 +1577,12 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_e { ubound = GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (desc), i); ubound = fold_convert (integer_type_node, ubound); - extent = fold_build2_loc (input_location, MINUS_EXPR, + tmp = fold_build2_loc (input_location, MINUS_EXPR, integer_type_node, ubound, lbound); - extent = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, - extent, integer_one_node); + tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, + tmp, integer_one_node); + extent = fold_build2_loc (input_location, MULT_EXPR, + integer_type_node, extent, tmp); } } img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 217965) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,7 @@ +2014-11-22 Tobias Burnus + + * gfortran.dg/coarray/cosubscript_1.f90: New. + 2014-11-22 Eric Botcazou * gnat.dg/specs/pack11.ads: New test. Index: gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 (Arbeitskopie) @@ -0,0 +1,66 @@ +! { dg-do run } +! +! From the HPCTools Group of University of Houston +! +! For a coindexed object, its cosubscript list determines the image +! index in the same way that a subscript list determines the subscript +! order value for an array element + +! Run at least with 3 images for the normal checking code +! Modified to also accept a single or two images +program cosubscript_test + implicit none + + integer, parameter :: X = 3, Y = 2 + integer, parameter :: P = 1, Q = -1 + integer :: me + integer :: i,j,k + + integer :: scalar[0:P, -1:Q, *] + + integer :: dim3_max, counter + logical :: is_err + + is_err = .false. + me = this_image() + scalar = me + dim3_max = num_images() / ( (P+1)*(Q+2) ) + + sync all + + if (num_images() == 1) then + k = 1 + j = -1 + i = 0 + if (scalar[i,j,k] /= this_image()) call abort + stop "OK" + else if (num_images() == 2) then + k = 1 + j = -1 + counter = 0 + do i = 0,P + counter = counter+1 + if (counter /= scalar[i,j,k]) call abort() + end do + stop "OK" + end if + + ! ******* SCALAR *********** + counter = 0 + do k = 1, dim3_max + do j = -1,Q + do i = 0,P + counter = counter+1 + if (counter /= scalar[i,j,k]) then + print * , "Error in cosubscript translation scalar" + print * , "[", i,",",j,",",k,"] = ",scalar[i,j,k],"/=",counter + is_err = .true. + end if + end do + end do + end do + + if (is_err) then + call abort() + end if +end program cosubscript_test