aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJanus Weil <janus@gcc.gnu.org>2010-11-09 11:39:46 +0100
committerJanus Weil <janus@gcc.gnu.org>2010-11-09 11:39:46 +0100
commitb04533af33ccf91e2874b24dd3e678d195c83587 (patch)
tree14d1f54316ef0bc517c72a674952cb7d233fd288 /gcc
parent6496e42f8734797b1a5613585c47e51398419547 (diff)
downloadgcc-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/ChangeLog29
-rw-r--r--gcc/fortran/class.c91
-rw-r--r--gcc/fortran/decl.c4
-rw-r--r--gcc/fortran/gfortran.h5
-rw-r--r--gcc/fortran/iresolve.c4
-rw-r--r--gcc/fortran/match.c4
-rw-r--r--gcc/fortran/module.c4
-rw-r--r--gcc/fortran/resolve.c40
-rw-r--r--gcc/fortran/trans-array.c4
-rw-r--r--gcc/fortran/trans-decl.c2
-rw-r--r--gcc/fortran/trans-expr.c24
-rw-r--r--gcc/fortran/trans-intrinsic.c20
-rw-r--r--gcc/fortran/trans-stmt.c22
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/class_29.f0334
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, &copy);
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, &current_attr,&var_locus)
+ if (gfc_copy_attr (&CLASS_DATA (sym)->attr, &current_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" } }