https://gcc.gnu.org/g:cd8b2b3704d972f2219404be7aa953a89cfc8342
commit cd8b2b3704d972f2219404be7aa953a89cfc8342
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Feb 18 22:27:39 2025 +0100
Modification nom variable select type
Diff:
---
gcc/fortran/match.cc | 35 +++++++++++++++++++++++++++--------
gcc/fortran/resolve.cc | 13 ++++++++-----
2 files changed, 35 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index ec9e5873204a..f609f92b0f0d 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6861,7 +6861,7 @@ select_type_push (gfc_symbol *sel)
/* Set the temporary for the current intrinsic SELECT TYPE selector. */
static gfc_symtree *
-select_intrinsic_set_tmp (gfc_typespec *ts)
+select_intrinsic_set_tmp (gfc_typespec *ts, const char *var_name)
{
char name[GFC_MAX_SYMBOL_LEN];
gfc_symtree *tmp;
@@ -6882,12 +6882,12 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
if (ts->type != BT_CHARACTER)
- sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
- ts->kind);
+ sprintf (name, "__tmp_%s_%d_%s", gfc_basic_typename (ts->type),
+ ts->kind, var_name);
else
snprintf (name, sizeof (name),
- "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
- gfc_basic_typename (ts->type), charlen, ts->kind);
+ "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d_%s",
+ gfc_basic_typename (ts->type), charlen, ts->kind, var_name);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
sym = tmp->n.sym;
@@ -6912,6 +6912,22 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
}
+static const char *
+get_select_type_var_name ()
+{
+ const char *name = "";
+ gfc_expr *e = gfc_state_stack->construct->expr1;
+ if (e->symtree)
+ name = e->symtree->name;
+ for (gfc_ref *r = e->ref; r; r = r->next)
+ if (r->type == REF_COMPONENT
+ && strcmp (r->u.c.component->name, "_data") != 0)
+ name = r->u.c.component->name;
+
+ return name;
+}
+
+
/* Set up a temporary for the current TYPE IS / CLASS IS branch . */
static void
@@ -6929,7 +6945,10 @@ select_type_set_tmp (gfc_typespec *ts)
return;
}
- tmp = select_intrinsic_set_tmp (ts);
+
+ const char *var_name = get_select_type_var_name ();
+
+ tmp = select_intrinsic_set_tmp (ts, var_name);
if (tmp == NULL)
{
@@ -6937,9 +6956,9 @@ select_type_set_tmp (gfc_typespec *ts)
return;
if (ts->type == BT_CLASS)
- sprintf (name, "__tmp_class_%s", ts->u.derived->name);
+ sprintf (name, "__tmp_class_%s_%s", ts->u.derived->name, var_name);
else
- sprintf (name, "__tmp_type_%s", ts->u.derived->name);
+ sprintf (name, "__tmp_type_%s_%s", ts->u.derived->name, var_name);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
sym = tmp->n.sym;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 913f04019a1e..820d38f5a27b 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10775,6 +10775,8 @@ resolve_select_type (gfc_code *code, gfc_namespace
*old_ns)
ref = gfc_copy_ref (ref);
}
+ gfc_expr *orig_expr1 = code->expr1;
+
/* Add EXEC_SELECT to switch on type. */
new_st = gfc_get_code (code->op);
new_st->expr1 = code->expr1;
@@ -10843,13 +10845,14 @@ resolve_select_type (gfc_code *code, gfc_namespace
*old_ns)
that does precisely this here (instead of using the
'global' one). */
const char * var_name = "";
- if (code->expr1->symtree)
- var_name = code->expr1->symtree->name;
- if (code->expr1->ref)
+ if (orig_expr1->symtree)
+ var_name = orig_expr1->symtree->name;
+ if (orig_expr1->ref)
{
- for (gfc_ref *r = code->expr1->ref; r; r = r->next)
+ for (gfc_ref *r = orig_expr1->ref; r; r = r->next)
if (r->type == REF_COMPONENT
- && strcmp (r->u.c.component->name, "_data") != 0)
+ && !(strcmp (r->u.c.component->name, "_data") == 0
+ || strcmp (r->u.c.component->name, "_vptr") == 0))
var_name = r->u.c.component->name;
}
