re PR fortran/77406 (ICE in generic_correspondence, at fortran/interface.c:1123)

2016-10-07  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77406
	* interface.c (gfc_compare_interfaces): Fix detection of ambiguous
	interface involving alternate return.
	(check_interface1): Improve error message and loci.

2016-10-07  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77406
	* gfortran.dg/pr77406.f90: New test.
	* gfortran.dg/assumed_type_3.f90: Update error messages.
	* gfortran.dg/defined_operators_1.f90: Ditto.
	* gfortran.dg/generic_26.f90: Ditto.
	* gfortran.dg/generic_7.f90: Ditto.
	* gfortran.dg/gomp/udr5.f90: Ditto.
	* gfortran.dg/gomp/udr7.f90: Ditto.
	* gfortran.dg/interface_1.f90: Ditto.
	* gfortran.dg/interface_37.f90: Ditto.
	* gfortran.dg/interface_5.f90: Ditto.
	* gfortran.dg/interface_6.f90: Ditto.
	* gfortran.dg/interface_7.f90
	* gfortran.dg/no_arg_check_3.f90
	* gfortran.dg/operator_5.f90
	* gfortran.dg/proc_ptr_comp_20.f90: Ditto.

From-SVN: r240870

18 files changed, 122 insertions, 50 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2b1b85c..50a0d42 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-07  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/77406
+	* interface.c (gfc_compare_interfaces): Fix detection of ambiguous
+	interface involving alternate return.
+	(check_interface1): Improve error message and loci.
+
 2016-10-06  Louis Krupp  <louis.krupp@zoho.com>
 
 	PR fortran/69955
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index e7f1878..2a9af0f 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1689,14 +1689,23 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
   f1 = gfc_sym_get_dummy_args (s1);
   f2 = gfc_sym_get_dummy_args (s2);
 
+  /* Special case: No arguments.  */
   if (f1 == NULL && f2 == NULL)
