https://gcc.gnu.org/g:9d448830cc85414e22839ac5be20c1ca1fd4ce33
commit r17-5265-g9d448830cc85414e22839ac5be20c1ca1fd4ce33 Author: Jerry DeLisle <[email protected]> Date: Thu Jun 11 12:05:15 2026 -0700 fortran: [PR125747] Fix shadow-variable bugs for DO CONCURRENT/FORALL type-spec Give each shadow variable for a type-spec index-name a unique numbered name, record the shadowed outer symbol in the iterator, and do not substitute into a nested FORALL/DO CONCURRENT that shadows the same symbol. Assisted-by: Claude Opus 5.5 PR fortran/125747 gcc/fortran/ChangeLog: * gfortran.h (gfc_forall_iterator): Add shadow_outer_sym. * match.cc (apply_typespec_to_iterator): Number the shadow variable name and set shadow_outer_sym. * resolve.cc (check_default_none_expr): Use shadow_outer_sym. (replace_in_code_recursive): Do not recurse into a nested FORALL/DO CONCURRENT that shadows old_sym. (gfc_resolve_forall): Use shadow_outer_sym. gcc/testsuite/ChangeLog: * gfortran.dg/do_concurrent_typespec_2.f90: New test. * gfortran.dg/do_concurrent_typespec_3.f90: New test. * gfortran.dg/do_concurrent_typespec_4.f90: New test. * gfortran.dg/do_concurrent_typespec_6.f90: New test. Diff: --- gcc/fortran/gfortran.h | 2 + gcc/fortran/match.cc | 15 +++++--- gcc/fortran/resolve.cc | 45 ++++++++-------------- .../gfortran.dg/do_concurrent_typespec_2.f90 | 32 +++++++++++++++ .../gfortran.dg/do_concurrent_typespec_3.f90 | 32 +++++++++++++++ .../gfortran.dg/do_concurrent_typespec_4.f90 | 35 +++++++++++++++++ .../gfortran.dg/do_concurrent_typespec_6.f90 | 19 +++++++++ 7 files changed, 147 insertions(+), 33 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c62ae5565557..130f17af39c7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3243,6 +3243,8 @@ typedef struct gfc_forall_iterator gfc_loop_annot annot; /* index-name shadows a variable from outer scope. */ bool shadow; + /* The shadowed outer-scope symbol, set when SHADOW is true. */ + gfc_symbol *shadow_outer_sym; struct gfc_forall_iterator *next; } gfc_forall_iterator; diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index d61757046d26..8e83cf39590d 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -2819,13 +2819,17 @@ cleanup: } +/* Counter used to uniquify shadow-variable names created below. */ + +static int shadow_var_num = 0; + /* Apply type-spec to iterator and create shadow variable if needed. */ static void apply_typespec_to_iterator (gfc_forall_iterator *iter, gfc_typespec *ts, locus *loc) { - char *name; + const char *name; gfc_expr *v; gfc_symtree *st; @@ -2846,14 +2850,15 @@ apply_typespec_to_iterator (gfc_forall_iterator *iter, gfc_typespec *ts, else { /* Variable exists in outer scope - must create shadow to comply - with F2018 19.4(6) scoping rules. */ - name = (char *) alloca (strlen (v->symtree->name) + 2); - strcpy (name, "_"); - strcat (name, v->symtree->name); + with F2018 19.4(6) scoping rules. Number the shadow so sibling + constructs do not share it. */ + name = gfc_get_string ("_%s_%d", v->symtree->name, shadow_var_num++); if (gfc_get_sym_tree (name, NULL, &st, false) != 0) gfc_internal_error ("Failed to create shadow variable symtree for " "DO CONCURRENT type-spec at %L", loc); + iter->shadow_outer_sym = iter->var->symtree->n.sym; + v = gfc_get_expr (); v->where = gfc_current_locus; v->expr_type = EXPR_VARIABLE; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 29247f4ec2dc..71e94e5a60b0 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -8709,11 +8709,9 @@ check_default_none_expr (gfc_expr **e, int *, void *data) if (!iter->var || !iter->var->symtree) continue; const char *iter_name = iter->var->symtree->name; - /* Shadow iterators (from inline type-spec: integer :: i = ...) - store the iterator with a leading underscore internally; the - user-visible name does not have the underscore. */ + /* Use the user-visible name of a shadow iterator. */ if (iter->shadow) - iter_name++; + iter_name = iter->shadow_outer_sym->name; if (strcmp (sym->name, iter_name) == 0) return 0; } @@ -12895,8 +12893,19 @@ replace_in_code_recursive (gfc_code *code, gfc_symbol *old_sym, gfc_symtree *new break; } - /* Recurse into blocks */ - if (c->block) + /* Recurse into blocks, except a nested FORALL/DO CONCURRENT that + shadows OLD_SYM itself. */ + bool skip_nested_shadow = false; + if (c->op == EXEC_FORALL || c->op == EXEC_DO_CONCURRENT) + for (gfc_forall_iterator *fa = c->ext.concur.forall_iterator; + fa; fa = fa->next) + if (fa->shadow && fa->shadow_outer_sym == old_sym) + { + skip_nested_shadow = true; + break; + } + + if (c->block && !skip_nested_shadow) replace_in_code_recursive (c->block->next, old_sym, new_st); } } @@ -12991,29 +13000,9 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save) { if (fa->shadow) { - gfc_symtree *shadow_st; - const char *shadow_name_str; - char *outer_name; - - /* fa->var now points to the shadow variable "_name". */ - shadow_name_str = fa->var->symtree->name; - shadow_st = fa->var->symtree; - - if (shadow_name_str[0] != '_') - gfc_internal_error ("Expected shadow variable name to start with _"); - - outer_name = (char *) alloca (strlen (shadow_name_str)); - strcpy (outer_name, shadow_name_str + 1); - - /* Find the ITERATOR symbol in the current namespace. - This is the local DO CONCURRENT variable that body expressions reference. */ - gfc_symtree *iter_st = gfc_find_symtree (ns->sym_root, outer_name); - - if (!iter_st) - /* No iterator variable found - this shouldn't happen */ - continue; + gfc_symtree *shadow_st = fa->var->symtree; - gfc_symbol *iter_sym = iter_st->n.sym; + gfc_symbol *iter_sym = fa->shadow_outer_sym; /* Walk the FORALL/DO CONCURRENT body and replace all references. */ if (code->block && code->block->next) diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90 new file mode 100644 index 000000000000..3dfb3db16d69 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! +! PR 125747 +! Three consecutive DO CONCURRENT constructs reuse the index-name 'i' +! with type-specs. The second and third constructs each need a shadow +! variable per F2018 19.4(6); they used to be assigned the same shadow +! symbol "_i", and the third construct's INTEGER(2) type-spec mutated +! the shadow symbol shared with the second construct, leaving its +! already-converted INTEGER(4) bounds inconsistent with the (now +! INTEGER(2)) loop variable and causing an ICE in gfc_add_modify_loc. + +program p + implicit none + integer :: s1, s2, s3 + + s1 = 0 + do concurrent (integer :: i = 1:3) reduce(+:s1) + s1 = s1 + i + end do + + s2 = 0 + do concurrent (integer :: i = 1:3) reduce(+:s2) + s2 = s2 + i + end do + + s3 = 0 + do concurrent (integer(2) :: i = 1:3) reduce(+:s3) + s3 = s3 + int (i, kind (s3)) + end do + + if (s1 /= 6 .or. s2 /= 6 .or. s3 /= 6) stop 1 +end program p diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90 new file mode 100644 index 000000000000..ce2a23d9dcc3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! +! PR 125747 +! A nested DO CONCURRENT that re-shadows the same index-name 'i' as its +! enclosing construct, with a different type-spec. The outer construct's +! body-substitution (i -> its shadow) must not also rewrite references to +! 'i' inside the nested construct's body, since the nested construct +! shadows 'i' itself and performs its own substitution. + +program p + implicit none + integer :: s1, s2, total + + ! Establish 'i' as INTEGER(4) via a prior sibling construct. + s1 = 0 + do concurrent (integer :: i = 1:3) reduce(+:s1) + s1 = s1 + i + end do + + s2 = 0 + total = 0 + do concurrent (integer :: i = 1:2) reduce(+:s2) + s2 = s2 + i + do concurrent (integer(2) :: i = 1:3) reduce(+:total) + total = total + int (i, kind (total)) + end do + end do + + if (s1 /= 6) stop 1 + if (s2 /= 3) stop 2 + if (total /= 12) stop 3 +end program p diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90 new file mode 100644 index 000000000000..a8a2fc980eb3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! +! PR 125747 +! Deeper nesting of DO CONCURRENT constructs that all reuse the +! index-name 'i' with type-specs, each shadowing the same outer-scope +! symbol. Exercises three levels with three distinct kinds, and a +! non-monotonic reuse where the innermost construct repeats the +! outermost construct's type-spec. + +program p + implicit none + integer :: total1, total2 + + ! Three levels, three distinct kinds (default, kind=2, kind=8). + total1 = 0 + do concurrent (integer :: i = 1:2) reduce(+:total1) + do concurrent (integer(2) :: i = 1:2) reduce(+:total1) + do concurrent (integer(8) :: i = 1:2) reduce(+:total1) + total1 = total1 + int (i, kind (total1)) + end do + end do + end do + if (total1 /= 12) stop 1 + + ! Innermost construct reuses the outermost construct's type-spec. + total2 = 0 + do concurrent (integer :: i = 1:2) reduce(+:total2) + do concurrent (integer(2) :: i = 1:2) reduce(+:total2) + do concurrent (integer :: i = 1:2) reduce(+:total2) + total2 = total2 + i + end do + end do + end do + if (total2 /= 12) stop 2 +end program p diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_6.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_6.f90 new file mode 100644 index 000000000000..ec08d7eb66a7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_6.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR 125747 +! +! Shadowing a 63-character index-name used to hang the compiler. + +program p + implicit none + integer :: iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + integer :: s + s = 0 + do concurrent (integer(8) :: iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii = 1:2) reduce(+:s) + s = s + 1 + end do + do concurrent (integer(2) :: iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii = 1:3) reduce(+:s) + s = s + 1 + end do + if (s /= 5) stop 1 +end program p
