! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! 15.4.3.4.5 Restrictions on generic declarations
! Specific procedures of generic interfaces must be distinguishable.
module m1
!ERROR: Generic 'g' may not have specific procedures 's2' and 's4' as their interfaces are not distinguishable
interface g
procedure s1
procedure s2
procedure s3
procedure s4
end interface
contains
subroutine s1(x)
integer(8) x
end
subroutine s2(x)
integer x
end
subroutine s3
end
subroutine s4(x)
integer x
end
end
module m2
!ERROR: Generic 'g' may not have specific procedures 'm2s1' and 'm2s2' as their interfaces are not distinguishable
interface g
subroutine m2s1(x)
end subroutine
subroutine m2s2(x)
real x
end subroutine
end interface
end
module m3
!ERROR: Generic 'g' may not have specific procedures 'm3f1' and 'm3f2' as their interfaces are not distinguishable
interface g
integer function m3f1()
end function
real function m3f2()
end function
end interface
end
module m4
type :: t1
end type
type, extends(t1) :: t2
end type
interface g
subroutine m4s1(x)
import :: t1
type(t1) :: x
end
subroutine m4s2(x)
import :: t2
type(t2) :: x
end
end interface
end
! These are all different ranks so they are distinguishable
module m5
interface g
subroutine m5s1(x)
real x
end subroutine
subroutine m5s2(x)
real x(:)
end subroutine
subroutine m5s3(x)
real x(:,:)
end subroutine
end interface
end
module m6
use m5
!ERROR: Generic 'g' may not have specific procedures 'm5s1' and 'm6s4' as their interfaces are not distinguishable
interface g
subroutine m6s4(x)
end subroutine
end interface
end
module m7
use m5
!ERROR: Generic 'g' may not have specific procedures 'm5s1' and 'm7s5' as their interfaces are not distinguishable
!ERROR: Generic 'g' may not have specific procedures 'm5s2' and 'm7s5' as their interfaces are not distinguishable
!ERROR: Generic 'g' may not have specific procedures 'm5s3' and 'm7s5' as their interfaces are not distinguishable
interface g
subroutine m7s5(x)
real x(..)
end subroutine
end interface
end
! Two procedures that differ only by attributes are not distinguishable
module m8
!ERROR: Generic 'g' may not have specific procedures 'm8s1' and 'm8s2' as their interfaces are not distinguishable
interface g
pure subroutine m8s1(x)
real, intent(in) :: x
end subroutine
subroutine m8s2(x)
real, intent(in) :: x
end subroutine
end interface
end
module m9
!ERROR: Generic 'g' may not have specific procedures 'm9s1' and 'm9s2' as their interfaces are not distinguishable
interface g
subroutine m9s1(x)
real :: x(10)
end subroutine
subroutine m9s2(x)
real :: x(100)
end subroutine
end interface
end
module m10
!ERROR: Generic 'g' may not have specific procedures 'm10s1' and 'm10s2' as their interfaces are not distinguishable
interface g
subroutine m10s1(x)
real :: x(10)
end subroutine
subroutine m10s2(x)
real :: x(..)
end subroutine
end interface
end
program m11
interface g1
subroutine m11s1(x)
real, pointer, intent(out) :: x
end subroutine
subroutine m11s2(x)
real, allocatable :: x
end subroutine
end interface
!ERROR: Generic 'g2' may not have specific procedures 'm11s3' and 'm11s4' as their interfaces are not distinguishable
interface g2
subroutine m11s3(x)
real, pointer, intent(in) :: x
end subroutine
subroutine m11s4(x)
real, allocatable :: x
end subroutine
end interface
end
module m12
!ERROR: Generic 'g1' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
generic :: g1 => s1, s2 ! rank-1 and assumed-rank
!ERROR: Generic 'g2' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
generic :: g2 => s2, s3 ! scalar and assumed-rank
!ERROR: Generic 'g3' may not have specific procedures 's1' and 's4' as their interfaces are not distinguishable
generic :: g3 => s1, s4 ! different shape, same rank
contains
subroutine s1(x)
real :: x(10)
end
subroutine s2(x)
real :: x(..)
end
subroutine s3(x)
real :: x
end
subroutine s4(x)
real :: x(100)
end
end
! Procedures that are distinguishable by return type of a dummy argument
module m13
interface g1
procedure s1
procedure s2
end interface
interface g2
procedure s1
procedure s3
end interface
contains
subroutine s1(x)
procedure(real), pointer :: x
end
subroutine s2(x)
procedure(integer), pointer :: x
end
subroutine s3(x)
interface
function x()
procedure(real), pointer :: x
end function
end interface
end
end
! Check user-defined operators
module m14
interface operator(*)
module procedure f1
module procedure f2
end interface
!ERROR: Generic 'OPERATOR(+)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
interface operator(+)
module procedure f1
module procedure f3
end interface
interface operator(.foo.)
module procedure f1
module procedure f2
end interface
!ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
interface operator(.bar.)
module procedure f1
module procedure f3
end interface
contains
real function f1(x, y)
real, intent(in) :: x
logical, intent(in) :: y
f1 = 0.
end
integer function f2(x, y)
integer, intent(in) :: x
logical, intent(in) :: y
f2 = 0.
end
real function f3(x, y)
real, value :: x
logical, value :: y
f3 = 0.
end
end module
! Types distinguished by kind (but not length) parameters
module m15
type :: t1(k1, l1)
integer, kind :: k1 = 1
integer, len :: l1 = 101
end type
type, extends(t1) :: t2(k2a, l2, k2b)
integer, kind :: k2a = 2
integer, kind :: k2b = 3
integer, len :: l2 = 102
end type
type, extends(t2) :: t3(l3, k3)
integer, kind :: k3 = 4
integer, len :: l3 = 103
end type
interface g1
procedure s1
procedure s2
end interface
!ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
interface g2
procedure s1
procedure s3
end interface
!ERROR: Generic 'g3' may not have specific procedures 's4' and 's5' as their interfaces are not distinguishable
interface g3
procedure s4
procedure s5
end interface
interface g4
procedure s5
procedure s6
procedure s9
end interface
interface g5
procedure s4
procedure s7
procedure s9
end interface
interface g6
procedure s5
procedure s8
procedure s9
end interface
!ERROR: Generic 'g7' may not have specific procedures 's6' and 's7' as their interfaces are not distinguishable
interface g7
procedure s6
procedure s7
end interface
!ERROR: Generic 'g8' may not have specific procedures 's6' and 's8' as their interfaces are not distinguishable
interface g8
procedure s6
procedure s8
end interface
!ERROR: Generic 'g9' may not have specific procedures 's7' and 's8' as their interfaces are not distinguishable
interface g9
procedure s7
procedure s8
end interface
contains
subroutine s1(x)
type(t1(1, 5)) :: x
end
subroutine s2(x)
type(t1(2, 4)) :: x
end
subroutine s3(x)
type(t1(l1=5)) :: x
end
subroutine s4(x)
type(t3(1, 101, 2, 102, 3, 103, 4)) :: x
end subroutine
subroutine s5(x)
type(t3) :: x
end subroutine
subroutine s6(x)
type(t3(1, 99, k2b=2, k2a=3, l2=*, l3=103, k3=4)) :: x
end subroutine
subroutine s7(x)
type(t3(k1=1, l1=99, k2a=3, k2b=2, k3=4)) :: x
end subroutine
subroutine s8(x)
type(t3(1, :, 3, :, 2, :, 4)), allocatable :: x
end subroutine
subroutine s9(x)
type(t3(k1=2)) :: x
end subroutine
end
! Check that specifics for type-bound generics can be distinguished
module m16
type :: t
contains
procedure, nopass :: s1
procedure, nopass :: s2
procedure, nopass :: s3
generic :: g1 => s1, s2
!ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
generic :: g2 => s1, s3
end type
contains
subroutine s1(x)
real :: x
end
subroutine s2(x)
integer :: x
end
subroutine s3(x)
real :: x
end
end
! Check polymorphic types
module m17
type :: t
end type
type, extends(t) :: t1
end type
type, extends(t) :: t2
end type
type, extends(t2) :: t2a
end type
interface g1
procedure s1
procedure s2
end interface
!ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
interface g2
procedure s3
procedure s4
end interface
interface g3
procedure s1
procedure s4
end interface
!ERROR: Generic 'g4' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
interface g4
procedure s2
procedure s3
end interface
!ERROR: Generic 'g5' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
interface g5
procedure s2
procedure s5
end interface
!ERROR: Generic 'g6' may not have specific procedures 's2' and 's6' as their interfaces are not distinguishable
interface g6
procedure s2
procedure s6
end interface
contains
subroutine s1(x)
type(t) :: x
end
subroutine s2(x)
type(t2a) :: x
end
subroutine s3(x)
class(t) :: x
end
subroutine s4(x)
class(t2) :: x
end
subroutine s5(x)
class(*) :: x
end
subroutine s6(x)
type(*) :: x
end
end
! Test C1514 rule 3 -- distinguishable passed-object dummy arguments
module m18
type :: t(k)
integer, kind :: k
contains
procedure, pass(x) :: p1 => s
procedure, pass :: p2 => s
procedure :: p3 => s
procedure, pass(y) :: p4 => s
generic :: g1 => p1, p4
generic :: g2 => p2, p4
generic :: g3 => p3, p4
end type
contains
subroutine s(x, y)
class(t(1)) :: x
class(t(2)) :: y
end
end
! C1511 - rules for operators
module m19
interface operator(.foo.)
module procedure f1
module procedure f2
end interface
!ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable
interface operator(.bar.)
module procedure f2
module procedure f3
end interface
contains
integer function f1(i)
integer, intent(in) :: i
f1 = 0
end
integer function f2(i, j)
integer, value :: i, j
f2 = 0
end
integer function f3(i, j)
integer, intent(in) :: i, j
f3 = 0
end
end
module m20
interface operator(.not.)
real function m20f(x)
character(*),intent(in) :: x
end function
end interface
interface operator(+)
procedure m20f
end interface
end module
subroutine subr1()
use m20
interface operator(.not.)
!ERROR: Procedure 'm20f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
procedure m20f
end interface
interface operator(+)
!ERROR: Procedure 'm20f' from module 'm20' is already specified in generic 'OPERATOR(+)'
procedure m20f
end interface
end subroutine subr1
! Extensions for distinguishable allocatable arguments; these should not
! elicit errors from f18
module m21
type :: t
end type
interface int1
procedure s1a, s1b ! only one is polymorphic
end interface
interface int2
procedure s2a, s2b ! only one is unlimited polymorphic
end interface
contains
subroutine s1a(x)
type(t), allocatable :: x
end subroutine
subroutine s1b(x)
class(t), allocatable :: x
end subroutine
subroutine s2a(x)
class(t), allocatable :: x
end subroutine
subroutine s2b(x)
class(*), allocatable :: x
end subroutine
end module
! Example reduced from pFUnit
module m22
!PORTABILITY: Generic 'generic' should not have specific procedures 'sub1' and 'sub2' as their interfaces are not distinguishable by the rules in the standard
interface generic
procedure sub1, sub2
end interface
contains
subroutine sub1(b, c)
class(*) b
integer, optional :: c
end
subroutine sub2(a, b, c)
real a
class(*) b
integer, optional :: c
end
end
Codebase Browser
llvm