Re: [Patch, Fortran, committed] PR 78592: [7 Regression] ICE in gfc_find_specific_dtio_proc, at fortran/interface.c:4939

[Janus Weil]

Hi Mikael,

>> 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.

thanks for the comment, and sorry that I didn't notice this problem.

The attached patch should fix it. What do you think about it?

Btw, with trunk r243776 I get an ICE on your test case, when the
module procedure is commented out. You don't see this?

Cheers,
Janus




> 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 243776)
+++ gcc/fortran/interface.c     (working copy)
@@ -4949,17 +4949,19 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived,
          && tb_io_st->n.sym->generic)
        {
          for (gfc_interface *intr = tb_io_st->n.sym->generic;
-              intr && intr->sym && intr->sym->formal;
-              intr = intr->next)
+              intr && intr->sym; intr = intr->next)
            {
-             gfc_symbol *fsym = intr->sym->formal->sym;
-             if ((fsym->ts.type == BT_CLASS
-                  && CLASS_DATA (fsym)->ts.u.derived == extended)
-                 || (fsym->ts.type == BT_DERIVED
-                     && fsym->ts.u.derived == extended))
+             if (intr->sym->formal)
                {
-                 dtio_sub = intr->sym;
-                 break;
+                 gfc_symbol *fsym = intr->sym->formal->sym;
+                 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;
+                   }
                }
            }
        }