Hi all,
attached patch fixes a confusion of compiler generated temporary symbols and
Fortran symbols, when the user choose the same name by accident. The generated
symbols are now prefixed using two underscores, which fixes the issue.
Regtests ok on x86_64-pc-linux-gnu / F43. Ok for mainline? Ok for later
backport to gcc-16,15 ?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From f59fa2e963c9b6d2a5ad062add9d605860482ce9 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <[email protected]>
Date: Tue, 28 Apr 2026 14:30:23 +0200
Subject: [PATCH] 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.
---
gcc/fortran/coarray.cc | 23 ++++++++++---------
.../gfortran.dg/coarray/pr125021.f90 | 21 +++++++++++++++++
2 files changed, 33 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr125021.f90
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
+
--
2.54.0
