public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, Fortran] PR100337 Should be able to pass non-present optional arguments to CO_BROADCAST
@ 2021-05-21 13:33 Andre Vehreschild
  2021-06-04 16:05 ` [Ping, Patch, " Andre Vehreschild
  0 siblings, 1 reply; 9+ messages in thread
From: Andre Vehreschild @ 2021-05-21 13:33 UTC (permalink / raw)
  To: GCC-Patches-ML, GCC-Fortran-ML; +Cc: Damian Rouson, Brad Richardson

[-- Attachment #1: Type: text/plain, Size: 350 bytes --]

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
+

^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2022-02-14 15:50 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-21 13:33 [Patch, Fortran] PR100337 Should be able to pass non-present optional arguments to CO_BROADCAST Andre Vehreschild
2021-06-04 16:05 ` [Ping, Patch, " Andre Vehreschild
2021-06-19 11:23   ` [Ping^2, " Andre Vehreschild
2021-06-21 12:30     ` 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

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).