diff options
author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2025-07-29 10:54:39 -0700 |
---|---|---|
committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2025-07-29 10:54:39 -0700 |
commit | 75164bb769816261706d317e08a5fee6d8ba49b6 (patch) | |
tree | e5a2a192a7c016dabcd6d58c58d8d9c195fae358 /gcc | |
parent | 6955bb63595259d94a8c8eaba56650fe7652c3cd (diff) | |
download | gcc-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')
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" } } |