===================================================================
@@ -1616,14 +1616,23 @@ gfc_compare_interfaces (gfc_symbol *s1,
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;
@@ -1791,13 +1800,15 @@ check_interface1 (gfc_interface *p, gfc_
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);
===================================================================
@@ -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
===================================================================
@@ -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
+
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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)
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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 mis
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
Consider the code interface s subroutine foo(*) end subroutine foo subroutine bar(*) end subroutine bar end interface s end gfortran currently ICE's, because she is ill-prepared to deal with alternate returns in an interface blocks. The attached patch fixes this problem. While I was fixing the problem I took this opportunity to improve the error reporting. Consider the code interface s subroutine foo(i) end subroutine foo subroutine bar(j) end subroutine bar end interface s end gfortran currently reports % gfc6 a.f90 a.f90:7:21: end subroutine bar 1 Error: Ambiguous interfaces 'bar' and 'foo' in generic interface 's' at (1) The (IMNSHO) improved error messages is now % gfc7 -c a.f90 a.f90:3:17: subroutine foo(i) 1 a.f90:6:17: subroutine bar(j) 2 Error: Ambiguous interfaces in generic interface 's' for 'foo' at (1) and 'bar' at (2) OK to commit on Saturday? 2016-09-03 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-09-03 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.