[gcc(refs/users/mikael/heads/refactor_descriptor_v06_temp)] Ajout nom de variable au variables temporaires select type

[Mikael Morin]

https://gcc.gnu.org/g:7a9396443bd81b27d61a99eefe1a29f832fc1434

commit 7a9396443bd81b27d61a99eefe1a29f832fc1434
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Wed Jun 18 18:07:54 2025 +0200

    Ajout nom de variable au variables temporaires select type

Diff:
---
 gcc/fortran/match.cc   | 35 +++++++++++++++++++++++++++--------
 gcc/fortran/resolve.cc | 27 ++++++++++++++++++++-------
 2 files changed, 47 insertions(+), 15 deletions(-)

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index a99a757bede6..09082db8b24c 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -7171,7 +7171,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;
@@ -7192,12 +7192,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;
@@ -7222,6 +7222,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
@@ -7239,7 +7255,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)
     {
@@ -7247,9 +7266,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 5413d8f9c542..0070e8c170d2 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10819,6 +10819,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;
@@ -10846,7 +10848,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
@@ -10854,6 +10855,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);
@@ -10886,11 +10888,22 @@ 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 (orig_expr1->symtree)
+	var_name = orig_expr1->symtree->name;
+      if (orig_expr1->ref)
+	{
+	  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, "_vptr") == 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;
@@ -10898,12 +10911,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);