From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.18]) by sourceware.org (Postfix) with ESMTPS id 10D27385BF9D; Sat, 19 Jun 2021 11:23:37 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 10D27385BF9D X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from vepi2 ([79.194.171.234]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MYvcA-1lq7652wAi-00UsxD; Sat, 19 Jun 2021 13:23:33 +0200 Date: Sat, 19 Jun 2021 13:23:32 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Cc: Damian Rouson , Brad Richardson Subject: Re: [Ping^2, Patch, Fortran] PR100337 Should be able to pass non-present optional arguments to CO_BROADCAST Message-ID: <20210619132332.302f1062@vepi2> In-Reply-To: <20210604180518.5daa870d@vepi2> References: <20210521153311.2760b4b3@vepi2> <20210604180518.5daa870d@vepi2> X-Mailer: Claws Mail 3.17.8 (GTK+ 2.24.33; x86_64-redhat-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/7Wrd4Jet9gW/6EhXQjdxvqi" X-Provags-ID: V03:K1:VwmKgMuZEEufb+PKFxrWvQ6v2Z/KvPVeAPGEF/C9OmikXrIlJOk eK3cbG6BMdFflYzeWdc+fRVQ3U0zzQXjbRMdFc0fn3VW0/hGQ7uFuaS+gfk10J2wpMcrgx+ UBmbxgUWcychPoZj+2+/ShiOgkuxCLTlCeLKV57OPklz5nWsVRv5qVoX2wxCr1EGtQZGMvZ 1fedPg2Myr3e1P5Gt/w6A== X-UI-Out-Filterresults: notjunk:1;V03:K0:OMwZHGo1yF4=:URAlpZcgstaz8AwGzPE4/E 2Fj0pMjLl5kCfPDRLWzgxDPNWy3qaPJ0uvbHTsEINWg/n3l6avY+RwcHAzbyzEm0dJ8fkfJaM 4aFoKFr3JqGsJcClCwc1DnFf3FwURnNIYaTFXCjHZBDsvOvxSQtgIzTmrZt+XXVS20tOVoEvd UTkfaZQiJ08hu6DTjVFItybAGkbKlJaBi38Sq3XiXwHZWm4mukasZm/RoAfb7UiC7tS5Avzf2 XRLDJvItTRQ7rquqsKFVuZCH5tWUPIZswHhdGTjL14T55eOAHOJIt6afM0jHlVatc+sg6y21G oDzqMM1LAh9X88KVRlTgaXdiroLM9sULahZupuUU6M8sP4tQk886CtrPQqBZY5DawarP9fBGP 4vs5H5w3ckuvf+LD+drjAmSwUaXJhzFPFCfDZZALertMvbrFteGTJjF+Grha+b2J2T/YC8B19 YKDoGzeYQ1n9fZ4vzYZ9bXOlUbbcRrjFM3MInXSyOexmMwUl6L652h7ZNqWJHE83IS5P7vLfw WJqS+z66S6KNAjO+324PznrEO0gNeP/grTsQLCfLXc400TWwLlTPBpQPmPxtBzmOfz2CDDqG8 senIhLwEDTePwxgE2cSGzbSXzEnUEZ0vpZM3yKfWXMn9CvUOXOE327R2pj6T4NheJaqJpO439 Qs5XuAtmOzOc7nVP9Wtw57W8H79cUisS0j8/Rl6mRi3UlFijUxsNzzEX1iF2D9rE7jqCzgBGE zLTo+8/P+yperU5lwFhvvuWZJM5wgMebi4/+LpNvgPDSaqKbvFVeTb95DVCAr7JQndFr7+tXa qquqBuixgsgCVFkYyGZ82vhG91dB+kbiTOWYXWyFqdJqbuN/oZPI8rlvvo3kp41vvz+XTrZdp qyeptz5Coau8V9qE33cgIPxsF6dIjKTBIb8OG/iINiesSKcuckH75YEIdVUi6fdCAvNmV3n34 zo0rqlhYoAG0RUwq75h6DdlLYAWRvG6xAfSebg11NQKm+q0J1U15aM+xDgnQPrwHRTFJuo0nr j1nlbFG90IQiHZA918SKckMPEWSf0vdETYWgO0y85UynbL/b1cMhOa5bRZeBieA/F06WZ/dgD d/rRxAf5/s2w484lJUoCAxJ+2moEwtZQED9 X-Spam-Status: No, score=-11.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sat, 19 Jun 2021 11:23:40 -0000 --MP_/7Wrd4Jet9gW/6EhXQjdxvqi Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline PING! On Fri, 4 Jun 2021 18:05:18 +0200 Andre Vehreschild wrote: > Ping! > > On Fri, 21 May 2021 15:33:11 +0200 > Andre Vehreschild wrote: > > > Hi, > > > > the attached patch fixes an issue when calling CO_BROADCAST in > > -fcoarray=3Dsingle mode, where the optional but non-present (in the ca= lling > > scope) stat variable was assigned to before checking for it being not > > present. > > > > Regtests fine on x86-64-linux/f33. Ok for trunk? > > > > Regards, > > Andre > > =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/7Wrd4Jet9gW/6EhXQjdxvqi Content-Type: text/x-log Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr100337.log gcc/fortran/ChangeLog: PR fortran/100337 * trans-intrinsic.c (conv_co_collective): Check stat for null ptr before dereferrencing. gcc/testsuite/ChangeLog: PR fortran/100337 * gfortran.dg/coarray_collectives_17.f90: New test. --MP_/7Wrd4Jet9gW/6EhXQjdxvqi Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=pr100337.patch diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 4d7451479d3..03a38090051 100644 =2D-- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -11232,8 +11232,28 @@ conv_co_collective (gfc_code *code) if (flag_coarray =3D=3D GFC_FCOARRAY_SINGLE) { if (stat !=3D NULL_TREE) - gfc_add_modify (&block, stat, - fold_convert (TREE_TYPE (stat), integer_zero_node)); + { + /* For optional stats, check the pointer is valid before zero'ing. */ + if (gfc_expr_attr (stat_expr).optional) + { + tree tmp; + stmtblock_t ass_block; + gfc_start_block (&ass_block); + gfc_add_modify (&ass_block, stat, + fold_convert (TREE_TYPE (stat), + integer_zero_node)); + tmp =3D fold_build2 (NE_EXPR, logical_type_node, + gfc_build_addr_expr (NULL_TREE, stat), + null_pointer_node); + tmp =3D fold_build3 (COND_EXPR, void_type_node, tmp, + gfc_finish_block (&ass_block), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tmp); + } + else + gfc_add_modify (&block, stat, + fold_convert (TREE_TYPE (stat), integer_zero_node)); + } return gfc_finish_block (&block); } diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_17.f90 b/gcc/te= stsuite/gfortran.dg/coarray_collectives_17.f90 new file mode 100644 index 00000000000..84a6645865e =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_collectives_17.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! { dg-options "-fcoarray=3Dsingle" } +! +! PR 100337 +! Test case inspired by code submitted by Brad Richardson + +program main + implicit none + + integer, parameter :: MESSAGE =3D 42 + integer :: result + + call myco_broadcast(MESSAGE, result, 1) + + if (result /=3D MESSAGE) error stop 1 +contains + subroutine myco_broadcast(m, r, source_image, stat, errmsg) + integer, intent(in) :: m + integer, intent(out) :: r + integer, intent(in) :: source_image + integer, intent(out), optional :: stat + character(len=3D*), intent(inout), optional :: errmsg + + integer :: data_length + + data_length =3D 1 + + call co_broadcast(data_length, source_image, stat, errmsg) + + if (present(stat)) then + if (stat /=3D 0) return + end if + + if (this_image() =3D=3D source_image) then + r =3D m + end if + + call co_broadcast(r, source_image, stat, errmsg) + end subroutine + +end program + --MP_/7Wrd4Jet9gW/6EhXQjdxvqi--