[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