From bd845c14b7aa666b5f7d453fa928551506df0ffa Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Fri, 7 Oct 2016 18:18:03 +0000 Subject: [PATCH] re PR fortran/77406 (ICE in generic_correspondence, at fortran/interface.c:1123) 2016-10-07 Steven G. Kargl 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 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 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/interface.c | 25 ++++++++++---- gcc/testsuite/ChangeLog | 19 +++++++++++ gcc/testsuite/gfortran.dg/assumed_type_3.f90 | 6 ++-- .../gfortran.dg/defined_operators_1.f90 | 9 ++--- gcc/testsuite/gfortran.dg/generic_26.f90 | 6 ++-- gcc/testsuite/gfortran.dg/generic_7.f90 | 6 ++-- gcc/testsuite/gfortran.dg/gomp/udr5.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/udr7.f90 | 2 +- gcc/testsuite/gfortran.dg/interface_1.f90 | 6 ++-- gcc/testsuite/gfortran.dg/interface_37.f90 | 6 ++-- gcc/testsuite/gfortran.dg/interface_5.f90 | 4 +-- gcc/testsuite/gfortran.dg/interface_6.f90 | 6 ++-- gcc/testsuite/gfortran.dg/interface_7.f90 | 6 ++-- gcc/testsuite/gfortran.dg/no_arg_check_3.f90 | 12 +++---- gcc/testsuite/gfortran.dg/operator_5.f90 | 8 ++--- gcc/testsuite/gfortran.dg/pr77406.f90 | 34 +++++++++++++++++++ .../gfortran.dg/proc_ptr_comp_20.f90 | 8 ++--- 18 files changed, 122 insertions(+), 50 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr77406.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2b1b85c90fd..50a0d422943 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-10-07 Steven G. Kargl + + 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 PR fortran/69955 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index e7f18785783..2a9af0f7638 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 fd69779350a..a0fedffa0a6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,22 @@ +2016-10-07 Steven G. Kargl + + 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 PR c++/77700 diff --git a/gcc/testsuite/gfortran.dg/assumed_type_3.f90 b/gcc/testsuite/gfortran.dg/assumed_type_3.f90 index e5bff509e40..38f924d6eea 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 9d9901853d3..af8dd166606 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 a1deef19f99..22a593b4227 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 7b9db24d5ba..53f1753bdc7 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 aebeee3a243..c10b80a24ad 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 230a3fc44dd..50aee23c932 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 3bbdd570c0f..aa6850f2428 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 a39f4748ac2..99b2b7c8a14 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 de7719178ca..a014862f8b1 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 2e7f85afa47..f816529ff16 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 b3274ef9b83..4e70f3501c3 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 ff176fef81a..3a95d0eff05 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 307b341ad1a..02d7b22981a 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 00000000000..a279f75c6c7 --- /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 29a2ef9f0d4..f430ce83c45 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 -- 2.30.2