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:
parent
6c2154a917
commit
4fa0269222
@ -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
|
||||
|
@ -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. */
|
||||
|
@ -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;
|
||||
|
@ -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 *);
|
||||
|
@ -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.
|
||||
|
13
gcc/testsuite/gfortran.dg/class_33.f90
Normal file
13
gcc/testsuite/gfortran.dg/class_33.f90
Normal 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" } }
|
Loading…
Reference in New Issue
Block a user