re PR fortran/46971 ([OOP] ICE on long class names)

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-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46971
	* gfortran.dg/class_33.f90: New.

From-SVN: r168363
This commit is contained in:
Janus Weil 2010-12-31 11:08:17 +01:00
parent 6c2154a917
commit 4fa0269222
6 changed files with 83 additions and 47 deletions

View File

@ -1,3 +1,16 @@
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

View File

@ -1,7 +1,8 @@
/* 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.
@ -116,8 +117,51 @@ get_unique_type_string (char *string, gfc_symbol *derived)
{
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);
}
@ -130,13 +174,13 @@ gfc_try
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)
@ -343,9 +387,9 @@ gfc_find_derived_vtab (gfc_symbol *derived)
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. */

View File

@ -7183,46 +7183,6 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
}
/* 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. */
@ -7355,7 +7315,7 @@ gfc_match_derived_decl (void)
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;

View File

@ -2868,6 +2868,7 @@ void gfc_add_component_ref (gfc_expr *, const char *);
#define gfc_add_size_component(e) gfc_add_component_ref(e,"_size")
#define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
gfc_expr *gfc_class_null_initializer (gfc_typespec *);
unsigned int gfc_hash_value (gfc_symbol *);
gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
gfc_array_spec **, bool);
gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);

View File

@ -1,3 +1,8 @@
2010-12-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/46971
* gfortran.dg/class_33.f90: New.
2010-12-30 Nicola Pero <nicola.pero@meta-innovation.com>
* objc.dg/method-conflict-3.m: New.

View File

@ -0,0 +1,13 @@
! { dg-do compile }
!
! PR 46971: [4.6 Regression] [OOP] ICE on long class names
!
! Contributed by Andrew Benson <abenson@its.caltech.edu>
module Molecular_Abundances_Structure
type molecularAbundancesStructure
end type
class(molecularAbundancesStructure), pointer :: molecules
end module
! { dg-final { cleanup-modules "Molecular_Abundances_Structure" } }