https://gcc.gnu.org/g:21571d265523e9ab8bca865426d3c62e22a3bff8
commit r16-8932-g21571d265523e9ab8bca865426d3c62e22a3bff8 Author: Andre Vehreschild <[email protected]> Date: Tue Apr 28 14:30:23 2026 +0200 Fortran: Use internal names for local symbols. Prevent collision of Fortran symbols with internally generated symbols by prefixing internals with two underscores. PR fortran/125021 gcc/fortran/ChangeLog: * coarray.cc (check_add_new_comp_handle_array): Prefix internal symbols by two underscores. (create_get_callback): Same. (create_allocated_callback): Same. (create_send_callback): Same. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/pr125021.f90: New test. (cherry picked from commit fee68dd1b484d5885abb110f1e8753f113db5713) Diff: --- gcc/fortran/coarray.cc | 23 ++++++++++++----------- gcc/testsuite/gfortran.dg/coarray/pr125021.f90 | 21 +++++++++++++++++++++ 2 files changed, 33 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc index 18f4c29c1057..dbca4a152de9 100644 --- a/gcc/fortran/coarray.cc +++ b/gcc/fortran/coarray.cc @@ -620,7 +620,7 @@ check_add_new_comp_handle_array (gfc_expr *e, gfc_symbol *type, c->expr2->ref->u.ar.codimen = 1; c->expr2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; caller_image - = gfc_find_symtree_in_proc ("caller_image", add_data->ns); + = gfc_find_symtree_in_proc ("__caller_image", add_data->ns); gcc_assert (caller_image); c->expr2->ref->u.ar.start[0] = gfc_get_variable_expr (caller_image); c->expr2->ref->u.ar.start[0]->where = e->where; @@ -866,16 +866,16 @@ create_get_callback (gfc_expr *expr) (*argptr)->sym = nsym; \ argptr = &(*argptr)->next - name = xasprintf ("add_data_%s_%s_%d", mname, tname, caf_sym_cnt); + name = xasprintf ("__add_data_%s_%s_%d", mname, tname, caf_sym_cnt); ADD_ARG (name, get_data, BT_DERIVED, 0, INTENT_IN); gfc_commit_symbol (get_data); free (name); - ADD_ARG ("caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, + ADD_ARG ("__caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, INTENT_IN); gfc_commit_symbol (caller_image); - ADD_ARG ("buffer", buffer, expr->ts.type, expr->ts.kind, INTENT_INOUT); + ADD_ARG ("__buffer", buffer, expr->ts.type, expr->ts.kind, INTENT_INOUT); buffer->ts = expr->ts; if (expr_rank) { @@ -915,7 +915,7 @@ create_get_callback (gfc_expr *expr) } gfc_commit_symbol (buffer); - ADD_ARG ("free_buffer", free_buffer, BT_LOGICAL, gfc_default_logical_kind, + ADD_ARG ("__free_buffer", free_buffer, BT_LOGICAL, gfc_default_logical_kind, INTENT_OUT); gfc_commit_symbol (free_buffer); @@ -1115,15 +1115,16 @@ create_allocated_callback (gfc_expr *expr) (*argptr)->sym = nsym; \ argptr = &(*argptr)->next - name = xasprintf ("add_data_%s_%s_%d", mname, tname, ++caf_sym_cnt); + name = xasprintf ("__add_data_%s_%s_%d", mname, tname, ++caf_sym_cnt); ADD_ARG (name, add_data, BT_DERIVED, 0, INTENT_IN); gfc_commit_symbol (add_data); free (name); - ADD_ARG ("caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, + ADD_ARG ("__caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, INTENT_IN); gfc_commit_symbol (caller_image); - ADD_ARG ("result", result, BT_LOGICAL, gfc_default_logical_kind, INTENT_OUT); + ADD_ARG ("__result", result, BT_LOGICAL, gfc_default_logical_kind, + INTENT_OUT); gfc_commit_symbol (result); // ADD_ARG (expr->symtree->name, base, BT_VOID, INTENT_IN); @@ -1260,12 +1261,12 @@ create_send_callback (gfc_expr *expr, gfc_expr *rhs) (*argptr)->sym = nsym; \ argptr = &(*argptr)->next - name = xasprintf ("add_send_data_%s_%s_%d", mname, tname, caf_sym_cnt); + name = xasprintf ("__add_send_data_%s_%s_%d", mname, tname, caf_sym_cnt); ADD_ARG (name, send_data, BT_DERIVED, 0, INTENT_IN); gfc_commit_symbol (send_data); free (name); - ADD_ARG ("caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, + ADD_ARG ("__caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind, INTENT_IN); gfc_commit_symbol (caller_image); @@ -1279,7 +1280,7 @@ create_send_callback (gfc_expr *expr, gfc_expr *rhs) argptr = &(*argptr)->next; gfc_commit_symbol (base); - ADD_ARG ("buffer", buffer, rhs->ts.type, rhs->ts.kind, INTENT_IN); + ADD_ARG ("__buffer", buffer, rhs->ts.type, rhs->ts.kind, INTENT_IN); buffer->ts = rhs->ts; if (rhs->rank) { diff --git a/gcc/testsuite/gfortran.dg/coarray/pr125021.f90 b/gcc/testsuite/gfortran.dg/coarray/pr125021.f90 new file mode 100644 index 000000000000..db6285f3e8ca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/pr125021.f90 @@ -0,0 +1,21 @@ +!{ dg-do run } + +! Contributed by Neil Carlson <[email protected]> +! Test for PR fortran/125021 + +type box + integer, allocatable :: data(:) +end type +type(box), allocatable :: buffer[:] + +integer :: i, n + +allocate(buffer[*]) +allocate(buffer%data(1), source=this_image()) +sync all + +i = 1 + modulo(this_image(), num_images()) +n = buffer[i]%data(1) +if (n /= i ) error stop +end +
