re PR fortran/40440 (Automatic deallocation component of DT function return value)

2009-10-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40440
	* decl.c (hash_value): New function.
	(gfc_match_derived_decl): Call it.

2009-10-11  Paul Thomas  <pault@gcc.gnu.org>

	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

1 files changed, 40 insertions, 4 deletions

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;