From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id DE7A1385E001; Fri, 4 Jun 2021 16:05:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DE7A1385E001 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from vepi2 ([79.194.169.29]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MTzay-1lxPX32pF4-00Qzz1; Fri, 04 Jun 2021 18:05:19 +0200 Date: Fri, 4 Jun 2021 18:05:18 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Cc: Damian Rouson , Brad Richardson Subject: [Ping, Patch, Fortran] PR100337 Should be able to pass non-present optional arguments to CO_BROADCAST Message-ID: <20210604180518.5daa870d@vepi2> In-Reply-To: <20210521153311.2760b4b3@vepi2> References: <20210521153311.2760b4b3@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_/kt/OMM_.X8b2ruIzEQYY7Qi" X-Provags-ID: V03:K1:PjcGBsfjrtosDL4X3shEW7fy3vgZ9a+3g0OJeW6LYmwr7jQ/J6S bLPn5jKy8H6BvVSQQPpc6EhH/fjhj7u09FLyDTskTzoV1Huj4/e2gtW9ywIXLfH4hWEK99C C9cQF9uKRzSRJQYwTloFGV3riGaMK3OTByOz5zyNIy3/sAvIllbmfVDR3w1VAWE1GssaKRN wMVzBWdj1XcTrvATtAQig== X-UI-Out-Filterresults: notjunk:1;V03:K0:+93N5uocVrA=:d/F3kQU/uwallZFP68yREu bfrZCVesymDUn6NZ6K/Tm6xqTIyjUF7ExnGBvuKyzK9UuTMZt1w837RcJ6EPzSviiJztZx4Ky d3i9mkqF3R1nu1W0MNJNcqUxIEndceKnoj61o226volF3y2Y6uNXxLX5bLr+xOW3eSz3tKoJn +CQuqjH5Cu/BX9iaUaFDFzOZqnycz5D5Ql24KI7JSQXXZGD9UDlbPK0ha9sMXDlxwVZh75sFo 4DczMrTMlQ6hXgyA0Ic09g80HIo+jT54Lct1PVI4xcj3aGU/7e0xRal56ZSYAXh3LBwVTcmaJ xRXRsXAqPDoIWMgZOr+oY4igiqEOEci0Ek5MmYhzA8AAuxagbt/V6ke4WpjhuGa+eiCyD7n6A +WMJ/4FBjUg8w91jcrD2PUwlJkDO0pUwFl9pO8kSD7JvJAo7kQADlYO/qBQxyzDyLWSM4VPbw UM0/D/o397WVUzWwEhq0cUwyPaaEKicI/R0hy0BdUNiT7YoM0ebkNKydCLeGhY3GSDGSx/wg5 qmmPP9x6btqDg8LIhCELA14PdlKgA+x3AkMLLeYkLDQ0blDsGeVGPw/q2Lu3echPEe02s9Qtz WMHmF5Dp29Gik8ISsPH2N3t1PBFa0pzPZTAjBCu3OS+UinlXXUo5zSIS9nmgQ3rNDvHU60Xpm B3KsgFRkIZCHtRPmlvvd/Z9j19aqSqCeRFvwShgJGyTl29aKD8jR70Yi8HJqe32lrRbEIX597 1gzjvjF4SFACj1Z/ResZcVAAQ9ZudMUUYkb0otu5NEeG9KSDw2tu1rsAk+4J3X2BBPbAD9HRp LJbQYR6utzs12V6LjdVM0j3zqrFOd+SWs2RVxEUv+c8UebU++Y7bxl11r3RtJftz0je9tS660 ejsIYD8oXUeN4iEYACC01ngfR0mzxvnyP7LwuPURJu99huXT9SSXwNF4WZDyLKOr6Dak/DKx+ G65EfSRQUHCbihEKVISpsA8ivt9ewjHKTG54V2zySnpfjGyRKf0Cp2oZjxJ1L3un3Wszgp+rQ nBMTQ3I/Zl+DR2AQUv5Mo+hOviafhANxaDHGxcJ7hXXcJTIgiN+kKD92V1ooIG7kRanJ6LFPZ HliC9JtwQlqAaGL5UjQf3DivANYoiAu4t4x X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, 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: Fri, 04 Jun 2021 16:05:33 -0000 --MP_/kt/OMM_.X8b2ruIzEQYY7Qi Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline 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 call= ing > scope) stat variable was assigned to before checking for it being not pr= esent. > > Regtests fine on x86-64-linux/f33. Ok for trunk? > > Regards, > Andre =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/kt/OMM_.X8b2ruIzEQYY7Qi 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_/kt/OMM_.X8b2ruIzEQYY7Qi 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_/kt/OMM_.X8b2ruIzEQYY7Qi--