+2010-12-31 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/46971
+ * gfortran.h (gfc_hash_value): Add prototype.
+ * class.c (get_unique_type_string): Check if proc_name is present and
+ make sure string contains an underscore.
+ (get_unique_hashed_string): New function which creates a hashed string
+ if the given unique string is too long.
+ (gfc_hash_value): Moved here from decl.c, renamed and simplified.
+ (gfc_build_class_symbol, gfc_find_derived_vtab): Use hashed strings.
+ * decl.c (hash_value): Moved to class.c.
+ (gfc_match_derived_decl): Renamed 'hash_value'.
+
2010-12-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/47085
/* Implementation of Fortran 2003 Polymorphism.
Copyright (C) 2009, 2010
Free Software Foundation, Inc.
- Contributed by Paul Richard Thomas & Janus Weil
+ Contributed by Paul Richard Thomas <pault@gcc.gnu.org>
+ and Janus Weil <janus@gcc.gnu.org>
This file is part of GCC.
{
if (derived->module)
sprintf (string, "%s_%s", derived->module, derived->name);
- else
+ else if (derived->ns->proc_name)
sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name);
+ else
+ sprintf (string, "_%s", derived->name);
+}
+
+
+/* A relative of 'get_unique_type_string' which makes sure the generated
+ string will not be too long (replacing it by a hash string if needed). */
+
+static void
+get_unique_hashed_string (char *string, gfc_symbol *derived)
+{
+ char tmp[2*GFC_MAX_SYMBOL_LEN+2];
+ get_unique_type_string (&tmp[0], derived);
+ /* If string is too long, use hash value in hex representation
+ (allow for extra decoration, cf. gfc_build_class_symbol)*/
+ if (strlen (tmp) > GFC_MAX_SYMBOL_LEN - 10)
+ {
+ int h = gfc_hash_value (derived);
+ sprintf (string, "%X", h);
+ }
+ else
+ strcpy (string, tmp);
+}
+
+
+/* Assign a hash value for a derived type. The algorithm is that of SDBM. */
+
+unsigned int
+gfc_hash_value (gfc_symbol *sym)
+{
+ unsigned int hash = 0;
+ char c[2*(GFC_MAX_SYMBOL_LEN+1)];
+ int i, len;
+
+ get_unique_type_string (&c[0], sym);
+ len = strlen (c);
+
+ for (i = 0; i < len; i++)
+ hash = (hash << 6) + (hash << 16) - hash + c[i];
+
+ /* 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);
}
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
gfc_array_spec **as, bool delayed_vtab)
{
- char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
+ char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
/* Determine the name of the encapsulating type. */
- get_unique_type_string (tname, ts->u.derived);
+ get_unique_hashed_string (tname, ts->u.derived);
if ((*as) && (*as)->rank && attr->allocatable)
sprintf (name, "__class_%s_%d_a", tname, (*as)->rank);
else if ((*as) && (*as)->rank)
if (ns)
{
- char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
+ char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
- get_unique_type_string (tname, derived);
+ get_unique_hashed_string (tname, derived);
sprintf (name, "__vtab_%s", tname);
/* Look for the vtab symbol in various namespaces. */
}
-/* Assign a hash value for a derived type. The algorithm is that of
- SDBM. The hashed string is '[module_name #] derived_name'. */
-static unsigned int
-hash_value (gfc_symbol *sym)
-{
- unsigned int hash = 0;
- const char *c;
- int i, len;
-
- /* Hash of the module or procedure name. */
- if (sym->module != NULL)
- c = sym->module;
- else if (sym->ns && sym->ns->proc_name
- && sym->ns->proc_name->attr.flavor == FL_MODULE)
- c = sym->ns->proc_name->name;
- else
- c = NULL;
-
- if (c)
- {
- len = strlen (c);
- for (i = 0; i < len; i++, c++)
- hash = (hash << 6) + (hash << 16) - hash + (*c);
-
- /* Disambiguate between 'a' in 'aa' and 'aa' in 'a'. */
- hash = (hash << 6) + (hash << 16) - hash + '#';
- }
-
- /* Hash of the derived type name. */
- len = strlen (sym->name);
- c = sym->name;
- for (i = 0; i < len; i++, c++)
- hash = (hash << 6) + (hash << 16) - hash + (*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);
-}
-
-
/* Match the beginning of a derived type declaration. If a type name
was the result of a function, then it is possible to have a symbol
already to be known as a derived type yet have no components. */
if (!sym->hash_value)
/* Set the hash for the compound name for this type. */
- sym->hash_value = hash_value (sym);
+ sym->hash_value = gfc_hash_value (sym);
/* Take over the ABSTRACT attribute. */
sym->attr.abstract = attr.abstract;