diff options
author | Janus Weil <janus@gcc.gnu.org> | 2010-11-09 11:39:46 +0100 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2010-11-09 11:39:46 +0100 |
commit | b04533af33ccf91e2874b24dd3e678d195c83587 (patch) | |
tree | 14d1f54316ef0bc517c72a674952cb7d233fd288 /gcc | |
parent | 6496e42f8734797b1a5613585c47e51398419547 (diff) | |
download | gcc-b04533af33ccf91e2874b24dd3e678d195c83587.zip gcc-b04533af33ccf91e2874b24dd3e678d195c83587.tar.gz gcc-b04533af33ccf91e2874b24dd3e678d195c83587.tar.bz2 |
re PR fortran/46313 ([OOP] class container naming collisions)
2010-11-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/46313
* gfortran.h (gfc_add_data_component,gfc_add_vptr_component,
gfc_add_hash_component,gfc_add_size_component,
gfc_add_def_init_component): New macros.
* class.c (gfc_add_component_ref): Renamed data component.
(get_unique_type_string): New function.
(gfc_build_class_symbol): Use 'get_unique_type_string' to construct
uniques names for the class containers. Rename components.
(gfc_find_derived_vtab): Use 'get_unique_type_string' to construct
uniques names for the vtab symbols. Rename components.
* decl.c (attr_decl1): Renamed class container components.
* iresolve.c (gfc_resolve_extends_type_of): Ditto.
* match.c (select_type_set_tmp): Renamed temporaries.
* module.c (read_module): Renamed vtab and vtype symbols.
* resolve.c (resolve_structure_cons,resolve_typebound_function,
resolve_typebound_subroutine,resolve_deallocate_expr,
resolve_select_type,resolve_fl_derived): Renamed class container and
vtab components.
* trans-array.c (structure_alloc_comps): Ditto.
* trans-decl.c (gfc_trans_deferred_vars): Ditto.
* trans-expr.c (gfc_conv_derived_to_class,gfc_conv_structure,
gfc_trans_class_init_assign,gfc_trans_class_assign): Ditto.
* trans-intrinsic.c (gfc_conv_intrinsic_sizeof,
gfc_conv_intrinsic_storage_size,gfc_conv_allocated,gfc_conv_associated,
gfc_conv_same_type_as): Ditto.
* trans-stmt.c (gfc_trans_allocate): Ditto.
2010-11-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/46313
* gfortran.dg/class_29.f03: New.
From-SVN: r166480
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 29 | ||||
-rw-r--r-- | gcc/fortran/class.c | 91 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 4 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
-rw-r--r-- | gcc/fortran/iresolve.c | 4 | ||||
-rw-r--r-- | gcc/fortran/match.c | 4 | ||||
-rw-r--r-- | gcc/fortran/module.c | 4 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 40 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 4 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 2 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 24 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 20 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 22 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_29.f03 | 34 |
15 files changed, 191 insertions, 101 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 22cf7d8..bfd8303 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,32 @@ +2010-11-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/46313 + * gfortran.h (gfc_add_data_component,gfc_add_vptr_component, + gfc_add_hash_component,gfc_add_size_component, + gfc_add_def_init_component): New macros. + * class.c (gfc_add_component_ref): Renamed data component. + (get_unique_type_string): New function. + (gfc_build_class_symbol): Use 'get_unique_type_string' to construct + uniques names for the class containers. Rename components. + (gfc_find_derived_vtab): Use 'get_unique_type_string' to construct + uniques names for the vtab symbols. Rename components. + * decl.c (attr_decl1): Renamed class container components. + * iresolve.c (gfc_resolve_extends_type_of): Ditto. + * match.c (select_type_set_tmp): Renamed temporaries. + * module.c (read_module): Renamed vtab and vtype symbols. + * resolve.c (resolve_structure_cons,resolve_typebound_function, + resolve_typebound_subroutine,resolve_deallocate_expr, + resolve_select_type,resolve_fl_derived): Renamed class container and + vtab components. + * trans-array.c (structure_alloc_comps): Ditto. + * trans-decl.c (gfc_trans_deferred_vars): Ditto. + * trans-expr.c (gfc_conv_derived_to_class,gfc_conv_structure, + gfc_trans_class_init_assign,gfc_trans_class_assign): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_sizeof, + gfc_conv_intrinsic_storage_size,gfc_conv_allocated,gfc_conv_associated, + gfc_conv_same_type_as): Ditto. + * trans-stmt.c (gfc_trans_allocate): Ditto. + 2010-11-08 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/43899 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 43907dc..46d8bf1 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -29,18 +29,18 @@ along with GCC; see the file COPYING3. If not see Each CLASS variable is encapsulated by a class container, which is a structure with two fields: - * $data: A pointer to the actual data of the variable. This field has the + * _data: A pointer to the actual data of the variable. This field has the declared type of the class variable and its attributes (pointer/allocatable/dimension/...). - * $vptr: A pointer to the vtable entry (see below) of the dynamic type. + * _vptr: A pointer to the vtable entry (see below) of the dynamic type. For each derived type we set up a "vtable" entry, i.e. a structure with the following fields: - * $hash: A hash value serving as a unique identifier for this type. - * $size: The size in bytes of the derived type. - * $extends: A pointer to the vtable entry of the parent derived type. - * $def_init: A pointer to a default initialized variable of this type. - * $copy: A procedure pointer to a copying procedure. + * _hash: A hash value serving as a unique identifier for this type. + * _size: The size in bytes of the derived type. + * _extends: A pointer to the vtable entry of the parent derived type. + * _def_init: A pointer to a default initialized variable of this type. + * _copy: A procedure pointer to a copying procedure. After these follow procedure pointer components for the specific type-bound procedures. */ @@ -52,7 +52,7 @@ along with GCC; see the file COPYING3. If not see /* Insert a reference to the component of the given name. - Only to be used with CLASS containers. */ + Only to be used with CLASS containers and vtables. */ void gfc_add_component_ref (gfc_expr *e, const char *name) @@ -68,7 +68,7 @@ gfc_add_component_ref (gfc_expr *e, const char *name) break; tail = &((*tail)->next); } - if (*tail != NULL && strcmp (name, "$data") == 0) + if (*tail != NULL && strcmp (name, "_data") == 0) next = *tail; (*tail) = gfc_get_ref(); (*tail)->next = next; @@ -82,7 +82,7 @@ gfc_add_component_ref (gfc_expr *e, const char *name) /* Build a NULL initializer for CLASS pointers, - initializing the $data and $vptr components to zero. */ + initializing the _data and _vptr components to zero. */ gfc_expr * gfc_class_null_initializer (gfc_typespec *ts) @@ -107,31 +107,46 @@ gfc_class_null_initializer (gfc_typespec *ts) } +/* Create a unique string identifier for a derived type, composed of its name + and module name. This is used to construct unique names for the class + containers and vtab symbols. */ + +static void +get_unique_type_string (char *string, gfc_symbol *derived) +{ + if (derived->module) + sprintf (string, "%s_%s", derived->module, derived->name); + else + sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name); +} + + /* Build a polymorphic CLASS entity, using the symbol that comes from build_sym. A CLASS entity is represented by an encapsulating type, - which contains the declared type as '$data' component, plus a pointer - component '$vptr' which determines the dynamic type. */ + which contains the declared type as '_data' component, plus a pointer + component '_vptr' which determines the dynamic type. */ 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 + 5]; + char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN]; gfc_symbol *fclass; gfc_symbol *vtab; gfc_component *c; /* Determine the name of the encapsulating type. */ + get_unique_type_string (tname, ts->u.derived); if ((*as) && (*as)->rank && attr->allocatable) - sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank); + sprintf (name, "__class_%s_%d_a", tname, (*as)->rank); else if ((*as) && (*as)->rank) - sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank); + sprintf (name, "__class_%s_%d", tname, (*as)->rank); else if (attr->pointer) - sprintf (name, "class$%s_p", ts->u.derived->name); + sprintf (name, "__class_%s_p", tname); else if (attr->allocatable) - sprintf (name, "class$%s_a", ts->u.derived->name); + sprintf (name, "__class_%s_a", tname); else - sprintf (name, "class$%s", ts->u.derived->name); + sprintf (name, "__class_%s", tname); gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass); if (fclass == NULL) @@ -151,8 +166,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, NULL, &gfc_current_locus) == FAILURE) return FAILURE; - /* Add component '$data'. */ - if (gfc_add_component (fclass, "$data", &c) == FAILURE) + /* Add component '_data'. */ + if (gfc_add_component (fclass, "_data", &c) == FAILURE) return FAILURE; c->ts = *ts; c->ts.type = BT_DERIVED; @@ -167,8 +182,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, c->as = (*as); c->initializer = NULL; - /* Add component '$vptr'. */ - if (gfc_add_component (fclass, "$vptr", &c) == FAILURE) + /* Add component '_vptr'. */ + if (gfc_add_component (fclass, "_vptr", &c) == FAILURE) return FAILURE; c->ts.type = BT_DERIVED; if (delayed_vtab) @@ -316,7 +331,6 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_namespace *ns; gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL; gfc_symbol *copy = NULL, *src = NULL, *dst = NULL; - char name[2 * GFC_MAX_SYMBOL_LEN + 8]; /* Find the top-level namespace (MODULE or PROGRAM). */ for (ns = gfc_current_ns; ns; ns = ns->parent) @@ -329,7 +343,10 @@ gfc_find_derived_vtab (gfc_symbol *derived) if (ns) { - sprintf (name, "vtab$%s", derived->name); + char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN]; + + get_unique_type_string (tname, derived); + sprintf (name, "__vtab_%s", tname); /* Look for the vtab symbol in various namespaces. */ gfc_find_symbol (name, gfc_current_ns, 0, &vtab); @@ -350,7 +367,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - sprintf (name, "vtype$%s", derived->name); + sprintf (name, "__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -366,8 +383,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) vtype->attr.vtype = 1; gfc_set_sym_referenced (vtype); - /* Add component '$hash'. */ - if (gfc_add_component (vtype, "$hash", &c) == FAILURE) + /* Add component '_hash'. */ + if (gfc_add_component (vtype, "_hash", &c) == FAILURE) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -375,8 +392,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->initializer = gfc_get_int_expr (gfc_default_integer_kind, NULL, derived->hash_value); - /* Add component '$size'. */ - if (gfc_add_component (vtype, "$size", &c) == FAILURE) + /* Add component '_size'. */ + if (gfc_add_component (vtype, "_size", &c) == FAILURE) goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; @@ -388,8 +405,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->initializer = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0); - /* Add component $extends. */ - if (gfc_add_component (vtype, "$extends", &c) == FAILURE) + /* Add component _extends. */ + if (gfc_add_component (vtype, "_extends", &c) == FAILURE) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -419,8 +436,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) goto have_vtype; } - /* Add component $def_init. */ - if (gfc_add_component (vtype, "$def_init", &c) == FAILURE) + /* Add component _def_init. */ + if (gfc_add_component (vtype, "_def_init", &c) == FAILURE) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -431,7 +448,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) else { /* Construct default initialization variable. */ - sprintf (name, "def_init$%s", derived->name); + sprintf (name, "__def_init_%s", tname); gfc_get_symbol (name, ns, &def_init); def_init->attr.target = 1; def_init->attr.save = SAVE_EXPLICIT; @@ -445,8 +462,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->initializer = gfc_lval_expr_from_sym (def_init); } - /* Add component $copy. */ - if (gfc_add_component (vtype, "$copy", &c) == FAILURE) + /* Add component _copy. */ + if (gfc_add_component (vtype, "_copy", &c) == FAILURE) goto cleanup; c->attr.proc_pointer = 1; c->attr.access = ACCESS_PRIVATE; @@ -462,7 +479,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - sprintf (name, "copy$%s", derived->name); + sprintf (name, "__copy_%s", tname); gfc_get_symbol (name, sub_ns, ©); sub_ns->proc_name = copy; copy->attr.flavor = FL_PROCEDURE; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 7fdfc99..eb2d36e 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6020,10 +6020,10 @@ attr_decl1 (void) /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). For CLASS variables, this must be applied - to the first component, or '$data' field. */ + to the first component, or '_data' field. */ if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class) { - if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr,&var_locus) + if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr, &var_locus) == FAILURE) { m = MATCH_ERROR; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2d0d4eb..13dbbc6 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2877,6 +2877,11 @@ gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); /* class.c */ void gfc_add_component_ref (gfc_expr *, const char *); +#define gfc_add_data_component(e) gfc_add_component_ref(e,"_data") +#define gfc_add_vptr_component(e) gfc_add_component_ref(e,"_vptr") +#define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash") +#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 *); gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, gfc_array_spec **, bool); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index e7a92da..12854fb 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -938,7 +938,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) /* Replace the first argument with the corresponding vtab. */ if (a->ts.type == BT_CLASS) - gfc_add_component_ref (a, "$vptr"); + gfc_add_vptr_component (a); else if (a->ts.type == BT_DERIVED) { vtab = gfc_find_derived_vtab (a->ts.u.derived); @@ -954,7 +954,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) /* Replace the second argument with the corresponding vtab. */ if (mo->ts.type == BT_CLASS) - gfc_add_component_ref (mo, "$vptr"); + gfc_add_vptr_component (mo); else if (mo->ts.type == BT_DERIVED) { vtab = gfc_find_derived_vtab (mo->ts.u.derived); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 41818e9..6cd1c46 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -4516,9 +4516,9 @@ select_type_set_tmp (gfc_typespec *ts) return; if (ts->type == BT_CLASS) - sprintf (name, "tmp$class$%s", ts->u.derived->name); + sprintf (name, "__tmp_class_%s", ts->u.derived->name); else - sprintf (name, "tmp$type$%s", ts->u.derived->name); + sprintf (name, "__tmp_type_%s", ts->u.derived->name); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); gfc_set_sym_referenced (tmp->n.sym); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 71699ad..f10e43b 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4372,8 +4372,8 @@ read_module (void) p = name; /* Exception: Always import vtabs & vtypes. */ - if (p == NULL && (strncmp (name, "vtab$", 5) == 0 - || strncmp (name, "vtype$", 6) == 0)) + if (p == NULL && (strncmp (name, "__vtab_", 5) == 0 + || strncmp (name, "__vtype_", 6) == 0)) p = name; /* Skip symtree nodes not in an ONLY clause, unless there diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7429ff2..f18d28c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -988,9 +988,9 @@ resolve_structure_cons (gfc_expr *expr, int init) !gfc_compare_types (&cons->expr->ts, &comp->ts)) { t = FAILURE; - if (strcmp (comp->name, "$extends") == 0) + if (strcmp (comp->name, "_extends") == 0) { - /* Can afford to be brutal with the $extends initializer. + /* Can afford to be brutal with the _extends initializer. The derived type can get lost because it is PRIVATE but it is not usage constrained by the standard. */ cons->expr->ts = comp->ts; @@ -5726,7 +5726,7 @@ resolve_typebound_function (gfc_expr* e) is present. */ ts = expr->ts; declared = ts.u.derived; - c = gfc_find_component (declared, "$vptr", true, true); + c = gfc_find_component (declared, "_vptr", true, true); if (c->ts.u.derived == NULL) c->ts.u.derived = gfc_find_derived_vtab (declared); @@ -5737,7 +5737,7 @@ resolve_typebound_function (gfc_expr* e) name = name ? name : e->value.function.esym->name; e->symtree = expr->symtree; e->ref = gfc_copy_ref (expr->ref); - gfc_add_component_ref (e, "$vptr"); + gfc_add_vptr_component (e); gfc_add_component_ref (e, name); e->value.function.esym = NULL; return SUCCESS; @@ -5760,7 +5760,7 @@ resolve_typebound_function (gfc_expr* e) return resolve_compcall (e, NULL); } - c = gfc_find_component (declared, "$data", true, true); + c = gfc_find_component (declared, "_data", true, true); declared = c->ts.u.derived; /* Treat the call as if it is a typebound procedure, in order to roll @@ -5776,8 +5776,8 @@ resolve_typebound_function (gfc_expr* e) if (new_ref) e->ref = new_ref; - /* '$vptr' points to the vtab, which contains the procedure pointers. */ - gfc_add_component_ref (e, "$vptr"); + /* '_vptr' points to the vtab, which contains the procedure pointers. */ + gfc_add_vptr_component (e); gfc_add_component_ref (e, name); /* Recover the typespec for the expression. This is really only @@ -5816,7 +5816,7 @@ resolve_typebound_subroutine (gfc_code *code) is present. */ ts = expr->symtree->n.sym->ts; declared = ts.u.derived; - c = gfc_find_component (declared, "$vptr", true, true); + c = gfc_find_component (declared, "_vptr", true, true); if (c->ts.u.derived == NULL) c->ts.u.derived = gfc_find_derived_vtab (declared); @@ -5827,7 +5827,7 @@ resolve_typebound_subroutine (gfc_code *code) name = name ? name : code->expr1->value.function.esym->name; code->expr1->symtree = expr->symtree; expr->symtree->n.sym->ts.u.derived = declared; - gfc_add_component_ref (code->expr1, "$vptr"); + gfc_add_vptr_component (code->expr1); gfc_add_component_ref (code->expr1, name); code->expr1->value.function.esym = NULL; return SUCCESS; @@ -5861,8 +5861,8 @@ resolve_typebound_subroutine (gfc_code *code) if (new_ref) code->expr1->ref = new_ref; - /* '$vptr' points to the vtab, which contains the procedure pointers. */ - gfc_add_component_ref (code->expr1, "$vptr"); + /* '_vptr' points to the vtab, which contains the procedure pointers. */ + gfc_add_vptr_component (code->expr1); gfc_add_component_ref (code->expr1, name); /* Recover the typespec for the expression. This is really only @@ -6404,7 +6404,7 @@ resolve_deallocate_expr (gfc_expr *e) if (e->ts.type == BT_CLASS) { /* Only deallocate the DATA component. */ - gfc_add_component_ref (e, "$data"); + gfc_add_data_component (e); } return SUCCESS; @@ -7735,8 +7735,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ns->code->next = new_st; code = new_st; code->op = EXEC_SELECT; - gfc_add_component_ref (code->expr1, "$vptr"); - gfc_add_component_ref (code->expr1, "$hash"); + gfc_add_vptr_component (code->expr1); + gfc_add_hash_component (code->expr1); /* Loop over TYPE IS / CLASS IS cases. */ for (body = code->block; body; body = body->block) @@ -7756,14 +7756,14 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) 'global' one). */ if (c->ts.type == BT_CLASS) - sprintf (name, "tmp$class$%s", c->ts.u.derived->name); + sprintf (name, "__tmp_class_%s", c->ts.u.derived->name); else - sprintf (name, "tmp$type$%s", c->ts.u.derived->name); + sprintf (name, "__tmp_type_%s", c->ts.u.derived->name); st = gfc_find_symtree (ns->sym_root, name); gcc_assert (st->n.sym->assoc); st->n.sym->assoc->target = gfc_get_variable_expr (code->expr1->symtree); if (c->ts.type == BT_DERIVED) - gfc_add_component_ref (st->n.sym->assoc->target, "$data"); + gfc_add_data_component (st->n.sym->assoc->target); new_st = gfc_get_code (); new_st->op = EXEC_BLOCK; @@ -7880,7 +7880,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) /* Set up arguments. */ new_st->expr1->value.function.actual = gfc_get_actual_arglist (); new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree); - gfc_add_component_ref (new_st->expr1->value.function.actual->expr, "$vptr"); + gfc_add_vptr_component (new_st->expr1->value.function.actual->expr); vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived); st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); new_st->expr1->value.function.actual->next = gfc_get_actual_arglist (); @@ -11193,8 +11193,8 @@ resolve_fl_derived (gfc_symbol *sym) if (sym->attr.is_class && sym->ts.u.derived == NULL) { /* Fix up incomplete CLASS symbols. */ - gfc_component *data = gfc_find_component (sym, "$data", true, true); - gfc_component *vptr = gfc_find_component (sym, "$vptr", true, true); + gfc_component *data = gfc_find_component (sym, "_data", true, true); + gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true); if (vptr->ts.u.derived == NULL) { gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 47ee8fd..12330ae 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6317,7 +6317,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - /* Add reference to '$data' component. */ + /* Add reference to '_data' component. */ tmp = CLASS_DATA (c)->backend_decl; comp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), comp, tmp, NULL_TREE); @@ -6357,7 +6357,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Allocatable scalar CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - /* Add reference to '$data' component. */ + /* Add reference to '_data' component. */ tmp = CLASS_DATA (c)->backend_decl; comp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), comp, tmp, NULL_TREE); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index a94556f..3f068de 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3393,7 +3393,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) e = gfc_lval_expr_from_sym (sym); if (sym->ts.type == BT_CLASS) - gfc_add_component_ref (e, "$data"); + gfc_add_data_component (e); gfc_init_se (&se, NULL); se.want_pointer = 1; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a95b421..94dfa34 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2584,7 +2584,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, var = gfc_create_var (tmp, "class"); /* Set the vptr. */ - cmp = gfc_find_component (declared, "$vptr", true, true); + cmp = gfc_find_component (declared, "_vptr", true, true); ctree = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (cmp->backend_decl), var, cmp->backend_decl, NULL_TREE); @@ -2598,7 +2598,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, fold_convert (TREE_TYPE (ctree), tmp)); /* Now set the data field. */ - cmp = gfc_find_component (declared, "$data", true, true); + cmp = gfc_find_component (declared, "_data", true, true); ctree = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (cmp->backend_decl), var, cmp->backend_decl, NULL_TREE); @@ -4504,13 +4504,13 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) if (!c->expr || cm->attr.allocatable) continue; - if (strcmp (cm->name, "$size") == 0) + if (strcmp (cm->name, "_size") == 0) { val = TYPE_SIZE_UNIT (gfc_get_derived_type (cm->ts.u.derived)); CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); } else if (cm->initializer && cm->initializer->expr_type != EXPR_NULL - && strcmp (cm->name, "$extends") == 0) + && strcmp (cm->name, "_extends") == 0) { tree vtab; gfc_symbol *vtabs; @@ -5875,15 +5875,15 @@ gfc_trans_class_init_assign (gfc_code *code) gfc_start_block (&block); lhs = gfc_copy_expr (code->expr1); - gfc_add_component_ref (lhs, "$data"); + gfc_add_data_component (lhs); rhs = gfc_copy_expr (code->expr1); - gfc_add_component_ref (rhs, "$vptr"); - gfc_add_component_ref (rhs, "$def_init"); + gfc_add_vptr_component (rhs); + gfc_add_def_init_component (rhs); sz = gfc_copy_expr (code->expr1); - gfc_add_component_ref (sz, "$vptr"); - gfc_add_component_ref (sz, "$size"); + gfc_add_vptr_component (sz); + gfc_add_size_component (sz); gfc_init_se (&dst, NULL); gfc_init_se (&src, NULL); @@ -5914,9 +5914,9 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op) if (expr2->ts.type != BT_CLASS) { - /* Insert an additional assignment which sets the '$vptr' field. */ + /* Insert an additional assignment which sets the '_vptr' field. */ lhs = gfc_copy_expr (expr1); - gfc_add_component_ref (lhs, "$vptr"); + gfc_add_vptr_component (lhs); if (expr2->ts.type == BT_DERIVED) { gfc_symbol *vtab; @@ -5945,7 +5945,7 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op) if (expr2->ts.type == BT_CLASS) op = EXEC_ASSIGN; else - gfc_add_component_ref (expr1, "$data"); + gfc_add_data_component (expr1); if (op == EXEC_ASSIGN) tmp = gfc_trans_assignment (expr1, expr2, false, true); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 5a0a43e..502a8153 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4547,7 +4547,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) if (ss == gfc_ss_terminator) { if (arg->ts.type == BT_CLASS) - gfc_add_component_ref (arg, "$data"); + gfc_add_data_component (arg); gfc_conv_expr_reference (&argse, arg); @@ -4618,8 +4618,8 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) { if (arg->ts.type == BT_CLASS) { - gfc_add_component_ref (arg, "$vptr"); - gfc_add_component_ref (arg, "$size"); + gfc_add_vptr_component (arg); + gfc_add_size_component (arg); gfc_conv_expr (&argse, arg); tmp = fold_convert (result_type, argse.expr); goto done; @@ -5070,7 +5070,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) /* Allocatable scalar. */ arg1se.want_pointer = 1; if (arg1->expr->ts.type == BT_CLASS) - gfc_add_component_ref (arg1->expr, "$data"); + gfc_add_data_component (arg1->expr); gfc_conv_expr (&arg1se, arg1->expr); tmp = arg1se.expr; } @@ -5111,7 +5111,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_init_se (&arg2se, NULL); arg1 = expr->value.function.actual; if (arg1->expr->ts.type == BT_CLASS) - gfc_add_component_ref (arg1->expr, "$data"); + gfc_add_data_component (arg1->expr); arg2 = arg1->next; ss1 = gfc_walk_expr (arg1->expr); @@ -5141,7 +5141,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) { /* An optional target. */ if (arg2->expr->ts.type == BT_CLASS) - gfc_add_component_ref (arg2->expr, "$data"); + gfc_add_data_component (arg2->expr); ss2 = gfc_walk_expr (arg2->expr); nonzero_charlen = NULL_TREE; @@ -5228,8 +5228,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) if (a->ts.type == BT_CLASS) { - gfc_add_component_ref (a, "$vptr"); - gfc_add_component_ref (a, "$hash"); + gfc_add_vptr_component (a); + gfc_add_hash_component (a); } else if (a->ts.type == BT_DERIVED) a = gfc_get_int_expr (gfc_default_integer_kind, NULL, @@ -5237,8 +5237,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) if (b->ts.type == BT_CLASS) { - gfc_add_component_ref (b, "$vptr"); - gfc_add_component_ref (b, "$hash"); + gfc_add_vptr_component (b); + gfc_add_hash_component (b); } else if (b->ts.type == BT_DERIVED) b = gfc_get_int_expr (gfc_default_integer_kind, NULL, diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index d075ac8..1fd4254 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4388,7 +4388,7 @@ gfc_trans_allocate (gfc_code * code) expr = gfc_copy_expr (al->expr); if (expr->ts.type == BT_CLASS) - gfc_add_component_ref (expr, "$data"); + gfc_add_data_component (expr); gfc_init_se (&se, NULL); gfc_start_block (&se.pre); @@ -4409,8 +4409,8 @@ gfc_trans_allocate (gfc_code * code) gfc_expr *sz; gfc_se se_sz; sz = gfc_copy_expr (code->expr3); - gfc_add_component_ref (sz, "$vptr"); - gfc_add_component_ref (sz, "$size"); + gfc_add_vptr_component (sz); + gfc_add_size_component (sz); gfc_init_se (&se_sz, NULL); gfc_conv_expr (&se_sz, sz); gfc_free_expr (sz); @@ -4497,18 +4497,18 @@ gfc_trans_allocate (gfc_code * code) actual = gfc_get_actual_arglist (); actual->expr = gfc_copy_expr (rhs); if (rhs->ts.type == BT_CLASS) - gfc_add_component_ref (actual->expr, "$data"); + gfc_add_data_component (actual->expr); actual->next = gfc_get_actual_arglist (); actual->next->expr = gfc_copy_expr (al->expr); - gfc_add_component_ref (actual->next->expr, "$data"); + gfc_add_data_component (actual->next->expr); if (rhs->ts.type == BT_CLASS) { ppc = gfc_copy_expr (rhs); - gfc_add_component_ref (ppc, "$vptr"); + gfc_add_vptr_component (ppc); } else ppc = gfc_lval_expr_from_sym (gfc_find_derived_vtab (rhs->ts.u.derived)); - gfc_add_component_ref (ppc, "$copy"); + gfc_add_component_ref (ppc, "_copy"); gfc_conv_procedure_call (&call, ppc->symtree->n.sym, actual, ppc, NULL); gfc_add_expr_to_block (&call.pre, call.expr); @@ -4527,8 +4527,8 @@ gfc_trans_allocate (gfc_code * code) /* Default-initialization via MOLD (polymorphic). */ gfc_expr *rhs = gfc_copy_expr (code->expr3); gfc_se dst,src; - gfc_add_component_ref (rhs, "$vptr"); - gfc_add_component_ref (rhs, "$def_init"); + gfc_add_vptr_component (rhs); + gfc_add_def_init_component (rhs); gfc_init_se (&dst, NULL); gfc_init_se (&src, NULL); gfc_conv_expr (&dst, expr); @@ -4549,13 +4549,13 @@ gfc_trans_allocate (gfc_code * code) /* Initialize VPTR for CLASS objects. */ lhs = gfc_expr_to_initialize (expr); - gfc_add_component_ref (lhs, "$vptr"); + gfc_add_vptr_component (lhs); rhs = NULL; if (code->expr3 && code->expr3->ts.type == BT_CLASS) { /* Polymorphic SOURCE: VPTR must be determined at run time. */ rhs = gfc_copy_expr (code->expr3); - gfc_add_component_ref (rhs, "$vptr"); + gfc_add_vptr_component (rhs); tmp = gfc_trans_pointer_assignment (lhs, rhs); gfc_add_expr_to_block (&block, tmp); gfc_free_expr (rhs); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c4fa079..f8c121e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-11-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/46313 + * gfortran.dg/class_29.f03: New. + 2010-11-09 Richard Guenther <rguenther@suse.de> PR middle-end/46221 diff --git a/gcc/testsuite/gfortran.dg/class_29.f03 b/gcc/testsuite/gfortran.dg/class_29.f03 new file mode 100644 index 0000000..d5ed8fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_29.f03 @@ -0,0 +1,34 @@ +! { dg-do compile } +! +! PR 46313: [OOP] OOP-ABI issue, ALLOCATE issue, CLASS renaming issue +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + +module m1 + type mytype + real :: a(10) = 2 + end type +end module m1 + +module m2 + type mytype + real :: b(10) = 8 + end type +end module m2 + +program p +use m1, t1 => mytype +use m2, t2 => mytype +implicit none + +class(t1), allocatable :: x +class(t2), allocatable :: y + +allocate (t1 :: x) +allocate (t2 :: y) + +print *, x%a +print *, y%b +end + +! { dg-final { cleanup-modules "m1 m2" } } |