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;

Reply via email to