From: janus Date: Fri, 31 Dec 2010 10:08:17 +0000 (+0000) Subject: 2010-12-31 Janus Weil X-Git-Tag: upstream/4.9.2~23792 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a656e7c2ec135ce937c2ee2381a1337cf9160e1c;p=platform%2Fupstream%2Flinaro-gcc.git 2010-12-31 Janus Weil 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 PR fortran/46971 * gfortran.dg/class_33.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@168363 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d9e91c7..696ad58 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2010-12-31 Janus Weil + + 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 PR fortran/47085 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 46d8bf1..27c7d23 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -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 + and Janus Weil 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. */ diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index eb2d36e..0dbda0b 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6f6a9f4..b18a43d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 26bcf8c..b8798c7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-12-31 Janus Weil + + PR fortran/46971 + * gfortran.dg/class_33.f90: New. + 2010-12-30 Nicola Pero * objc.dg/method-conflict-3.m: New. diff --git a/gcc/testsuite/gfortran.dg/class_33.f90 b/gcc/testsuite/gfortran.dg/class_33.f90 new file mode 100644 index 0000000..b809fb1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_33.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! +! PR 46971: [4.6 Regression] [OOP] ICE on long class names +! +! Contributed by Andrew Benson + +module Molecular_Abundances_Structure + type molecularAbundancesStructure + end type + class(molecularAbundancesStructure), pointer :: molecules +end module + +! { dg-final { cleanup-modules "Molecular_Abundances_Structure" } }