-    return 1;			/* Special case: No arguments.  */
+    return 1;
 
   if (generic_flag)
     {
       if (count_types_test (f1, f2, p1, p2)
 	  || count_types_test (f2, f1, p2, p1))
 	return 0;
+
+      /* Special case: alternate returns.  If both f1->sym and f2->sym are
+	 NULL, then the leading formal arguments are alternate returns.  
+	 The previous conditional should catch argument lists with 
+	 different number of argument.  */
+      if (f1 && f1->sym == NULL && f2 && f2->sym == NULL)
+	return 1;
+
       if (generic_correspondence (f1, f2, p1, p2)
 	  || generic_correspondence (f2, f1, p2, p1))
 	return 0;
@@ -1864,13 +1873,15 @@ check_interface1 (gfc_interface *p, gfc_interface *q0,
 				       generic_flag, 0, NULL, 0, NULL, NULL))
 	  {
 	    if (referenced)
-	      gfc_error ("Ambiguous interfaces %qs and %qs in %s at %L",
-			 p->sym->name, q->sym->name, interface_name,
-			 &p->where);
+	      gfc_error ("Ambiguous interfaces in %s for %qs at %L "
+			 "and %qs at %L", interface_name,
+			 q->sym->name, &q->sym->declared_at,
+			 p->sym->name, &p->sym->declared_at);
 	    else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
-	      gfc_warning (0, "Ambiguous interfaces %qs and %qs in %s at %L",
-			   p->sym->name, q->sym->name, interface_name,
-			   &p->where);
+	      gfc_warning (0, "Ambiguous interfaces in %s for %qs at %L "
+			 "and %qs at %L", interface_name,
+			 q->sym->name, &q->sym->declared_at,
+			 p->sym->name, &p->sym->declared_at);
 	    else
 	      gfc_warning (0, "Although not referenced, %qs has ambiguous "
 			   "interfaces at %L", interface_name, &p->where);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fd69779..a0fedff 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,22 @@
+2016-10-07  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/77406
+	* gfortran.dg/pr77406.f90: New test.
+	* gfortran.dg/assumed_type_3.f90: Update error messages.
+	* gfortran.dg/defined_operators_1.f90: Ditto.
+	* gfortran.dg/generic_26.f90: Ditto.
+	* gfortran.dg/generic_7.f90: Ditto.
+	* gfortran.dg/gomp/udr5.f90: Ditto.
+	* gfortran.dg/gomp/udr7.f90: Ditto.
+	* gfortran.dg/interface_1.f90: Ditto.
+	* gfortran.dg/interface_37.f90: Ditto.
+	* gfortran.dg/interface_5.f90: Ditto.
+	* gfortran.dg/interface_6.f90: Ditto.
+	* gfortran.dg/interface_7.f90
+	* gfortran.dg/no_arg_check_3.f90
+	* gfortran.dg/operator_5.f90
+	* gfortran.dg/proc_ptr_comp_20.f90: Ditto.
+
 2016-10-07  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
 	PR c++/77700
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_3.f90 b/gcc/testsuite/gfortran.dg/assumed_type_3.f90
index e5bff50..38f924d 100644
--- a/gcc/testsuite/gfortran.dg/assumed_type_3.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_type_3.f90
@@ -66,12 +66,12 @@ subroutine nine()
     end subroutine okok2
   end interface
   interface three
-    subroutine ambig1(x)
+    subroutine ambig1(x) ! { dg-error "Ambiguous interfaces" }
       type(*) :: x
     end subroutine ambig1
-    subroutine ambig2(x)
+    subroutine ambig2(x) ! { dg-error "Ambiguous interfaces" }
       integer :: x
-    end subroutine ambig2 ! { dg-error "Ambiguous interfaces 'ambig2' and 'ambig1' in generic interface 'three'" }
+    end subroutine ambig2
   end interface
 end subroutine nine
 
diff --git a/gcc/testsuite/gfortran.dg/defined_operators_1.f90 b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
index 9d99018..af8dd16 100644
--- a/gcc/testsuite/gfortran.dg/defined_operators_1.f90
+++ b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
@@ -11,7 +11,7 @@ module mymod
      module procedure foo_1
      module procedure foo_2
      module procedure foo_3
-     module procedure foo_1_OK  ! { dg-error "Ambiguous interfaces" }
+     module procedure foo_1_OK
      module procedure foo_2_OK
      function foo_chr (chr) ! { dg-error "cannot be assumed character length" }
        character(*) :: foo_chr
@@ -37,12 +37,12 @@ contains
     integer :: foo_1
     foo_0 = 1
   end function foo_0
-  function foo_1 (a) ! { dg-error "must be INTENT" }
+  function foo_1 (a) ! { dg-error "Ambiguous interfaces" }
     integer :: foo_1
-    integer :: a
+    integer, intent(in) :: a
     foo_1 = 1
   end function foo_1
-  function foo_1_OK (a)
+  function foo_1_OK (a) ! { dg-error "Ambiguous interfaces" }
     integer :: foo_1_OK
     integer, intent (in) :: a
     foo_1_OK = 1
@@ -65,3 +65,4 @@ contains
     foo_3 = a + 3 * b - c
   end function foo_3
 end module mymod
+
diff --git a/gcc/testsuite/gfortran.dg/generic_26.f90 b/gcc/testsuite/gfortran.dg/generic_26.f90
index a1deef1..22a593b 100644
--- a/gcc/testsuite/gfortran.dg/generic_26.f90
+++ b/gcc/testsuite/gfortran.dg/generic_26.f90
@@ -9,17 +9,17 @@ module a
 
   interface test
     procedure testAlloc
-    procedure testPtr   ! { dg-error "Ambiguous interfaces" }
+    procedure testPtr
   end interface
 
 contains
 
-  logical function testAlloc(obj)
+  logical function testAlloc(obj)    ! { dg-error "Ambiguous interfaces" }
     integer, allocatable :: obj
     testAlloc = .true.
   end function
   
-  logical function testPtr(obj)
+  logical function testPtr(obj)      ! { dg-error "Ambiguous interfaces" }
     integer, pointer :: obj
     testPtr = .false.
   end function
diff --git a/gcc/testsuite/gfortran.dg/generic_7.f90 b/gcc/testsuite/gfortran.dg/generic_7.f90
index 7b9db24..53f1753 100644
--- a/gcc/testsuite/gfortran.dg/generic_7.f90
+++ b/gcc/testsuite/gfortran.dg/generic_7.f90
@@ -7,15 +7,15 @@
 MODULE global
 INTERFACE iface
   MODULE PROCEDURE sub_a
-  MODULE PROCEDURE sub_b ! { dg-error "Ambiguous interfaces" }
+  MODULE PROCEDURE sub_b
   MODULE PROCEDURE sub_c
 END INTERFACE
 CONTAINS
-  SUBROUTINE sub_a(x)
+  SUBROUTINE sub_a(x) ! { dg-error "Ambiguous interfaces" }
     INTEGER, INTENT(in) :: x
     WRITE (*,*) 'A: ', x
   END SUBROUTINE
-  SUBROUTINE sub_b(y)
+  SUBROUTINE sub_b(y) ! { dg-error "Ambiguous interfaces" }
     INTEGER, INTENT(in) :: y
     WRITE (*,*) 'B: ', y
   END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/gomp/udr5.f90 b/gcc/testsuite/gfortran.dg/gomp/udr5.f90
index aebeee3..c10b80a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/udr5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/udr5.f90
@@ -55,5 +55,5 @@ subroutine f1
 end subroutine f1
 subroutine f2
   use udr5m3	! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
-  use udr5m2	! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" }
+  use udr5m2	! { dg-error "Ambiguous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
 end subroutine f2
diff --git a/gcc/testsuite/gfortran.dg/gomp/udr7.f90 b/gcc/testsuite/gfortran.dg/gomp/udr7.f90
index 230a3fc..50aee23 100644
--- a/gcc/testsuite/gfortran.dg/gomp/udr7.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/udr7.f90
@@ -78,7 +78,7 @@ subroutine f1
 end subroutine f1
 subroutine f2
   use udr7m3	! { dg-error "Previous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
-  use udr7m2	! { dg-error "Ambiguous !.OMP DECLARE REDUCTION" }
+  use udr7m2	! { dg-error "Ambiguous !.OMP DECLARE REDUCTION|Ambiguous interfaces" }
 end subroutine f2
 subroutine f3
   use udr7m4
diff --git a/gcc/testsuite/gfortran.dg/interface_1.f90 b/gcc/testsuite/gfortran.dg/interface_1.f90
index 3bbdd57..aa6850f 100644
--- a/gcc/testsuite/gfortran.dg/interface_1.f90
+++ b/gcc/testsuite/gfortran.dg/interface_1.f90
@@ -24,15 +24,15 @@ end module y
 
 module z
 
-  use y
+  use y    ! { dg-warning "in generic interface" }
 
   interface ambiguous
-    module procedure f    ! { dg-warning "in generic interface" "" }
+    module procedure f 
   end interface
 
   contains
 
-    real function f(a)
+    real function f(a)   ! { dg-warning "in generic interface" "" }
       real a
       f = a
     end function
diff --git a/gcc/testsuite/gfortran.dg/interface_37.f90 b/gcc/testsuite/gfortran.dg/interface_37.f90
index a39f474..99b2b7c 100644
--- a/gcc/testsuite/gfortran.dg/interface_37.f90
+++ b/gcc/testsuite/gfortran.dg/interface_37.f90
@@ -4,13 +4,13 @@
 ! Subroutine/function ambiguity in generics.
 !
      interface q
-       subroutine qr(f)
+       subroutine qr(f)  ! { dg-error "Ambiguous interfaces" }
          implicit real(f)
          external f
        end subroutine
-       subroutine qc(f)
+       subroutine qc(f)  ! { dg-error "Ambiguous interfaces" }
          implicit complex(f)
          external f
-       end subroutine ! { dg-error "Ambiguous interfaces" }
+       end subroutine
      end interface q
    end
diff --git a/gcc/testsuite/gfortran.dg/interface_5.f90 b/gcc/testsuite/gfortran.dg/interface_5.f90
index de77191..a014862 100644
--- a/gcc/testsuite/gfortran.dg/interface_5.f90
+++ b/gcc/testsuite/gfortran.dg/interface_5.f90
@@ -46,8 +46,8 @@ subroutine i_am_ok
 end subroutine i_am_ok
 
 program main
-  USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
-  USE f77_blas_generic
+  USE f77_blas_extra   ! { dg-error "Ambiguous interfaces" }
+  USE f77_blas_generic ! { dg-error "Ambiguous interfaces" }
   character(6) :: chr
   chr = ""
   call bl_copy(1.0, chr)
diff --git a/gcc/testsuite/gfortran.dg/interface_6.f90 b/gcc/testsuite/gfortran.dg/interface_6.f90
index 2e7f85a..f816529 100644
--- a/gcc/testsuite/gfortran.dg/interface_6.f90
+++ b/gcc/testsuite/gfortran.dg/interface_6.f90
@@ -7,16 +7,16 @@
 ! procedures below are invalid, even though actually unambiguous.
 !
 INTERFACE BAD8
-  SUBROUTINE S8A(X,Y,Z)
+  SUBROUTINE S8A(X,Y,Z)     ! { dg-error "Ambiguous interfaces" }
     REAL,OPTIONAL :: X
     INTEGER :: Y
     REAL :: Z
   END SUBROUTINE S8A
-  SUBROUTINE S8B(X,Z,Y)
+  SUBROUTINE S8B(X,Z,Y)     ! { dg-error "Ambiguous interfaces" }
     INTEGER,OPTIONAL :: X
     INTEGER :: Z
     REAL :: Y
-  END SUBROUTINE S8B ! { dg-error "Ambiguous interfaces" }
+  END SUBROUTINE S8B
 END INTERFACE BAD8
 real :: a, b
 integer :: i, j
diff --git a/gcc/testsuite/gfortran.dg/interface_7.f90 b/gcc/testsuite/gfortran.dg/interface_7.f90
index b3274ef..4e70f35 100644
--- a/gcc/testsuite/gfortran.dg/interface_7.f90
+++ b/gcc/testsuite/gfortran.dg/interface_7.f90
@@ -11,20 +11,20 @@ module xx
     SUBROUTINE S9A(X)
       REAL :: X
     END SUBROUTINE S9A
-    SUBROUTINE S9B(X)
+    SUBROUTINE S9B(X)     ! { dg-error "Ambiguous interfaces" }
       INTERFACE
         FUNCTION X(A)
           REAL :: X,A
         END FUNCTION X
       END INTERFACE
     END SUBROUTINE S9B
-    SUBROUTINE S9C(X)
+    SUBROUTINE S9C(X)     ! { dg-error "Ambiguous interfaces" }
       INTERFACE
         FUNCTION X(A)
           REAL :: X
           INTEGER :: A
         END FUNCTION X
       END INTERFACE
-    END SUBROUTINE S9C  ! { dg-error "Ambiguous interfaces" }
+    END SUBROUTINE S9C
   END INTERFACE BAD9
 end module xx
diff --git a/gcc/testsuite/gfortran.dg/no_arg_check_3.f90 b/gcc/testsuite/gfortran.dg/no_arg_check_3.f90
index ff176fe..3a95d0e 100644
--- a/gcc/testsuite/gfortran.dg/no_arg_check_3.f90
+++ b/gcc/testsuite/gfortran.dg/no_arg_check_3.f90
@@ -55,23 +55,23 @@ subroutine nine()
     end subroutine okay
   end interface
   interface two
-    subroutine ambig1(x)
+    subroutine ambig1(x)  ! { dg-error "Ambiguous interfaces" }
 !GCC$ attributes NO_ARG_CHECK :: x
       integer :: x
     end subroutine ambig1
-    subroutine ambig2(x)
+    subroutine ambig2(x)  ! { dg-error "Ambiguous interfaces" }
 !GCC$ attributes NO_ARG_CHECK :: x
       integer :: x(*)
-    end subroutine ambig2 ! { dg-error "Ambiguous interfaces 'ambig2' and 'ambig1' in generic interface 'two'" }
+    end subroutine ambig2
   end interface
   interface three
-    subroutine ambig3(x)
+    subroutine ambig3(x)   ! { dg-error "Ambiguous interfaces" }
 !GCC$ attributes NO_ARG_CHECK :: x
       integer :: x
     end subroutine ambig3
-    subroutine ambig4(x)
+    subroutine ambig4(x)   ! { dg-error "Ambiguous interfaces" }
       integer :: x
-    end subroutine ambig4 ! { dg-error "Ambiguous interfaces 'ambig4' and 'ambig3' in generic interface 'three'" }
+    end subroutine ambig4
   end interface
 end subroutine nine
 
diff --git a/gcc/testsuite/gfortran.dg/operator_5.f90 b/gcc/testsuite/gfortran.dg/operator_5.f90
index 307b341..02d7b22 100644
--- a/gcc/testsuite/gfortran.dg/operator_5.f90
+++ b/gcc/testsuite/gfortran.dg/operator_5.f90
@@ -16,7 +16,7 @@ MODULE mod_t
   END INTERFACE
 
   INTERFACE OPERATOR(.FOO.)
-    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+    MODULE PROCEDURE t_bar
   END INTERFACE
 
   ! intrinsic operator
@@ -29,7 +29,7 @@ MODULE mod_t
   END INTERFACE
 
   INTERFACE OPERATOR(==)
-    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+    MODULE PROCEDURE t_bar
   END INTERFACE
 
   INTERFACE OPERATOR(.eq.)
@@ -37,12 +37,12 @@ MODULE mod_t
   END INTERFACE
 
 CONTAINS
-  LOGICAL FUNCTION t_foo(this, other)
+  LOGICAL FUNCTION t_foo(this, other)  ! { dg-error "Ambiguous interfaces" }
     TYPE(t), INTENT(in) :: this, other
     t_foo = .FALSE.
   END FUNCTION
 
-  LOGICAL FUNCTION t_bar(this, other)
+  LOGICAL FUNCTION t_bar(this, other)  ! { dg-error "Ambiguous interfaces" }
     TYPE(t), INTENT(in) :: this, other
     t_bar = .FALSE.
   END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/pr77406.f90 b/gcc/testsuite/gfortran.dg/pr77406.f90
new file mode 100644
index 0000000..a279f75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr77406.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-w" }
+module m
+   interface s
+      subroutine s1(*)  ! { dg-error "Ambiguous interfaces" }
+      end
+      subroutine s2(*)  ! { dg-error "Ambiguous interfaces" }
+      end
+   end interface 
+   interface t
+      subroutine t1(*)
+      end
+      subroutine t2(*,*)
+      end
+   end interface
+   interface u
+      subroutine u1(*,x)
+      end
+      subroutine u2(*,i)
+      end
+   end interface
+   interface v
+      subroutine v1(*,*)  ! { dg-error "Ambiguous interfaces" }
+      end
+      subroutine v2(*,*)  ! { dg-error "Ambiguous interfaces" }
+      end
+   end interface
+   interface w
+      subroutine w1(*,i)  ! { dg-error "Ambiguous interfaces" }
+      end
+      subroutine w2(*,j)  ! { dg-error "Ambiguous interfaces" }
+      end
+   end interface
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
index 29a2ef9..f430ce8 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
@@ -7,11 +7,11 @@
 implicit none
 
 interface func
-  procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
+  procedure f1,f2
 end interface
 
 interface operator(.op.)
-  procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
+  procedure f1,f2
 end interface
 
 type :: t1
@@ -35,12 +35,12 @@ o1%ppc => o2%ppc  ! { dg-error "Type mismatch in function result" }
 
 contains
 
-  real function f1(a,b)
+  real function f1(a,b)    ! { dg-error "Ambiguous interfaces" }
     real,intent(in) :: a,b
     f1 = a + b
   end function
 
-  integer function f2(a,b)
+  integer function f2(a,b) ! { dg-error "Ambiguous interfaces" }
     real,intent(in) :: a,b
     f2 = a - b
   end function