+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
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;
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);
+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
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
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
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
foo_3 = a + 3 * b - c
end function foo_3
end module mymod
+
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
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
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
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
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
! 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
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)
! 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
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
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
END INTERFACE
INTERFACE OPERATOR(.FOO.)
- MODULE PROCEDURE t_bar ! { dg-error "Ambiguous interfaces" }
+ MODULE PROCEDURE t_bar
END INTERFACE
! intrinsic operator
END INTERFACE
INTERFACE OPERATOR(==)
- MODULE PROCEDURE t_bar ! { dg-error "Ambiguous interfaces" }
+ MODULE PROCEDURE t_bar
END INTERFACE
INTERFACE OPERATOR(.eq.)
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
--- /dev/null
+! { 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
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
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
projects / gcc.git / commitdiff