trans-expr.c (gfc_trans_assign_vtab_procs): Clean up (we don't have vtabs for generics any more).
2010-08-15 Janus Weil <janus@gcc.gnu.org> * trans-expr.c (gfc_trans_assign_vtab_procs): Clean up (we don't have vtabs for generics any more). From-SVN: r163270
This commit is contained in:
parent
ef7e003500
commit
d44d2f9a97
|
@ -1,3 +1,8 @@
|
||||||
|
2010-08-15 Janus Weil <janus@gcc.gnu.org>
|
||||||
|
|
||||||
|
* trans-expr.c (gfc_trans_assign_vtab_procs): Clean up (we don't have
|
||||||
|
vtabs for generics any more).
|
||||||
|
|
||||||
2010-08-15 Daniel Kraft <d@domob.eu>
|
2010-08-15 Daniel Kraft <d@domob.eu>
|
||||||
|
|
||||||
PR fortran/38936
|
PR fortran/38936
|
||||||
|
|
|
@ -5606,65 +5606,26 @@ void gfc_trans_assign_vtab_procs (stmtblock_t *block, gfc_symbol *dt,
|
||||||
gfc_symbol *vtab)
|
gfc_symbol *vtab)
|
||||||
{
|
{
|
||||||
gfc_component *cmp;
|
gfc_component *cmp;
|
||||||
tree vtb;
|
tree vtb, ctree, proc, cond = NULL_TREE;
|
||||||
tree ctree;
|
|
||||||
tree proc;
|
|
||||||
tree cond = NULL_TREE;
|
|
||||||
stmtblock_t body;
|
stmtblock_t body;
|
||||||
bool seen_extends;
|
|
||||||
|
|
||||||
/* Point to the first procedure pointer. */
|
/* Point to the first procedure pointer. */
|
||||||
cmp = gfc_find_component (vtab->ts.u.derived, "$extends", true, true);
|
cmp = gfc_find_component (vtab->ts.u.derived, "$extends", true, true);
|
||||||
|
cmp = cmp->next;
|
||||||
seen_extends = (cmp != NULL);
|
if (!cmp)
|
||||||
|
return;
|
||||||
|
|
||||||
vtb = gfc_get_symbol_decl (vtab);
|
vtb = gfc_get_symbol_decl (vtab);
|
||||||
|
|
||||||
if (seen_extends)
|
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl), vtb,
|
||||||
{
|
cmp->backend_decl, NULL_TREE);
|
||||||
cmp = cmp->next;
|
cond = fold_build2 (EQ_EXPR, boolean_type_node, ctree,
|
||||||
if (!cmp)
|
build_int_cst (TREE_TYPE (ctree), 0));
|
||||||
return;
|
|
||||||
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
|
|
||||||
vtb, cmp->backend_decl, NULL_TREE);
|
|
||||||
cond = fold_build2 (EQ_EXPR, boolean_type_node, ctree,
|
|
||||||
build_int_cst (TREE_TYPE (ctree), 0));
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
cmp = vtab->ts.u.derived->components;
|
|
||||||
}
|
|
||||||
|
|
||||||
gfc_init_block (&body);
|
gfc_init_block (&body);
|
||||||
for (; cmp; cmp = cmp->next)
|
for (; cmp; cmp = cmp->next)
|
||||||
{
|
{
|
||||||
gfc_symbol *target = NULL;
|
gfc_symbol *target = NULL;
|
||||||
|
|
||||||
/* Generic procedure - build its vtab. */
|
|
||||||
if (cmp->ts.type == BT_DERIVED && !cmp->tb)
|
|
||||||
{
|
|
||||||
gfc_symbol *vt = cmp->ts.interface;
|
|
||||||
|
|
||||||
if (vt == NULL)
|
|
||||||
{
|
|
||||||
/* Use association loses the interface. Obtain the vtab
|
|
||||||
by name instead. */
|
|
||||||
char name[2 * GFC_MAX_SYMBOL_LEN + 8];
|
|
||||||
sprintf (name, "vtab$%s$%s", vtab->ts.u.derived->name,
|
|
||||||
cmp->name);
|
|
||||||
gfc_find_symbol (name, vtab->ns, 0, &vt);
|
|
||||||
if (vt == NULL)
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
|
|
||||||
gfc_trans_assign_vtab_procs (&body, dt, vt);
|
|
||||||
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
|
|
||||||
vtb, cmp->backend_decl, NULL_TREE);
|
|
||||||
proc = gfc_get_symbol_decl (vt);
|
|
||||||
proc = gfc_build_addr_expr (TREE_TYPE (ctree), proc);
|
|
||||||
gfc_add_modify (&body, ctree, proc);
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* This is required when typebound generic procedures are called
|
/* This is required when typebound generic procedures are called
|
||||||
with derived type targets. The specific procedures do not get
|
with derived type targets. The specific procedures do not get
|
||||||
|
@ -5691,8 +5652,7 @@ void gfc_trans_assign_vtab_procs (stmtblock_t *block, gfc_symbol *dt,
|
||||||
|
|
||||||
proc = gfc_finish_block (&body);
|
proc = gfc_finish_block (&body);
|
||||||
|
|
||||||
if (seen_extends)
|
proc = build3_v (COND_EXPR, cond, proc, build_empty_stmt (input_location));
|
||||||
proc = build3_v (COND_EXPR, cond, proc, build_empty_stmt (input_location));
|
|
||||||
|
|
||||||
gfc_add_expr_to_block (block, proc);
|
gfc_add_expr_to_block (block, proc);
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue