[Patch, fortran] PR78737 - [OOP] linking error with deferred, undefined user-defined derived-type I/O
Paul Richard Thomas
paul.richard.thomas@gmail.com
Tue Dec 13 09:08:00 GMT 2016
Dear Janus,
To make amends for what I can only describe as a brainstorm :-) ,
please find attached a version of your patch that runs all the dtio
testcases successfully.
I have even written a code that made extensive use of dynamic dispatch
of generic typebound procedures... I can't imagine what I have been
thinking.
Cheers
Paul
On 13 December 2016 at 06:33, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Janus,
>
> I woke up in the middle of the night realising that not only are you
> right about the need for dynamic dispatch but that my dtio_20.f90 must
> already work.
>
> Thanks for putting me right!
>
> Paul
>
> On 13 December 2016 at 00:30, Janus Weil <janus@gcc.gnu.org> wrote:
>> Hi Paul, hi all,
>>
>> 2016-12-12 21:04 GMT+01:00 Janus Weil <janus@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.
>
>
>
> --
> If you're walking down the right path and you're willing to keep
> walking, eventually you'll make progress.
>
> Barack Obama
--
If you're walking down the right path and you're willing to keep
walking, eventually you'll make progress.
Barack Obama
-------------- next part --------------
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 243516)
--- gcc/fortran/gfortran.h (working copy)
*************** int gfc_has_vector_subscript (gfc_expr*)
*** 3251,3256 ****
--- 3251,3257 ----
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 243516)
--- gcc/fortran/interface.c (working copy)
*************** gfc_compare_interfaces (gfc_symbol *s1,
*** 1712,1719 ****
return 0;
/* Special case: alternate returns. If both f1->sym and f2->sym are
! NULL, then the leading formal arguments are alternate returns.
! The previous conditional should catch argument lists with
different number of argument. */
if (f1 && f1->sym == NULL && f2 && f2->sym == NULL)
return 1;
--- 1712,1719 ----
return 0;
/* Special case: alternate returns. If both f1->sym and f2->sym are
! NULL, then the leading formal arguments are alternate returns.
! The previous conditional should catch argument lists with
different number of argument. */
if (f1 && f1->sym == NULL && f2 && f2->sym == NULL)
return 1;
*************** gfc_check_dtio_interfaces (gfc_symbol *d
*** 4826,4838 ****
}
! 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;
bool t = false;
if (!derived || derived->attr.flavor != FL_DERIVED)
--- 4826,4835 ----
}
! gfc_symtree*
! gfc_find_typebound_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
{
gfc_symtree *tb_io_st = NULL;
bool t = false;
if (!derived || derived->attr.flavor != FL_DERIVED)
*************** gfc_find_specific_dtio_proc (gfc_symbol
*** 4869,4874 ****
--- 4866,4884 ----
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)
{
*************** gfc_find_specific_dtio_proc (gfc_symbol
*** 4903,4909 ****
for (extended = derived; extended;
extended = gfc_get_derived_super_type (extended))
{
! if (extended == NULL || extended->ns == NULL)
return NULL;
if (formatted == true)
--- 4913,4920 ----
for (extended = derived; extended;
extended = gfc_get_derived_super_type (extended))
{
! if (extended == NULL || extended->ns == NULL
! || extended->attr.flavor == FL_UNKNOWN)
return NULL;
if (formatted == true)
Index: gcc/fortran/trans-io.c
===================================================================
*** gcc/fortran/trans-io.c (revision 243516)
--- gcc/fortran/trans-io.c (working copy)
*************** get_dtio_proc (gfc_typespec * ts, gfc_co
*** 2181,2195 ****
}
if (ts->type == BT_DERIVED)
! derived = ts->u.derived;
! else
! derived = ts->u.derived->components->ts.u.derived;
! *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));
return NULL_TREE;
--- 2181,2220 ----
}
if (ts->type == BT_DERIVED)
! {
! derived = ts->u.derived;
! *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_symtree *tb_io_st;
! gfc_expr *expr;
!
! expr = gfc_find_and_cut_at_last_class_ref (code->expr1);
! gfc_add_vptr_component (expr);
!
! derived = ts->u.derived->components->ts.u.derived;
! 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);
! gfc_free_expr (expr);
! return se.expr;
! }
! gfc_free_expr (expr);
! }
return NULL_TREE;
More information about the Fortran
mailing list