Skip to content

R
riscv-gcc-1
Commit bd845c14 by Steven G. Kargl
Options

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
parent 296002c6
Showing with 122 additions and 50 deletions
gcc/fortran/ChangeLog
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
......
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);
......
gcc/testsuite/ChangeLog
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
......
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
......
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
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
......
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
......
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
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
......
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
......
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
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)
......
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
......
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
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
......
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
......
gcc/testsuite/gfortran.dg/pr77406.f90 0 → 100644
! { 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
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment