]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Small fixes of coarray routines handling and code gen.
authorAndre Vehreschild <vehre@gcc.gnu.org>
Wed, 18 Jun 2025 07:21:16 +0000 (09:21 +0200)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Thu, 26 Feb 2026 17:18:22 +0000 (09:18 -0800)
gcc/fortran/ChangeLog:

* check.cc (gfc_check_image_status): Fix argument index of team=
argument for correct error message.
* trans-intrinsic.cc (conv_intrinsic_image_status): Team=
argument is optional and is a pointer to the team handle.
* trans-stmt.cc (gfc_trans_sync): Make images argument also a
dereferencable pointer.  But treat errmsg as a pointer to a
char array like in all other functions.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_sync_memory.f90: Adapt grep pattern for
msg being only &msg.

gcc/fortran/check.cc
gcc/fortran/trans-intrinsic.cc
gcc/fortran/trans-stmt.cc
gcc/testsuite/gfortran.dg/coarray_sync_memory.f90

index c1f1c660db0cf429f1da5b27cdd9083ffab659ec..29d9f07b81d8e7ed22366bb8a387624ef7030df4 100644 (file)
@@ -1868,7 +1868,7 @@ gfc_check_image_status (gfc_expr *image, gfc_expr *team)
       || !positive_check (0, image))
     return false;
 
-  return !team || (scalar_check (team, 0) && team_type_check (team, 0));
+  return !team || (scalar_check (team, 1) && team_type_check (team, 1));
 }
 
 
index c4d8d5c9728cced1bbc584949df8dc655c5acf04..cacefa3942b5dfd74a176c66f3814b6dbb4314fa 100644 (file)
@@ -2073,9 +2073,13 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
                                            GFC_STAT_STOPPED_IMAGE));
     }
   else if (flag_coarray == GFC_FCOARRAY_LIB)
+    /* The team is optional and therefore needs to be a pointer to the opaque
+       pointer.  */
     tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
                               args[0],
-                              num_args < 2 ? null_pointer_node : args[1]);
+                              num_args < 2
+                                ? null_pointer_node
+                                : gfc_build_addr_expr (NULL_TREE, args[1]));
   else
     gcc_unreachable ();
 
index 1e1179323c4667c50e84ff81616336fa67e168ed..4d2ca182f808d87401f6b600e6891eb6f0118a66 100644 (file)
@@ -1362,7 +1362,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
     {
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr1);
-      images = argse.expr;
+      images = gfc_trans_force_lval (&argse.pre, argse.expr);
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
 
   if (code->expr2)
@@ -1372,6 +1373,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr2);
       stat = argse.expr;
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
   else
     stat = null_pointer_node;
@@ -1384,8 +1386,9 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
       argse.want_pointer = 1;
       gfc_conv_expr (&argse, code->expr3);
       gfc_conv_string_parameter (&argse);
-      errmsg = gfc_build_addr_expr (NULL, argse.expr);
+      errmsg = argse.expr;
       errmsglen = fold_convert (size_type_node, argse.string_length);
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
   else if (flag_coarray == GFC_FCOARRAY_LIB)
     {
index c4e660b8cf727dc7aae4c40c970cdcc595478129..0030d91257d592fe412e5d0aea721c3e0b7ce7e0 100644 (file)
@@ -14,5 +14,5 @@ end
 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, 0B, 0\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, &&msg, 42\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, &&msg, 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, &msg, 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, &msg, 42\\);" 1 "original" } }