[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Ajout nom variable dans temp select type
Mikael Morin
mikael@gcc.gnu.org
Fri Jun 13 14:46:53 GMT 2025
https://gcc.gnu.org/g:5897fda7e98adbac15a061b2783ff4f0851eb8f7
commit 5897fda7e98adbac15a061b2783ff4f0851eb8f7
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Tue Feb 18 22:08:17 2025 +0100
Ajout nom variable dans temp select type
Diff:
---
gcc/fortran/resolve.cc | 24 +++++++++++++++++-------
1 file changed, 17 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 23d51258da6a..0d327f103ae1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10857,7 +10857,6 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
for (body = code->block; body; body = body->block)
{
gfc_symbol *vtab;
- gfc_expr *e;
c = body->ext.block.case_list;
/* Generate an index integer expression for address of the
@@ -10865,6 +10864,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
is stored in c->high and is used to resolve intrinsic cases. */
if (c->ts.type != BT_UNKNOWN)
{
+ gfc_expr *e;
if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
{
vtab = gfc_find_derived_vtab (c->ts.u.derived);
@@ -10897,11 +10897,21 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
when this case is actually true, so build a new ASSOCIATE
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)
+ {
+ for (gfc_ref *r = code->expr1->ref; r; r = r->next)
+ if (r->type == REF_COMPONENT
+ && strcmp (r->u.c.component->name, "_data") != 0)
+ var_name = r->u.c.component->name;
+ }
if (c->ts.type == BT_CLASS)
- sprintf (name, "__tmp_class_%s", c->ts.u.derived->name);
+ sprintf (name, "__tmp_class_%s_%s", c->ts.u.derived->name, var_name);
else if (c->ts.type == BT_DERIVED)
- sprintf (name, "__tmp_type_%s", c->ts.u.derived->name);
+ sprintf (name, "__tmp_type_%s_%s", c->ts.u.derived->name, var_name);
else if (c->ts.type == BT_CHARACTER)
{
HOST_WIDE_INT charlen = 0;
@@ -10909,12 +10919,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
&& c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
charlen = gfc_mpz_get_hwi (c->ts.u.cl->length->value.integer);
snprintf (name, sizeof (name),
- "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
- gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
+ "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d_%s",
+ gfc_basic_typename (c->ts.type), charlen, c->ts.kind, var_name);
}
else
- sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
- c->ts.kind);
+ sprintf (name, "__tmp_%s_%d_%s", gfc_basic_typename (c->ts.type),
+ c->ts.kind, var_name);
st = gfc_find_symtree (ns->sym_root, name);
gcc_assert (st->n.sym->assoc);
More information about the Gcc-cvs
mailing list