From: Andre Vehreschild <vehre@gmx.de>
To: GCC-Patches-ML <gcc-patches@gcc.gnu.org>,
GCC-Fortran-ML <fortran@gcc.gnu.org>
Cc: Damian Rouson <damian@sourceryinstitute.org>,
Brad Richardson <brad@sourceryinstitute.org>
Subject: Re: [Ping^2, Patch, Fortran] PR100337 Should be able to pass non-present optional arguments to CO_BROADCAST
Date: Sat, 19 Jun 2021 13:23:32 +0200 [thread overview]
Message-ID: <20210619132332.302f1062@vepi2> (raw)
In-Reply-To: <20210604180518.5daa870d@vepi2>
[-- Attachment #1: Type: text/plain, Size: 585 bytes --]
PING!
On Fri, 4 Jun 2021 18:05:18 +0200
Andre Vehreschild <vehre@gmx.de> wrote:
> Ping!
>
> On Fri, 21 May 2021 15:33:11 +0200
> Andre Vehreschild <vehre@gmx.de> wrote:
>
> > Hi,
> >
> > the attached patch fixes an issue when calling CO_BROADCAST in
> > -fcoarray=single mode, where the optional but non-present (in the calling
> > 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
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr100337.log --]
[-- Type: text/x-log, Size: 234 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: pr100337.patch --]
[-- Type: text/x-patch, Size: 2587 bytes --]
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 4d7451479d3..03a38090051 100644
--- 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 == GFC_FCOARRAY_SINGLE)
{
if (stat != 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 = fold_build2 (NE_EXPR, logical_type_node,
+ gfc_build_addr_expr (NULL_TREE, stat),
+ null_pointer_node);
+ tmp = 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/testsuite/gfortran.dg/coarray_collectives_17.f90
new file mode 100644
index 00000000000..84a6645865e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_17.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! PR 100337
+! Test case inspired by code submitted by Brad Richardson
+
+program main
+ implicit none
+
+ integer, parameter :: MESSAGE = 42
+ integer :: result
+
+ call myco_broadcast(MESSAGE, result, 1)
+
+ if (result /= 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=*), intent(inout), optional :: errmsg
+
+ integer :: data_length
+
+ data_length = 1
+
+ call co_broadcast(data_length, source_image, stat, errmsg)
+
+ if (present(stat)) then
+ if (stat /= 0) return
+ end if
+
+ if (this_image() == source_image) then
+ r = m
+ end if
+
+ call co_broadcast(r, source_image, stat, errmsg)
+ end subroutine
+
+end program
+
next prev parent reply other threads:[~2021-06-19 11:23 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-05-21 13:33 [Patch, " Andre Vehreschild
2021-06-04 16:05 ` [Ping, Patch, " Andre Vehreschild
2021-06-19 11:23 ` Andre Vehreschild [this message]
2021-06-21 12:30 ` [Ping^2, " Tobias Burnus
2021-06-22 7:40 ` Andre Vehreschild
2021-06-22 8:37 ` Tobias Burnus
2021-06-23 8:23 ` Andre Vehreschild
2021-06-23 9:21 ` Tobias Burnus
2022-02-14 15:50 ` [Backport gcc-11, " Andre Vehreschild
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210619132332.302f1062@vepi2 \
--to=vehre@gmx.de \
--cc=brad@sourceryinstitute.org \
--cc=damian@sourceryinstitute.org \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).