From a14ce12818b1c5c6b3ea4bdd8c6074669cce2a20 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 11 Oct 2009 12:20:09 +0000 Subject: re PR fortran/40440 (Automatic deallocation component of DT function return value) 2009-10-11 Paul Thomas PR fortran/40440 * decl.c (hash_value): New function. (gfc_match_derived_decl): Call it. 2009-10-11 Paul Thomas PR fortran/40440 * gfortran.dg/class_4a.f03: New test with class_4b,c and d.f03. * gfortran.dg/class_4b.f03: As above. * gfortran.dg/class_4c.f03: As above. * gfortran.dg/class_4d.f03: As above. From-SVN: r152640 --- gcc/fortran/decl.c | 44 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 40 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 1856d89..69449a3 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6747,8 +6747,44 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name) } -/* Counter for assigning a unique vindex number to each derived type. */ -static int vindex_counter = 0; +/* 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 @@ -6872,8 +6908,8 @@ gfc_match_derived_decl (void) } if (!sym->vindex) - /* Set the vindex for this type and increment the counter. */ - sym->vindex = ++vindex_counter; + /* Set the vindex for this type. */ + sym->vindex = hash_value (sym); /* Take over the ABSTRACT attribute. */ sym->attr.abstract = attr.abstract; -- cgit v1.1