aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@gcc.gnu.org>2025-07-29 10:54:39 -0700
committerJerry DeLisle <jvdelisle@gcc.gnu.org>2025-07-29 10:54:39 -0700
commit75164bb769816261706d317e08a5fee6d8ba49b6 (patch)
treee5a2a192a7c016dabcd6d58c58d8d9c195fae358 /gcc
parent6955bb63595259d94a8c8eaba56650fe7652c3cd (diff)
downloadgcc-75164bb769816261706d317e08a5fee6d8ba49b6.zip
gcc-75164bb769816261706d317e08a5fee6d8ba49b6.tar.gz
gcc-75164bb769816261706d317e08a5fee6d8ba49b6.tar.bz2
Revert "fortran: Testing patches for coarray shared memory."
This reverts commit 6955bb63595259d94a8c8eaba56650fe7652c3cd.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/check.cc11
-rw-r--r--gcc/fortran/coarray.cc26
-rw-r--r--gcc/fortran/invoke.texi54
-rw-r--r--gcc/fortran/trans-decl.cc7
-rw-r--r--gcc/fortran/trans-expr.cc68
-rw-r--r--gcc/fortran/trans-intrinsic.cc6
-rw-r--r--gcc/fortran/trans-stmt.cc7
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f9016
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/atomic_2.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/caf.exp13
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f9094
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f909
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coindexed_1.f9074
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coindexed_3.f084
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90108
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/dummy_3.f901
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/event_1.f9089
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/event_3.f084
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/event_4.f083
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/failed_images_1.f082
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/failed_images_2.f0839
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/image_status_1.f082
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/image_status_2.f0832
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/lock_2.f902
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/poly_run_3.f908
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f082
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f0839
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/sync_1.f908
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/sync_3.f9026
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/sync_team.f9033
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_sync_memory.f904
32 files changed, 191 insertions, 638 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 3446c88..838d523 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1835,7 +1835,7 @@ gfc_check_image_status (gfc_expr *image, gfc_expr *team)
|| !positive_check (0, image))
return false;
- return !team || (scalar_check (team, 1) && team_type_check (team, 1));
+ return !team || (scalar_check (team, 0) && team_type_check (team, 0));
}
@@ -1878,8 +1878,13 @@ gfc_check_f_c_string (gfc_expr *string, gfc_expr *asis)
bool
gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
{
- if (team && (!scalar_check (team, 0) || !team_type_check (team, 0)))
- return false;
+ if (team)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+ gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+ &team->where);
+ return false;
+ }
if (kind)
{
diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index c611b53..ef8fd4e 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -696,23 +696,17 @@ check_add_new_component (gfc_symbol *type, gfc_expr *e, gfc_symbol *add_data)
check_add_new_component (type, actual->expr, add_data);
break;
case EXPR_FUNCTION:
- if ((e->symtree->n.sym->attr.pure
- && e->symtree->n.sym->attr.elemental)
- || (e->value.function.isym && e->value.function.isym->pure
- && e->value.function.isym->elemental))
- {
- /* Only allow pure and elemental function calls in a coarray
- accessor, because all other may have side effects or access
- pointers, which may not be possible in the accessor running on
- another host. */
- for (gfc_actual_arglist *actual = e->value.function.actual;
- actual; actual = actual->next)
- check_add_new_component (type, actual->expr, add_data);
- }
- else
- /* Extract the expression, evaluate it and add a temporary with its
- value to the helper structure. */
+ if (!e->symtree->n.sym->attr.pure
+ && !e->symtree->n.sym->attr.elemental
+ && !(e->value.function.isym
+ && (e->value.function.isym->pure
+ || e->value.function.isym->elemental)))
+ /* Treat non-pure/non-elemental functions. */
check_add_new_comp_handle_array (e, type, add_data);
+ else
+ for (gfc_actual_arglist *actual = e->value.function.actual; actual;
+ actual = actual->next)
+ check_add_new_component (type, actual->expr, add_data);
break;
case EXPR_VARIABLE:
check_add_new_comp_handle_array (e, type, add_data);
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 77926fa..0b893e8 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -104,7 +104,6 @@ one is not the default.
* Interoperability Options:: Options for interoperability with other
languages.
* Environment Variables:: Environment variables that affect @command{gfortran}.
-* Shared Memory Coarrays:: Multi process shared memory coarray support.
@end menu
@node Option Summary
@@ -2281,56 +2280,3 @@ variables.
@xref{Runtime}, for environment variables that affect the
run-time behavior of programs compiled with GNU Fortran.
@c man end
-
-@node Shared Memory Coarrays
-@section Shared Memory Coarrays
-
-@c man begin SHARED MEMORY COARRAYS
-
-@command{gfortran} supplies a runtime library for running coarray enabled
-programs using a shared memory multi process approach. The library is supplied
-as a static link library with the @command{libgfortran} library and is fully
-compatible with the ABI enabled when @command{gfortran} is called with
-@code{-fcoarray=lib}. The shared memory coarray library then just needs to be
-linked to the executable produced by @command{gfortran} using
-@code{-lcaf_shmem}.
-
-The library @code{caf_shmem} can only be used on architectures that allow
-multiple processes to use the same memory at the same virtual memory address in
-each process' memory space. This is the case on most Unix and Windows based
-systems.
-
-The resulting executable can be started without any driver and does not provide
-any additional command line options. Limited control is possible by
-environment variables:
-
-@env{GFORTRAN_NUM_IMAGES}: The number of images to spawn when running the
-executable. Note, there will always be one additional supervisor process, which
-does not participate in the computation, but is only responsible for starting
-the images and catching any (ab-)normal termination. When the environment
-variable is not set, then the number of hardware threads reported by the OS will
-be taken. Over-provisioning is possible. The number of images is limited only
-by the OS and the size of an integer variable on the architecture the program is
-to be run on.
-
-@env{GFORTRAN_SHARED_MEMORY_SIZE}: The size of the shared memory segment made
-available to all images is fixed and needs to be set at program start. It can
-not grow or shrink. The size can be given in bytes (no suffix), kilobytes
-(@code{k} or @code{K} suffix), megabytes (@code{m} or @code{M}) or gigabytes
-(@code{g} or @code{G}). If the variable is not set, or not parseable, then on
-32-bit architectures 2^28 bytes and on 64-bit 2^34 bytes are choosen. Note,
-although the size is set, most modern systems do not allocate the memory at
-program start. This allows to choose a shared memory size larger than available
-memory.
-
-Warning: Choosing a large shared memory size may produce large coredumps!
-
-The shared memory coarray library internally uses some additional environment
-variables, which will be overwritten without notice or may result in failure to
-start. These are: @code{GFORTRAN_IMAGE_NUM}, @code{GFORTRAN_SHMEM_PID} and
-@code{GFORTRAN_SHMEM_BASE}. It is strongly discouraged to use these variables.
-Special care needs to be taken, when one coarray program starts another coarray
-program as a child process. In this case it is the spawning process'
-responsibility to remove above variables from the environment.
-
-@c man end
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ba4a842..43bd7be 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4223,9 +4223,10 @@ gfc_build_builtin_function_decls (void)
get_identifier (PREFIX ("caf_sync_team")), ". r w w w ", void_type_node,
4, pvoid_type_node, pint_type, pchar_type_node, size_type_node);
- gfor_fndecl_caf_team_number = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX ("caf_team_number")), ". r ", integer_type_node,
- 1, pvoid_type_node);
+ gfor_fndecl_caf_team_number
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_team_number")), ". r ",
+ integer_type_node, 1, integer_type_node);
gfor_fndecl_caf_image_status = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX ("caf_image_status")), ". r r ",
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d97d135..082987f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -90,8 +90,6 @@ static tree
get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
{
enum gfc_array_kind akind;
- tree *lbound = NULL, *ubound = NULL;
- int codim = 0;
if (attr.pointer)
akind = GFC_ARRAY_POINTER_CONT;
@@ -102,16 +100,8 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
if (POINTER_TYPE_P (TREE_TYPE (scalar)))
scalar = TREE_TYPE (scalar);
- if (TYPE_LANG_SPECIFIC (TREE_TYPE (scalar)))
- {
- struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (TREE_TYPE (scalar));
- codim = lang_specific->corank;
- lbound = lang_specific->lbound;
- ubound = lang_specific->ubound;
- }
- return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, codim, lbound,
- ubound, 1, akind,
- !(attr.pointer || attr.target));
+ return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
+ akind, !(attr.pointer || attr.target));
}
tree
@@ -770,43 +760,11 @@ gfc_get_vptr_from_expr (tree expr)
return NULL_TREE;
}
-static void
-copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src)
-{
- tree src_type = TREE_TYPE (src);
- if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank)
- {
- struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type);
- for (int c = 0; c < lang_specific->corank; ++c)
- {
- int dim = lang_specific->rank + c;
- tree codim = gfc_rank_cst[dim];
-
- if (lang_specific->lbound[dim])
- gfc_conv_descriptor_lbound_set (block, dest, codim,
- lang_specific->lbound[dim]);
- else
- gfc_conv_descriptor_lbound_set (
- block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim));
- if (dim + 1 < lang_specific->corank)
- {
- if (lang_specific->ubound[dim])
- gfc_conv_descriptor_ubound_set (block, dest, codim,
- lang_specific->ubound[dim]);
- else
- gfc_conv_descriptor_ubound_set (
- block, dest, codim,
- gfc_conv_descriptor_ubound_get (src, codim));
- }
- }
- }
-}
-
void
gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
bool lhs_type)
{
- tree lhs_dim, rhs_dim, type;
+ tree tmp, tmp2, type;
gfc_conv_descriptor_data_set (block, lhs_desc,
gfc_conv_descriptor_data_get (rhs_desc));
@@ -817,18 +775,15 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
gfc_conv_descriptor_dtype (rhs_desc));
/* Assign the dimension as range-ref. */
- lhs_dim = gfc_get_descriptor_dimension (lhs_desc);
- rhs_dim = gfc_get_descriptor_dimension (rhs_desc);
-
- type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim);
- lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim,
- gfc_index_zero_node, NULL_TREE, NULL_TREE);
- rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim,
- gfc_index_zero_node, NULL_TREE, NULL_TREE);
- gfc_add_modify (block, lhs_dim, rhs_dim);
+ tmp = gfc_get_descriptor_dimension (lhs_desc);
+ tmp2 = gfc_get_descriptor_dimension (rhs_desc);
- /* The corank dimensions are not copied by the ARRAY_RANGE_REF. */
- copy_coarray_desc_part (block, lhs_desc, rhs_desc);
+ type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2);
+ tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
+ gfc_index_zero_node, NULL_TREE, NULL_TREE);
+ tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,
+ gfc_index_zero_node, NULL_TREE, NULL_TREE);
+ gfc_add_modify (block, tmp, tmp2);
}
/* Takes a derived type expression and returns the address of a temporary
@@ -944,7 +899,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
gfc_expr_attr (e));
gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
gfc_get_dtype (type));
- copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
if (optional)
parmse->expr = build3_loc (input_location, COND_EXPR,
TREE_TYPE (parmse->expr),
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 7cd95da..be98427 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2073,13 +2073,9 @@ 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
- : gfc_build_addr_expr (NULL_TREE, args[1]));
+ num_args < 2 ? null_pointer_node : args[1]);
else
gcc_unreachable ();
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index eadd40c..f105401 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1362,8 +1362,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
{
gfc_init_se (&argse, NULL);
gfc_conv_expr_val (&argse, code->expr1);
- images = gfc_trans_force_lval (&argse.pre, argse.expr);
- gfc_add_block_to_block (&se.pre, &argse.pre);
+ images = argse.expr;
}
if (code->expr2)
@@ -1373,7 +1372,6 @@ 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;
@@ -1386,9 +1384,8 @@ 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 = argse.expr;
+ errmsg = gfc_build_addr_expr (NULL, 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)
{
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
index 50b4bab..2ee8ff0 100644
--- a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
@@ -11,19 +11,11 @@ program main
end type
type(mytype), save :: object[*]
- integer :: me, other
+ integer :: me
me=this_image()
- other = me + 1
- if (other .GT. num_images()) other = 1
- if (me == num_images()) then
- allocate(object%indices(me/2))
- else
- allocate(object%indices(me))
- end if
- object%indices = 42 * me
+ allocate(object%indices(me))
+ object%indices = 42
- sync all
- if ( any( object[other]%indices(:) /= 42 * other ) ) STOP 1
- sync all
+ if ( any( object[me]%indices(:) /= 42 ) ) STOP 1
end program
diff --git a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90 b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
index 7eccd7b..5e1c496 100644
--- a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
@@ -61,7 +61,7 @@ end do
sync all
call atomic_ref(var, caf[num_images()], stat=stat)
-if (stat /= 0 .or. var /= num_images() * 2) STOP 12
+if (stat /= 0 .or. var /= num_images() + this_image()) STOP 12
do i = 1, num_images()
call atomic_ref(var, caf[i], stat=stat)
if (stat /= 0 .or. var /= num_images() + i) STOP 13
@@ -328,7 +328,7 @@ end do
sync all
call atomic_ref(var, caf[num_images()], stat=stat)
-if (stat /= 0 .or. var /= num_images() * 2) STOP 45
+if (stat /= 0 .or. var /= num_images() + this_image()) STOP 45
do i = 1, num_images()
call atomic_ref(var, caf[i], stat=stat)
if (stat /= 0 .or. var /= num_images() + i) STOP 46
@@ -403,7 +403,7 @@ if (this_image() < storage_size(caf)-2) then
do i = this_image(), min(num_images(), storage_size(caf)-2)
var = -99
call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)
- if (stat /= 0) STOP 53
+ if (stat /= 0 .or. var <= 0) STOP 53
end do
end if
sync all
@@ -544,7 +544,7 @@ if (this_image() < storage_size(caf)-2) then
do i = this_image(), min(num_images(), storage_size(caf)-2)
var = -99
call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)
- if (stat /= 0) STOP 68
+ if (stat /= 0 .or. (var < 0 .and. var /= -1)) STOP 68
end do
end if
sync all
@@ -628,27 +628,26 @@ sync all
if (this_image() == 1) then
call atomic_cas(caf_log[num_images()], compare=.false., new=.false., old=var2, stat=stat)
- if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 82
+ if (stat /= 0 .or. var2 .neqv. .true.) STOP 82
call atomic_ref(var2, caf_log[num_images()], stat=stat)
- if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 83
+ if (stat /= 0 .or. var2 .neqv. .true.) STOP 83
end if
sync all
-if (this_image() == num_images() .and. (caf_log .neqv. .true.)) STOP 84
+if (this_image() == num_images() .and. caf_log .neqv. .true.) STOP 84
call atomic_ref(var2, caf_log[num_images()], stat=stat)
-if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 85
+if (stat /= 0 .or. var2 .neqv. .true.) STOP 85
sync all
if (this_image() == 1) then
call atomic_cas(caf_log[num_images()], compare=.true., new=.false., old=var2, stat=stat)
- if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 86
+ if (stat /= 0 .or. var2 .neqv. .true.) STOP 86
call atomic_ref(var2, caf_log[num_images()], stat=stat)
- if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 87
+ if (stat /= 0 .or. var2 .neqv. .false.) STOP 87
end if
sync all
-if (this_image() == num_images() .and. (caf_log .neqv. .false.)) STOP 88
+if (this_image() == num_images() .and. caf_log .neqv. .false.) STOP 88
call atomic_ref(var2, caf_log[num_images()], stat=stat)
-if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 89
-sync all
+if (stat /= 0 .or. var2 .neqv. .false.) STOP 89
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/caf.exp b/gcc/testsuite/gfortran.dg/coarray/caf.exp
index 1f002e0..c1e8e8c 100644
--- a/gcc/testsuite/gfortran.dg/coarray/caf.exp
+++ b/gcc/testsuite/gfortran.dg/coarray/caf.exp
@@ -70,12 +70,6 @@ proc dg-compile-aux-modules { args } {
}
}
-if { [getenv GFORTRAN_NUM_IMAGES] == "" } {
- # Some caf_shmem tests need at least 8 images. This is also to limit the
- # number of images on big machines preventing overload w/o any benefit.
- setenv GFORTRAN_NUM_IMAGES 8
-}
-
# Main loop.
foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] {
# If we're only testing specific files and this isn't one of them, skip it.
@@ -109,13 +103,6 @@ foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]]
dg-test $test "-fcoarray=lib $flags -lcaf_single" {}
cleanup-modules ""
}
-
- foreach flags $option_list {
- verbose "Testing $nshort (libcaf_shmem), $flags" 1
- set gfortran_aux_module_flags "-fcoarray=lib $flags -lcaf_shmem"
- dg-test $test "-fcoarray=lib $flags -lcaf_shmem" {}
- cleanup-modules ""
- }
}
torture-finish
dg-finish
diff --git a/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90 b/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90
deleted file mode 100644
index 9b4c44f..0000000
--- a/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90
+++ /dev/null
@@ -1,94 +0,0 @@
-!{ dg-do run }
-
-! Check that co_reduce for strings works.
-! This test is motivated by OpenCoarray's co_reduce_string test.
-
-program co_reduce_strings
-
- implicit none
-
- integer, parameter :: numstrings = 10, strlen = 8, base_len = 4
- character(len=strlen), dimension(numstrings) :: fixarr
- character(len=strlen), dimension(:), allocatable :: allocarr
- character(len=:), allocatable :: defarr(:)
- character(len=strlen) :: expect
- integer :: i
-
- ! Construct the strings by postfixing foo by a number.
- associate (me => this_image(), np => num_images())
- if (np > 999) error stop "Too many images; increase format string modifiers and sizes!"
-
- allocate(allocarr(numstrings))
- do i = 1, numstrings
- write(fixarr(i), "('foo',I04)") i * me
- write(allocarr(i), "('foo',I04)") i * me
- end do
- ! Collectively reduce the maximum string.
- call co_reduce(fixarr, fixmax)
- call check(fixarr, 1)
-
- call co_reduce(allocarr, strmax)
- call check(allocarr, 2)
- end associate
-
- ! Construct the strings by postfixing foo by a number.
- associate (me => this_image(), np => num_images())
- allocate(character(len=base_len + 4)::defarr(numstrings))
- do i = 1, numstrings
- write(defarr(i), "('foo',I04)") i * me
- end do
- call sub_red(defarr)
- end associate
- sync all
-
-contains
-
- pure function fixmax(lhs, rhs) result(m)
- character(len=strlen), intent(in) :: lhs, rhs
- character(len=strlen) :: m
-
- if (lhs > rhs) then
- m = lhs
- else
- m = rhs
- end if
- end function
-
- pure function strmax(lhs, rhs) result(maxstr)
- character(len=strlen), intent(in) :: lhs, rhs
- character(len=strlen) :: maxstr
-
- if (lhs > rhs) then
- maxstr = lhs
- else
- maxstr = rhs
- end if
- end function
-
- subroutine sub_red(str)
- character(len=:), allocatable :: str(:)
-
- call co_reduce(str, strmax)
- call check(str, 3)
- end subroutine
-
- subroutine check(curr, stop_code)
- character(len=*), intent(in) :: curr(:)
- character(len=strlen) :: expect
- integer, intent(in) :: stop_code
- integer :: i
-
- associate(np => num_images())
- do i = 1, numstrings
- write (expect, "('foo',I04)") i * np
- if (curr(i) /= expect) then
- ! On error print what we got and what we expected.
- print *, this_image(), ": Got: ", curr(i), ", expected: ", expect, ", for i=", i
- stop stop_code
- end if
- end do
- end associate
- end subroutine
-
-end program co_reduce_strings
-
diff --git a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
index ce7c628..27db0e8 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
@@ -19,7 +19,7 @@ program p
! For this reason, -fcoarray=single and -fcoarray=lib give the
! same result
if (allocated (a[1])) stop 3
- if (allocated (c%x[1,1,1])) stop 4
+ if (allocated (c%x[1,2,3])) stop 4
! Allocate collectively
allocate(a[*])
@@ -28,17 +28,16 @@ program p
if (.not. allocated (a)) stop 5
if (.not. allocated (c%x)) stop 6
if (.not. allocated (a[1])) stop 7
- if (.not. allocated (c%x[1,1,1])) stop 8
+ if (.not. allocated (c%x[1,2,3])) stop 8
- sync all
- ! Dellocate collectively
+ ! Deallocate collectively
deallocate(a)
deallocate(c%x)
if (allocated (a)) stop 9
if (allocated (c%x)) stop 10
if (allocated (a[1])) stop 11
- if (allocated (c%x[1,1,1])) stop 12
+ if (allocated (c%x[1,2,3])) stop 12
end
! Expected: always local access and never a call to _gfortran_caf_get
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
index 8f7a83a..f90b65c 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
@@ -21,7 +21,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 1_"abc"
str2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
str2a[1] = str1a
end if
@@ -38,7 +37,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
ustr2a = 4_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a[1] = ustr1a
end if
@@ -55,7 +53,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 1_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a[1] = str2a
end if
@@ -72,7 +69,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
ustr1a = 4_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a[1] = ustr2a
end if
@@ -95,7 +91,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = str1b
end if
@@ -118,7 +113,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = ustr1b
end if
@@ -141,7 +135,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = str2b
end if
@@ -164,7 +157,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = ustr2b
end if
@@ -187,7 +179,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = str1a
end if
@@ -208,7 +199,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = ustr1a
end if
@@ -229,7 +219,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = str2a
end if
@@ -250,7 +239,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = ustr2a
end if
@@ -273,7 +261,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 1_"abc"
str2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
str2a = str1a[1]
end if
@@ -290,7 +277,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
ustr2a = 4_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a = ustr1a[1]
end if
@@ -307,7 +293,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 1_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a = str2a[1]
end if
@@ -324,7 +309,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
ustr1a = 4_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a = ustr2a[1]
end if
@@ -347,7 +331,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b = str1b(:)[1]
end if
@@ -370,7 +353,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b = ustr1b(:)[1]
end if
@@ -393,7 +375,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b = str2b(:)[1]
end if
@@ -416,7 +397,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b = ustr2b(:)[1]
end if
@@ -439,7 +419,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b = str1a[1]
end if
@@ -460,7 +439,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b = ustr1a[1]
end if
@@ -481,7 +459,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b = str2a[1]
end if
@@ -502,7 +479,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b = ustr2a[1]
end if
@@ -526,7 +502,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 1_"abc"
str2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
str2a[1] = str1a[mod(1, num_images())+1]
end if
@@ -543,7 +518,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
ustr2a = 4_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a[1] = ustr1a[mod(1, num_images())+1]
end if
@@ -560,7 +534,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 1_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a[1] = str2a[mod(1, num_images())+1]
end if
@@ -577,7 +550,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
ustr1a = 4_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a[1] = ustr2a[mod(1, num_images())+1]
end if
@@ -600,7 +572,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = str1b(:)[mod(1, num_images())+1]
end if
@@ -623,7 +594,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
end if
@@ -646,7 +616,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = str2b(:)[mod(1, num_images())+1]
end if
@@ -669,7 +638,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
end if
@@ -692,7 +660,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = str1a[mod(1, num_images())+1]
end if
@@ -713,7 +680,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = ustr1a[mod(1, num_images())+1]
end if
@@ -734,7 +700,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = str2a[mod(1, num_images())+1]
end if
@@ -755,7 +720,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = ustr2a[mod(1, num_images())+1]
end if
@@ -779,8 +743,7 @@ subroutine char_test()
str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
- str2a = 1_"XXXXXXX"
- sync all
+ str1a = 1_"XXXXXXX"
if (this_image() == num_images()) then
str2a[1] = ustr1a
end if
@@ -797,7 +760,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 4_"abc"
ustr2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a[1] = str1a
end if
@@ -814,7 +776,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a[1] = ustr2a
end if
@@ -831,7 +792,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 4_"abcde"
ustr1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a[1] = str2a
end if
@@ -854,7 +814,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = ustr1b
end if
@@ -877,7 +836,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = str1b
end if
@@ -900,7 +858,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = ustr2b
end if
@@ -923,7 +880,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = str2b
end if
@@ -946,7 +902,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = ustr1a
end if
@@ -967,7 +922,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = str1a
end if
@@ -988,7 +942,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = ustr2a
end if
@@ -1009,7 +962,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = str2a
end if
@@ -1032,7 +984,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
str2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
str2a = ustr1a[1]
end if
@@ -1049,7 +1000,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 1_"abc"
ustr2a = 4_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a = str1a[1]
end if
@@ -1066,7 +1016,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a = ustr2a[1]
end if
@@ -1083,7 +1032,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 1_"abcde"
ustr1a = 4_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a = str2a[1]
end if
@@ -1106,7 +1054,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b = ustr1b(:)[1]
end if
@@ -1129,7 +1076,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b = str1b(:)[1]
end if
@@ -1152,7 +1098,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b = ustr2b(:)[1]
end if
@@ -1175,7 +1120,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b = str2b(:)[1]
end if
@@ -1198,7 +1142,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b = ustr1a[1]
end if
@@ -1219,7 +1162,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b = str1a[1]
end if
@@ -1240,7 +1182,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b = ustr2a[1]
end if
@@ -1261,7 +1202,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b = str2a[1]
end if
@@ -1285,7 +1225,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr1a = 4_"abc"
str2a = 1_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
str2a[1] = ustr1a[mod(1, num_images())+1]
end if
@@ -1302,7 +1241,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str1a = 1_"abc"
ustr2a = 4_"XXXXXXX"
- sync all
if (this_image() == num_images()) then
ustr2a[1] = str1a[mod(1, num_images())+1]
end if
@@ -1319,7 +1257,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
ustr2a = 4_"abcde"
str1a = 1_"XXX"
- sync all
if (this_image() == num_images()) then
str1a[1] = ustr2a[mod(1, num_images())+1]
end if
@@ -1336,7 +1273,6 @@ subroutine char_test()
ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
str2a = 1_"abcde"
ustr1a = 4_"XXX"
- sync all
if (this_image() == num_images()) then
ustr1a[1] = str2a[mod(1, num_images())+1]
end if
@@ -1359,7 +1295,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
end if
@@ -1382,7 +1317,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = str1b(:)[mod(1, num_images())+1]
end if
@@ -1405,7 +1339,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
end if
@@ -1428,7 +1361,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = str2b(:)[mod(1, num_images())+1]
end if
@@ -1451,7 +1383,6 @@ subroutine char_test()
str2b(1) = 1_"XXXXXXX"
str2b(2) = 1_"YYYYYYY"
str2b(3) = 1_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
str2b(:)[1] = ustr1a[mod(1, num_images())+1]
end if
@@ -1472,7 +1403,6 @@ subroutine char_test()
ustr2b(1) = 4_"XXXXXXX"
ustr2b(2) = 4_"YYYYYYY"
ustr2b(3) = 4_"ZZZZZZZ"
- sync all
if (this_image() == num_images()) then
ustr2b(:)[1] = str1a[mod(1, num_images())+1]
end if
@@ -1493,7 +1423,6 @@ subroutine char_test()
str1b(1) = 1_"XXX"
str1b(2) = 1_"YYY"
str1b(3) = 1_"ZZZ"
- sync all
if (this_image() == num_images()) then
str1b(:)[1] = ustr2a[mod(1, num_images())+1]
end if
@@ -1514,7 +1443,6 @@ subroutine char_test()
ustr1b(1) = 4_"XXX"
ustr1b(2) = 4_"YYY"
ustr1b(3) = 4_"ZZZ"
- sync all
if (this_image() == num_images()) then
ustr1b(:)[1] = str2a[mod(1, num_images())+1]
end if
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
index 145835d..7fd2085 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
@@ -15,8 +15,8 @@ program pr98903
a = 42
s = 42
- sync all
-
+ ! Checking against single image only. Therefore team statements are
+ ! not viable nor are they (yet) supported by GFortran.
if (a[1, team_number=-1, stat=s] /= 42) stop 1
if (s /= 0) stop 2
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
index 8eb6466..c35ec10 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
@@ -13,72 +13,68 @@ program coindexed_5
parentteam = get_team()
caf = [23, 32]
- form team(t_num, team) !, new_index=num_images() - this_image() + 1)
+ form team(t_num, team, new_index=1)
form team(t_num, formed_team)
change team(team, cell[*] => caf(2))
- associate(me => this_image())
- ! for get_from_remote
- ! Checking against caf_single is very limitted.
- if (cell[me, team_number=t_num] /= 32) stop 1
- if (cell[me, team_number=st_num] /= 32) stop 2
- if (cell[me, team=parentteam] /= 32) stop 3
+ ! for get_from_remote
+ ! Checking against caf_single is very limitted.
+ if (cell[1, team_number=t_num] /= 32) stop 1
+ if (cell[1, team_number=st_num] /= 32) stop 2
+ if (cell[1, team=parentteam] /= 32) stop 3
- ! Check that team_number is validated
- lhs = cell[me, team_number=5, stat=stat]
- if (stat /= 1) stop 4
+ ! Check that team_number is validated
+ lhs = cell[1, team_number=5, stat=stat]
+ if (stat /= 1) stop 4
- ! Check that only access to active teams is valid
- stat = 42
- lhs = cell[me, team=formed_team, stat=stat]
- if (stat /= 1) stop 5
+ ! Check that only access to active teams is valid
+ stat = 42
+ lhs = cell[1, team=formed_team, stat=stat]
+ if (stat /= 1) stop 5
- ! for send_to_remote
- ! Checking against caf_single is very limitted.
- cell[me, team_number=t_num] = 45
- if (cell /= 45) stop 11
- cell[me, team_number=st_num] = 46
- if (cell /= 46) stop 12
- cell[me, team=parentteam] = 47
- if (cell /= 47) stop 13
+ ! for send_to_remote
+ ! Checking against caf_single is very limitted.
+ cell[1, team_number=t_num] = 45
+ if (cell /= 45) stop 11
+ cell[1, team_number=st_num] = 46
+ if (cell /= 46) stop 12
+ cell[1, team=parentteam] = 47
+ if (cell /= 47) stop 13
- ! Check that team_number is validated
- stat = -1
- cell[me, team_number=5, stat=stat] = 0
- if (stat /= 1) stop 14
+ ! Check that team_number is validated
+ stat = -1
+ cell[1, team_number=5, stat=stat] = 0
+ if (stat /= 1) stop 14
- ! Check that only access to active teams is valid
- stat = 42
- cell[me, team=formed_team, stat=stat] = -1
- if (stat /= 1) stop 15
+ ! Check that only access to active teams is valid
+ stat = 42
+ cell[1, team=formed_team, stat=stat] = -1
+ if (stat /= 1) stop 15
- ! for transfer_between_remotes
- ! Checking against caf_single is very limitted.
- cell[me, team_number=t_num] = caf(1)[me, team_number=-1]
- if (cell /= 23) stop 21
- cell[me, team_number=st_num] = caf(2)[me, team_number=-1]
- ! cell is an alias for caf(2) and has been overwritten by caf(1)!
- if (cell /= 23) stop 22
- cell[me, team=parentteam] = caf(1)[me, team= team]
- if (cell /= 23) stop 23
+ ! for transfer_between_remotes
+ ! Checking against caf_single is very limitted.
+ cell[1, team_number=t_num] = caf(1)[1, team_number=-1]
+ if (cell /= 23) stop 21
+ cell[1, team_number=st_num] = caf(2)[1, team_number=-1]
+ ! cell is an alias for caf(2) and has been overwritten by caf(1)!
+ if (cell /= 23) stop 22
+ cell[1, team=parentteam] = caf(1)[1, team= team]
+ if (cell /= 23) stop 23
- ! Check that team_number is validated
- stat = -1
- cell[me, team_number=5, stat=stat] = caf(1)[me, team_number= -1]
- if (stat /= 1) stop 24
- stat = -1
- cell[me, team_number=t_num] = caf(1)[me, team_number= -2, stat=stat]
- if (stat /= 1) stop 25
+ ! Check that team_number is validated
+ stat = -1
+ cell[1, team_number=5, stat=stat] = caf(1)[1, team_number= -1]
+ if (stat /= 1) stop 24
+ stat = -1
+ cell[1, team_number=t_num] = caf(1)[1, team_number= -2, stat=stat]
+ if (stat /= 1) stop 25
- ! Check that only access to active teams is valid
- stat = 42
- cell[me, team=formed_team, stat=stat] = caf(1)[me]
- if (stat /= 1) stop 26
- stat = 42
- cell[me] = caf(1)[me, team=formed_team, stat=stat]
- if (stat /= 1) stop 27
-
- sync all
- end associate
+ ! Check that only access to active teams is valid
+ stat = 42
+ cell[1, team=formed_team, stat=stat] = caf(1)[1]
+ if (stat /= 1) stop 26
+ stat = 42
+ cell[1] = caf(1)[1, team=formed_team, stat=stat]
+ if (stat /= 1) stop 27
end team
end program coindexed_5
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
index c569390..4b45daa 100644
--- a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
@@ -15,7 +15,6 @@ program pr77871
p%i = 42
allocate (p2(5)[*])
p2(:)%i = (/(i, i=0, 4)/)
- sync all
call s(p, 1)
call s2(p2, 1)
contains
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_1.f90 b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
index a9fecf9..81dc90b 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
@@ -5,54 +5,47 @@
use iso_fortran_env, only: event_type
implicit none
-type(event_type), save, allocatable, dimension(:) :: events[:]
+type(event_type), save :: var[*]
integer :: count, stat
-associate (me => this_image(), np => num_images())
- allocate(events(np)[*])
-
- associate(var => events(me))
- count = -42
- call event_query (var, count)
- if (count /= 0) STOP 1
-
- stat = 99
- event post (var, stat=stat)
- if (stat /= 0) STOP 2
- call event_query(var, count, stat=stat)
- if (count /= 1 .or. stat /= 0) STOP 3
-
- count = 99
- event post (var[this_image()])
- call event_query(var, count)
- if (count /= 2) STOP 4
-
- count = 99
- event wait (var)
- call event_query(var, count)
- if (count /= 1) STOP 5
-
- count = 99
- event post (var)
- call event_query(var, count)
- if (count /= 2) STOP 6
-
- count = 99
- event post (var)
- call event_query(var, count)
- if (count /= 3) STOP 7
-
- count = 99
- event wait (var, until_count=2)
- call event_query(var, count)
- if (count /= 1) STOP 8
-
- stat = 99
- event wait (var, stat=stat, until_count=1)
- if (stat /= 0) STOP 9
- count = 99
- call event_query(event=var, stat=stat, count=count)
- if (count /= 0 .or. stat /= 0) STOP 10
- end associate
-end associate
+count = -42
+call event_query (var, count)
+if (count /= 0) STOP 1
+
+stat = 99
+event post (var, stat=stat)
+if (stat /= 0) STOP 2
+call event_query(var, count, stat=stat)
+if (count /= 1 .or. stat /= 0) STOP 3
+
+stat = 99
+event post (var[this_image()])
+call event_query(var, count)
+if (count /= 2) STOP 4
+
+stat = 99
+event wait (var)
+call event_query(var, count)
+if (count /= 1) STOP 5
+
+stat = 99
+event post (var)
+call event_query(var, count)
+if (count /= 2) STOP 6
+
+stat = 99
+event post (var)
+call event_query(var, count)
+if (count /= 3) STOP 7
+
+stat = 99
+event wait (var, until_count=2)
+call event_query(var, count)
+if (count /= 1) STOP 8
+
+stat = 99
+event wait (var, stat=stat, until_count=1)
+if (stat /= 0) STOP 9
+call event_query(event=var, stat=stat, count=count)
+if (count /= 0 .or. stat /= 0) STOP 10
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_3.f08 b/gcc/testsuite/gfortran.dg/coarray/event_3.f08
index cedf636..60d3193 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/event_3.f08
@@ -11,8 +11,8 @@ program global_event
contains
subroutine exchange
integer :: cnt
- event post(x[this_image()])
- event post(x[this_image()])
+ event post(x[1])
+ event post(x[1])
call event_query(x, cnt)
if (cnt /= 2) error stop 1
event wait(x, until_count=2)
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_4.f08 b/gcc/testsuite/gfortran.dg/coarray/event_4.f08
index 26a1f59..de901c0 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_4.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/event_4.f08
@@ -8,6 +8,5 @@ program event_4
type(event_type) done[*]
nc(1) = 1
event post(done[1])
- if (this_image() == 1) event wait(done,until_count=nc(1))
- sync all
+ event wait(done,until_count=nc(1))
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
index 34ae131..4898dd8 100644
--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
@@ -8,7 +8,7 @@ program test_failed_images_1
integer :: i
fi = failed_images() ! OK
- fi = failed_images(TEAM=1) ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
+ fi = failed_images(TEAM=1) ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) not yet supported" }
fi = failed_images(KIND=1) ! OK
fi = failed_images(KIND=4) ! OK
fi = failed_images(KIND=0) ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be positive" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
index 78d92da..ca5fe40 100644
--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
@@ -1,44 +1,17 @@
! { dg-do run }
program test_failed_images_2
- use iso_fortran_env
implicit none
- type(team_type) :: t
integer, allocatable :: fi(:)
integer(kind=1), allocatable :: sfi(:)
- integer, allocatable :: rem_images(:)
- integer :: i, st
- associate(np => num_images())
- form team (1, t)
- fi = failed_images()
- if (size(fi) > 0) stop 1
- sfi = failed_images(KIND=1)
- if (size(sfi) > 0) stop 2
- sfi = failed_images(KIND=8)
- if (size(sfi) > 0) stop 3
-
- fi = failed_images(t)
- if (size(fi) > 0) stop 4
+ fi = failed_images()
+ if (size(fi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=1)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+ sfi = failed_images(KIND=8)
+ if (size(sfi) > 0) error stop "failed_images result shall be empty array"
- if (num_images() > 1) then
- sync all
- if (this_image() == 2) fail image
- rem_images = (/ 1, ( i, i = 3, np )/)
- ! Can't synchronize well on a failed image. Try with a sleep.
- do i = 0, 10
- if (size(failed_images()) == 0) then
- call sleep(1)
- else
- exit
- end if
- end do
- if (i == 10 .AND. size(failed_images()) == 0) stop 5
- sync images (rem_images, stat=st)
- if (any(failed_images() /= [2])) stop 6
- if (any(failed_images(t, 8) /= [2])) stop 7
- end if
- end associate
end program test_failed_images_2
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
index f725f81..b7ec5a6 100644
--- a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
@@ -18,7 +18,7 @@ program test_image_status_1
isv = image_status(k2) ! Ok
isv = image_status(k4) ! Ok
isv = image_status(k8) ! Ok
- isv = image_status(1, team=1) ! { dg-error "'team' argument of 'image_status' intrinsic at \\(1\\) shall be of type 'team_type'" }
+ isv = image_status(1, team=1) ! { dg-error "shall be of type 'team_type'" }
isv = image_status() ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
isv = image_status(team=1) ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
index 8866f23..fb49289 100644
--- a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
@@ -1,38 +1,12 @@
! { dg-do run }
program test_image_status_2
- use iso_fortran_env
+ use iso_fortran_env , only : STAT_STOPPED_IMAGE
implicit none
- type(team_type) :: t
- integer :: i, st
- integer, allocatable :: rem_images(:)
-
- form team (1, t)
-
if (image_status(1) /= 0) error stop "Image 1 should report OK."
- if (image_status(num_images() + 1) /= STAT_STOPPED_IMAGE) error stop "Image should be stopped."
-
- if (image_status(1, t) /= 0) error stop "Image 1 in team t should report OK."
-
- if (num_images() > 1) then
- associate (np => num_images())
- sync all
- if (this_image() == 2) fail image
- rem_images = (/ 1, ( i, i = 3, np )/)
- ! Can't synchronize well on failed image. Try with a sleep.
- do i = 0, 10
- if (image_status(2) /= STAT_FAILED_IMAGE) then
- call sleep(1)
- else
- exit
- end if
- end do
- sync images (rem_images, stat=st)
- if (image_status(2) /= STAT_FAILED_IMAGE) error stop "Image 2 has NOT status failed."
- if (image_status(2, t) /= STAT_FAILED_IMAGE) error stop "Image 2 has NOT status failed."
- end associate
- end if
+ if (image_status(2) /= STAT_STOPPED_IMAGE) error stop "Image 2 should be stopped."
+ if (image_status(3) /= STAT_STOPPED_IMAGE) error stop "Image 3 should be stopped."
end program test_image_status_2
diff --git a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90 b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
index 3d445b9..8e96154 100644
--- a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
@@ -58,8 +58,6 @@ if (stat /= 0) STOP 9
UNLOCK(lock3(4), stat=stat)
if (stat /= 0) STOP 10
-! Ensure all other (/=1) images have released the locks.
-sync all
if (this_image() == 1) then
acquired = .false.
LOCK (lock1[this_image()], acquired_lock=acquired)
diff --git a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90 b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
index 4da1b95..c284a56 100644
--- a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
@@ -12,28 +12,28 @@ allocate(a(1)[*])
if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
STOP 1
if (any (lcobound(a) /= 1)) STOP 2
-if (any (ucobound(a) /= num_images())) STOP 3
+if (any (ucobound(a) /= this_image())) STOP 3
deallocate(a)
allocate(b[*])
if (this_image() == 1 .and. any (this_image(b) /= lcobound(b))) &
STOP 4
if (any (lcobound(b) /= 1)) STOP 5
-if (any (ucobound(b) /= num_images())) STOP 6
+if (any (ucobound(b) /= this_image())) STOP 6
deallocate(b)
allocate(a(1)[-10:*])
if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
STOP 7
if (any (lcobound(a) /= -10)) STOP 8
-if (any (ucobound(a) /= -11 + num_images())) STOP 9
+if (any (ucobound(a) /= -11+this_image())) STOP 9
deallocate(a)
allocate(d[23:*])
if (this_image() == 1 .and. any (this_image(d) /= lcobound(d))) &
STOP 10
if (any (lcobound(d) /= 23)) STOP 11
-if (any (ucobound(d) /= 22 + num_images())) STOP 12
+if (any (ucobound(d) /= 22+this_image())) STOP 12
deallocate(d)
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
index 8dd7df5..b0d27bd 100644
--- a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
@@ -19,7 +19,7 @@ if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
deallocate(a)
allocate(a[4:*])
-a[this_image () + 3] = 8 - 2*this_image ()
+a[this_image ()] = 8 - 2*this_image ()
if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
STOP 4
@@ -30,7 +30,6 @@ n3 = 3
allocate (B[n1:n2, n3:*])
if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
STOP 5
-sync all
call sub(A, B)
if (allocated (a)) STOP 6
@@ -48,8 +47,7 @@ contains
STOP 8
if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
STOP 9
- if (x[this_image () + 3] /= 8 - 2*this_image ()) STOP 10
- sync all
+ if (x[this_image ()] /= 8 - 2*this_image ()) STOP 3
deallocate(x)
end subroutine sub
@@ -58,13 +56,12 @@ contains
integer, allocatable, SAVE :: a[:]
if (init) then
- if (allocated(a)) STOP 11
+ if (allocated(a)) STOP 10
allocate(a[*])
a = 45
else
- if (.not. allocated(a)) STOP 12
- if (a /= 45) STOP 13
- sync all
+ if (.not. allocated(a)) STOP 11
+ if (a /= 45) STOP 12
deallocate(a)
end if
end subroutine two
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
index 7658e6b..403de58 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
@@ -8,7 +8,7 @@ program test_stopped_images_1
integer :: i
gi = stopped_images() ! OK
- gi = stopped_images(TEAM=1) ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
+ gi = stopped_images(TEAM=1) ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) not yet supported" }
gi = stopped_images(KIND=1) ! OK
gi = stopped_images(KIND=4) ! OK
gi = stopped_images(KIND=0) ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be positive" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
index dadd00e..0bf4a81 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
@@ -1,44 +1,17 @@
! { dg-do run }
program test_stopped_images_2
- use iso_fortran_env
implicit none
- type(team_type) :: t
integer, allocatable :: si(:)
integer(kind=1), allocatable :: ssi(:)
- integer, allocatable :: rem_images(:)
- integer :: i, st
- associate(np => num_images())
- form team (1, t)
- si = stopped_images()
- if (size(si) > 0) stop 1
- ssi = stopped_images(KIND=1)
- if (size(ssi) > 0) stop 2
- ssi = stopped_images(KIND=8)
- if (size(ssi) > 0) stop 3
-
- si = stopped_images(t)
- if (size(si) > 0) stop 4
+ si = stopped_images()
+ if (size(si) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=1)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+ ssi = stopped_images(KIND=8)
+ if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
- if (num_images() > 1) then
- sync all
- if (this_image() == 2) stop
- rem_images = (/ 1, ( i, i = 3, np )/)
- ! Can't synchronize well on a stopped image. Try with a sleep.
- do i = 0, 10
- if (size(stopped_images()) == 0) then
- call sleep(1)
- else
- exit
- end if
- end do
- if (i == 10 .AND. size(stopped_images()) == 0) stop 5
- sync images (rem_images, stat=st)
- if (any(stopped_images() /= [2])) stop 6
- if (any(stopped_images(t, 8) /= [2])) stop 7
- end if
- end associate
end program test_stopped_images_2
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
index 4abe5a3..8633c4a 100644
--- a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
@@ -26,6 +26,7 @@ n = 5
sync all (stat=n,errmsg=str)
if (n /= 0) STOP 2
+
!
! Test SYNC MEMORY
!
@@ -41,21 +42,17 @@ n = 5
sync memory (errmsg=str,stat=n)
if (n /= 0) STOP 4
+
!
! Test SYNC IMAGES
!
sync images (*)
-
if (this_image() == 1) then
sync images (1)
sync images (1, errmsg=str)
sync images ([1])
end if
-! Need to sync all here, because otherwise sync image 1 may overlap with the
-! sync images(*, stat=n) below and that may hang for num_images() > 1.
-sync all
-
n = 5
sync images (*, stat=n)
if (n /= 0) STOP 5
@@ -64,5 +61,4 @@ n = 5
sync images (*,errmsg=str,stat=n)
if (n /= 0) STOP 6
-sync all
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
index ceb4b19..fe1e4c5 100644
--- a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
@@ -9,9 +9,8 @@
! PR fortran/18918
implicit none
-integer :: n, st
-integer,allocatable :: others(:)
-character(len=40) :: str
+integer :: n
+character(len=30) :: str
critical
end critical
myCr: critical
@@ -59,32 +58,17 @@ if (this_image() == 1) then
sync images ([1])
end if
-! Need to sync all here, because otherwise sync image 1 may overlap with the
-! sync images(*, stat=n) below and that may hang for num_images() > 1.
-sync all
-
n = 5
sync images (*, stat=n)
if (n /= 0) STOP 5
n = 5
-sync images (*, errmsg=str, stat=n)
+sync images (*,errmsg=str,stat=n)
if (n /= 0) STOP 6
-if (this_image() == num_images()) then
- others = (/( n, n=1, (num_images() - 1)) /)
- sync images(others)
-else
- sync images ( num_images() )
-end if
-
n = -1
-st = 0
-sync images (n, errmsg=str, stat=st)
-if (st /= 1 .OR. str /= "Invalid image number -1 in SYNC IMAGES") STOP 7
-
-! Do this only on image 1, or output of error messages will clutter
-if (this_image() == 1) sync images (n) ! Invalid: "-1"
+sync images ( num_images() )
+sync images (n) ! Invalid: "-1"
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_team.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_team.f90
deleted file mode 100644
index a968845..0000000
--- a/gcc/testsuite/gfortran.dg/coarray/sync_team.f90
+++ /dev/null
@@ -1,33 +0,0 @@
-!{ dg-do run }
-
-program main
- use, intrinsic :: iso_fortran_env, only: team_type
- implicit none
- integer, parameter :: PARENT_TEAM = 1, CURRENT_TEAM = 2, CHILD_TEAM = 3
- type(team_type) :: team(3)
-
- if (num_images() > 7) then
-
- form team (1, team(PARENT_TEAM))
- change team (team(PARENT_TEAM))
- form team (mod(this_image(),2) + 1, team(CURRENT_TEAM))
- change team (team(CURRENT_TEAM))
- form team(mod(this_image(),2) + 1, team(CHILD_TEAM))
- sync team(team(PARENT_TEAM))
- ! change order / number of syncs between teams to try to expose deadlocks
- if (team_number() == 1) then
- sync team(team(CURRENT_TEAM))
- sync team(team(CHILD_TEAM))
- else
- sync team(team(CHILD_TEAM))
- sync team(team(CURRENT_TEAM))
- sync team(team(CHILD_TEAM))
- sync team(team(CURRENT_TEAM))
- end if
- end team
- end team
-
- sync all
- end if
-
-end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90 b/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
index 0030d91..c4e660b 100644
--- a/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
@@ -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" } }