Commit d44d2f9a by Janus Weil

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
parent ef7e0035
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,66 +5606,27 @@ void gfc_trans_assign_vtab_procs (stmtblock_t *block, gfc_symbol *dt, ...@@ -5606,66 +5606,27 @@ 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);
seen_extends = (cmp != NULL);
vtb = gfc_get_symbol_decl (vtab);
if (seen_extends)
{
cmp = cmp->next; cmp = cmp->next;
if (!cmp) if (!cmp)
return; return;
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
vtb, cmp->backend_decl, NULL_TREE); vtb = gfc_get_symbol_decl (vtab);
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, cond = fold_build2 (EQ_EXPR, boolean_type_node, ctree,
build_int_cst (TREE_TYPE (ctree), 0)); 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
added to the vtype, which remains "empty". */ added to the vtype, which remains "empty". */
...@@ -5691,7 +5652,6 @@ void gfc_trans_assign_vtab_procs (stmtblock_t *block, gfc_symbol *dt, ...@@ -5691,7 +5652,6 @@ 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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment