PR fortran/95687 - ICE in get_unique_hashed_string, at fortran/class.c:508

With submodules and PDTs, name mangling of interfaces may result in long
internal symbols overflowing a previously static internal buffer.  We now
set the buffer size dynamically.

gcc/fortran/
	PR fortran/95687
	* class.c (get_unique_type_string): Return a string with dynamic
	length.
	(get_unique_hashed_string, gfc_hash_value): Use dynamic result
	from get_unique_type_string instead of static buffer.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 227134eef3da56acc4ac8982bc8203e50d3a2d1a..2b760efe8d7f5ed88cb11b94a3304fcbb4a106e4 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -476,22 +476,38 @@ gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
    and module name. This is used to construct unique names for the class
    containers and vtab symbols.  */
 
-static void
-get_unique_type_string (char *string, gfc_symbol *derived)
+static char *
+get_unique_type_string (gfc_symbol *derived)
 {
   const char *dt_name;
+  char *string;
+  size_t len;
   if (derived->attr.unlimited_polymorphic)
     dt_name = "STAR";
   else
     dt_name = gfc_dt_upper_string (derived->name);
+  len = strlen (dt_name) + 2;
   if (derived->attr.unlimited_polymorphic)
-    sprintf (string, "_%s", dt_name);
+    {
+      string = XNEWVEC (char, len);
+      sprintf (string, "_%s", dt_name);
+    }
   else if (derived->module)
-    sprintf (string, "%s_%s", derived->module, dt_name);
+    {
+      string = XNEWVEC (char, strlen (derived->module) + len);
+      sprintf (string, "%s_%s", derived->module, dt_name);
+    }
   else if (derived->ns->proc_name)
-    sprintf (string, "%s_%s", derived->ns->proc_name->name, dt_name);
+    {
+      string = XNEWVEC (char, strlen (derived->ns->proc_name->name) + len);
+      sprintf (string, "%s_%s", derived->ns->proc_name->name, dt_name);
+    }
   else
-    sprintf (string, "_%s", dt_name);
+    {
+      string = XNEWVEC (char, len);
+      sprintf (string, "_%s", dt_name);
+    }
+  return string;
 }
 
 
@@ -502,10 +518,8 @@ static void
 get_unique_hashed_string (char *string, gfc_symbol *derived)
 {
   /* Provide sufficient space to hold "symbol.symbol_symbol".  */
-  char tmp[3*GFC_MAX_SYMBOL_LEN+3];
-  get_unique_type_string (&tmp[0], derived);
-  size_t len = strnlen (tmp, sizeof (tmp));
-  gcc_assert (len < sizeof (tmp));
+  char *tmp;
+  tmp = get_unique_type_string (derived);
   /* If string is too long, use hash value in hex representation (allow for
      extra decoration, cf. gfc_build_class_symbol & gfc_find_derived_vtab).
      We need space to for 15 characters "__class_" + symbol name + "_%d_%da",
@@ -517,6 +531,7 @@ get_unique_hashed_string (char *string, gfc_symbol *derived)
     }
   else
     strcpy (string, tmp);
+  free (tmp);
 }
 
 
@@ -527,16 +542,16 @@ gfc_hash_value (gfc_symbol *sym)
 {
   unsigned int hash = 0;
   /* Provide sufficient space to hold "symbol.symbol_symbol".  */
-  char c[3*GFC_MAX_SYMBOL_LEN+3];
+  char *c;
   int i, len;
 
-  get_unique_type_string (&c[0], sym);
-  len = strnlen (c, sizeof (c));
-  gcc_assert ((size_t) len < sizeof (c));
+  c = get_unique_type_string (sym);
+  len = strlen (c);
 
   for (i = 0; i < len; i++)
     hash = (hash << 6) + (hash << 16) - hash + c[i];
 
+  free (c);
   /* Return the hash but take the modulus for the sake of module read,
      even though this slightly increases the chance of collision.  */
   return (hash % 100000000);

diff --git a/gcc/testsuite/gfortran.dg/pr95687.f90 b/gcc/testsuite/gfortran.dg/pr95687.f90
new file mode 100644 (file)
index 0000000..a674533
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95687.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fsecond-underscore" }
+! PR fortran/95687 - ICE in get_unique_hashed_string, at fortran/class.c:508
+
+module m2345678901234567890123456789012345678901234567890123456789_123
+  interface
+     module subroutine s2345678901234567890123456789012345678901234567890123456789_123
+     end
+  end interface
+end
+submodule(m2345678901234567890123456789012345678901234567890123456789_123) &
+          n2345678901234567890123456789012345678901234567890123456789_123
+  type t2345678901234567890123456789012345678901234567890123456789_123 &
+      (a2345678901234567890123456789012345678901234567890123456789_123)
+     integer, kind :: a2345678901234567890123456789012345678901234567890123456789_123 = 4
+  end type
+  class(t2345678901234567890123456789012345678901234567890123456789_123(3)), pointer :: &
+        x2345678901234567890123456789012345678901234567890123456789_123
+end