[Patch, fortran] PR30236 - alternate-return subroutine in generic interface causes ice/segfault

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This patch fixes a segfault that is triggered by alternate returns in 
generic interfaces.  The fix is self-explanatory and the testcase is the 
reviewer's.

A wrinkle here is whether or not this is valid fortran.  Most compilers 
that I have access to seem to quietly compile this..... well, noisily, 
actually, since they complain about the obsolescent feature, but compile 
it they do.  However, in the thread on comp.lang.fortran;
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/5f5079d3fe7e534a/846f950fdb70767f#846f950fdb70767f
Michael Metcalf offers the advice that this is invalid because the 
alternate returns are not data object arguments and should not be counted.

Brooks, as reporter and correspondent on the fortran thread, what do you 
think?  Is this a -std=gnu or unconditionally an error?

Other than this, the patch clears the problem and the testcase behaves 
"correctly" if run.

Regtested on ia64/FC5 - OK for trunk and for 4.2, subject to adjustment 
according to the standard or validity?

Paul


2006-12-18  Paul Thomas <pault@gcc.gnu.org>

	PR fortran/30236
	* interface.c (compare_interfaces): Handle NULL symbols.
	(count_types_test): Count NULL symbols, which correspond to
	alternate returns.

2006-12-18  Paul Thomas <pault@gcc.gnu.org>

	PR fortran/30236
	* gfortran.dg/generic_11.f90: New test.

Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(revision 120001)
--- gcc/fortran/interface.c	(working copy)
*************** static int compare_interfaces (gfc_symbo
*** 443,448 ****
--- 443,450 ----
  static int
  compare_type_rank_if (gfc_symbol * s1, gfc_symbol * s2)
  {
+   if (s1 == NULL || s2 == NULL)
+     return s1 == s2 ? 1 : 0;
  
    if (s1->attr.flavor != FL_PROCEDURE && s2->attr.flavor != FL_PROCEDURE)
      return compare_type_rank (s1, s2);
*************** count_types_test (gfc_formal_arglist * f
*** 731,744 ****
        if (arg[i].flag != -1)
  	continue;
  
!       if (arg[i].sym->attr.optional)
  	continue;		/* Skip optional arguments */
  
        arg[i].flag = k;
  
        /* Find other nonoptional arguments of the same type/rank.  */
        for (j = i + 1; j < n1; j++)
! 	if (!arg[j].sym->attr.optional
  	    && compare_type_rank_if (arg[i].sym, arg[j].sym))
  	  arg[j].flag = k;
  
--- 733,746 ----
        if (arg[i].flag != -1)
  	continue;
  
!       if (arg[i].sym && arg[i].sym->attr.optional)
  	continue;		/* Skip optional arguments */
  
        arg[i].flag = k;
  
        /* Find other nonoptional arguments of the same type/rank.  */
        for (j = i + 1; j < n1; j++)
! 	if ((arg[j].sym == NULL || !arg[j].sym->attr.optional)
  	    && compare_type_rank_if (arg[i].sym, arg[j].sym))
  	  arg[j].flag = k;
  
Index: gcc/testsuite/gfortran.dg/generic_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_11.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/generic_11.f90	(revision 0)
***************
*** 0 ****
--- 1,39 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR30236, which was due to alternate returns
+ ! in generic interfaces causing a segfault.  They now work
+ ! correctly.
+ !
+ ! Contributed by Brooks Moses <brooks@gcc.gnu.org>
+ !
+ module arswitch
+   implicit none
+   interface gen
+     module procedure with
+     module procedure without
+   end interface
+ contains
+   subroutine with(i,*)
+     integer i
+     if (i>0) then
+       return 1
+     else
+       return
+     end if
+   end subroutine
+   subroutine without()
+     return
+   end subroutine
+ end module
+ 
+ program test
+   use arswitch
+   implicit none
+   integer :: i = 0
+  10 continue
+   call with (i, *20)
+   print *, " looping with i = ", i
+   i = 2
+   goto 10
+  20 print *, " leaving with i = ", i
+ end
+ ! { dg-final { cleanup-modules "arswitch" } }