TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 23:25:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Use internal names for local symbols.

Browse Source 
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.
This commit is contained in:
Andre Vehreschild
2026-04-28 14:30:23 +02:00
parent 2a64a63d98
commit fee68dd1b4
2 changed files with 33 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/fortran/coarray.cc
View File

@@ -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)
{

21
gcc/testsuite/gfortran.dg/coarray/pr125021.f90 Normal file
View File

@@ -0,0 +1,21 @@
!{ dg-do run }
! Contributed by Neil Carlson <neil.n.carlson@gmail.com>
! 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