[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;
>
>
-------------- next part --------------
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;
+		    }
 		}
 	    }
 	}