[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Ajout nom variable dans temp select type

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:1340fd7a9b2a244989f74d90f1a31a9fcae63e1d

commit 1340fd7a9b2a244989f74d90f1a31a9fcae63e1d
Author: Mikael Morin <mik...@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 f211ad187613..913f04019a1e 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10802,7 +10802,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
@@ -10810,6 +10809,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);
@@ -10842,11 +10842,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;
@@ -10854,12 +10864,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);