| Message ID | CAKwh3qhVz2=y=wsQiZwcpJnVnScy_m9nn1B6aRg9kS2Qjf0GJw@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
Hello, Le 30/11/2016 à 10:52, Janus Weil a écrit : > Hi all, > > I have just committed a completely obvious patch for this PR. All it > does is rearrange some expressions to avoid an ICE (see attachment): > I have made a late review of it, and I think it’s not as innocent as it seems. With it, if the first element’s formal is not properly set, the rest of the generic linked list is ignored. Here is a variant of the testcase committed. It shows no error if the module procedure line is commented, and two errors if it’s uncommented, one error saying that the write of z2 should use DTIO. The latter error should not appear. program p type t end type type(t) :: z type, extends(t) :: t2 end type class(t2), allocatable :: z2 interface write(formatted) procedure wf2 module procedure wf ! error end interface print *, z allocate(z2) print *, z2 ! spurious error contains subroutine wf2(this, a, b, c, d, e) class(t2), intent(in) :: this integer, intent(in) :: a character, intent(in) :: b integer, intent(in) :: c(:) integer, intent(out) :: d character, intent(inout) :: e end subroutine wf2 end > > pr78592.diff > > Index: gcc/fortran/interface.c > =================================================================== > --- gcc/fortran/interface.c (revision 243004) > +++ gcc/fortran/interface.c (working copy) > @@ -4933,15 +4933,15 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, > && tb_io_st->n.sym > && tb_io_st->n.sym->generic) > { > - gfc_interface *intr; > - for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next) > + for (gfc_interface *intr = tb_io_st->n.sym->generic; > + intr && intr->sym && intr->sym->formal; > + intr = intr->next) > { > gfc_symbol *fsym = intr->sym->formal->sym; > - if (intr->sym && intr->sym->formal > - && ((fsym->ts.type == BT_CLASS > - && CLASS_DATA (fsym)->ts.u.derived == extended) > - || (fsym->ts.type == BT_DERIVED > - && fsym->ts.u.derived == extended))) > + if ((fsym->ts.type == BT_CLASS > + && CLASS_DATA (fsym)->ts.u.derived == extended) > + || (fsym->ts.type == BT_DERIVED > + && fsym->ts.u.derived == extended)) > { > dtio_sub = intr->sym; > break;
Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 243004) +++ gcc/fortran/interface.c (working copy) @@ -4933,15 +4933,15 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, && tb_io_st->n.sym && tb_io_st->n.sym->generic) { - gfc_interface *intr; - for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next) + for (gfc_interface *intr = tb_io_st->n.sym->generic; + intr && intr->sym && intr->sym->formal; + intr = intr->next) { gfc_symbol *fsym = intr->sym->formal->sym; - if (intr->sym && intr->sym->formal - && ((fsym->ts.type == BT_CLASS - && CLASS_DATA (fsym)->ts.u.derived == extended) - || (fsym->ts.type == BT_DERIVED - && fsym->ts.u.derived == extended))) + if ((fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->ts.u.derived == extended) + || (fsym->ts.type == BT_DERIVED + && fsym->ts.u.derived == extended)) { dtio_sub = intr->sym; break; Index: gcc/testsuite/gfortran.dg/dtio_18.f90 =================================================================== --- gcc/testsuite/gfortran.dg/dtio_18.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/dtio_18.f90 (working copy) @@ -0,0 +1,15 @@ +! { dg-do compile } +! +! PR 78592: [7 Regression] ICE in gfc_find_specific_dtio_proc, at fortran/interface.c:4939 +! +! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de> + +program p + type t + end type + type(t) :: z + interface write(formatted) + module procedure wf ! { dg-error "is neither function nor subroutine" } + end interface + print *, z +end