public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1741] fortran: Fix deref of optional in gen. code. [PR100337]
@ 2021-06-23 8:17 Andre Vehreschild
0 siblings, 0 replies; only message in thread
From: Andre Vehreschild @ 2021-06-23 8:17 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:da13e4ebebb07a47d5fb50eab8893f8fe38683df
commit r12-1741-gda13e4ebebb07a47d5fb50eab8893f8fe38683df
Author: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed Jun 23 10:09:29 2021 +0200
fortran: Fix deref of optional in gen. code. [PR100337]
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.
Diff:
---
gcc/fortran/trans-intrinsic.c | 24 +++++++++++--
.../gfortran.dg/coarray_collectives_17.f90 | 42 ++++++++++++++++++++++
2 files changed, 64 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e578449995a..46670baae55 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11242,8 +11242,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
+
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-06-23 8:17 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-23 8:17 [gcc r12-1741] fortran: Fix deref of optional in gen. code. [PR100337] Andre Vehreschild
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).