Hi Paul, hi all,
2016-12-12 21:04 GMT+01:00 Janus Weil <ja...@gcc.gnu.org>:
> As commented several times in bugzilla, my feeling is that the
> solution for this PR would be to utilize the vtable machinery, in
> order to generate a truly polymorphic call to the DTIO procedure.
in order to elaborate what I have in mind, I'm attaching a draft patch
which implements polymorphic DTIO in the most straightforward manner I
could come up with. I have not regtested it yet, but at least it
removes the link failure on comment 0 and 6 in the PR and most
importantly it generates the correct output for comment 18, which none
of the previous attempts have accomplished.
I'd be grateful for any comments, in particular whether I'm on the
right track here or whether I'm misinterpreting the F03 standard in
any way ...
(Btw, it seems that Paul's dtio_20.f90 works already on current trunk,
so it's not very well suited to test for the problem at hand.)
Cheers,
Janus
PS: A quick check of the dtio_* tests shows ICEs on dtio_7.f90 and
dtio_13.f90. I'll look into those tomorrow.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 243580)
+++ gcc/fortran/gfortran.h (working copy)
@@ -3252,6 +3252,7 @@ int gfc_has_vector_subscript (gfc_expr*);
gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
void gfc_check_dtio_interfaces (gfc_symbol*);
+gfc_symtree* gfc_find_typebound_dtio_proc (gfc_symbol *, bool, bool);
gfc_symbol* gfc_find_specific_dtio_proc (gfc_symbol*, bool, bool);
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 243580)
+++ gcc/fortran/interface.c (working copy)
@@ -4826,13 +4826,10 @@ gfc_check_dtio_interfaces (gfc_symbol *derived)
}
-gfc_symbol *
-gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
+gfc_symtree*
+gfc_find_typebound_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
{
gfc_symtree *tb_io_st = NULL;
- gfc_symbol *dtio_sub = NULL;
- gfc_symbol *extended;
- gfc_typebound_proc *tb_io_proc, *specific_proc;
bool t = false;
if (!derived || derived->attr.flavor != FL_DERIVED)
@@ -4869,7 +4866,20 @@ gfc_check_dtio_interfaces (gfc_symbol *derived)
true,
&derived->declared_at);
}
+ return tb_io_st;
+}
+
+gfc_symbol *
+gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
+{
+ gfc_symtree *tb_io_st = NULL;
+ gfc_symbol *dtio_sub = NULL;
+ gfc_symbol *extended;
+ gfc_typebound_proc *tb_io_proc, *specific_proc;
+
+ tb_io_st = gfc_find_typebound_dtio_proc (derived, write, formatted);
+
if (tb_io_st != NULL)
{
const char *genname;
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (revision 243580)
+++ gcc/fortran/trans-io.c (working copy)
@@ -2181,16 +2181,36 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code,
}
if (ts->type == BT_DERIVED)
- derived = ts->u.derived;
- else
- derived = ts->u.derived->components->ts.u.derived;
+ {
+ derived = ts->u.derived;
+ *dtio_sub = gfc_find_specific_dtio_proc (derived, last_dt == WRITE,
+ formatted);
- *dtio_sub = gfc_find_specific_dtio_proc (derived, last_dt == WRITE,
- formatted);
+ if (*dtio_sub)
+ return gfc_build_addr_expr (NULL, gfc_get_symbol_decl (*dtio_sub));
+ }
+ else if (ts->type == BT_CLASS)
+ {
+ gfc_expr *expr = gfc_copy_expr(code->expr1);
+ gfc_add_vptr_component (expr);
- if (*dtio_sub)
- return gfc_build_addr_expr (NULL, gfc_get_symbol_decl (*dtio_sub));
+ derived = ts->u.derived->components->ts.u.derived;
+ gfc_symtree *tb_io_st = gfc_find_typebound_dtio_proc (derived,
+ last_dt == WRITE, formatted);
+ if (tb_io_st)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ se.want_pointer = 1;
+ gfc_add_component_ref (expr,
+ tb_io_st->n.tb->u.generic->specific_st->name);
+ *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym;
+ gfc_conv_expr (&se, expr);
+ return se.expr;
+ }
+ }
+
return NULL_TREE;
}
