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

gcc/fortran/ChangeLog

+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-09  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/41585

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;

gcc/testsuite/ChangeLog

+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.
+
 2009-10-11  Richard Guenther  <rguenther@suse.de>
 
 	PR tree-optimization/41555

gcc/testsuite/gfortran.dg/class_4a.f03

+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  type t
+  end type t
+end module m

gcc/testsuite/gfortran.dg/class_4b.f03

+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m2
+  use m
+  type, extends(t) :: t2
+  end type t2
+end module m2

gcc/testsuite/gfortran.dg/class_4c.f03

+! { dg-do run }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  use m
+  use m2
+  type,extends(t) :: t3
+  end type t3
+
+  integer :: i
+  class(t), allocatable :: a
+  allocate(t3 :: a)
+  select type(a)
+    type is(t)
+      i = 1
+    type is(t2)
+      i = 2
+    type is(t3)
+      i = 3
+  end select
+  print *, i
+end

gcc/testsuite/gfortran.dg/class_4d.f03

+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! This file does nothing other than clean up the modules.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  type t
+  end type t
+end module m
+! { dg-final { cleanup-modules "m m2" } }