forked from OSchip/llvm-project
142 lines
3.9 KiB
Fortran
142 lines
3.9 KiB
Fortran
! RUN: %S/test_errors.sh %s %t %f18
|
|
! Confirm enforcement of constraints and restrictions in 7.5.7.3
|
|
! and C733, C734 and C779, C780, C782, C783, C784, and C785.
|
|
|
|
module m
|
|
!ERROR: An ABSTRACT derived type must be extensible
|
|
type, abstract, bind(c) :: badAbstract1
|
|
end type
|
|
!ERROR: An ABSTRACT derived type must be extensible
|
|
type, abstract :: badAbstract2
|
|
sequence
|
|
real :: badAbstract2Field
|
|
end type
|
|
type, abstract :: abstract
|
|
contains
|
|
!ERROR: DEFERRED is required when an interface-name is provided
|
|
procedure(s1), pass :: ab1
|
|
!ERROR: Type-bound procedure 'ab3' may not be both DEFERRED and NON_OVERRIDABLE
|
|
procedure(s1), deferred, non_overridable :: ab3
|
|
!ERROR: DEFERRED is only allowed when an interface-name is provided
|
|
procedure, deferred, non_overridable :: ab4 => s1
|
|
end type
|
|
type :: nonoverride
|
|
contains
|
|
procedure, non_overridable, nopass :: no1 => s1
|
|
end type
|
|
type, extends(nonoverride) :: nonoverride2
|
|
end type
|
|
type, extends(nonoverride2) :: nonoverride3
|
|
contains
|
|
!ERROR: Override of NON_OVERRIDABLE 'no1' is not permitted
|
|
procedure, nopass :: no1 => s1
|
|
end type
|
|
type, abstract :: missing
|
|
contains
|
|
procedure(s4), deferred :: am1
|
|
end type
|
|
!ERROR: Non-ABSTRACT extension of ABSTRACT derived type 'missing' lacks a binding for DEFERRED procedure 'am1'
|
|
type, extends(missing) :: concrete
|
|
end type
|
|
type, extends(missing) :: intermediate
|
|
contains
|
|
procedure :: am1 => s7
|
|
end type
|
|
type, extends(intermediate) :: concrete2 ! ensure no false missing binding error
|
|
end type
|
|
type, bind(c) :: inextensible1
|
|
end type
|
|
!ERROR: The parent type is not extensible
|
|
type, extends(inextensible1) :: badExtends1
|
|
end type
|
|
type :: inextensible2
|
|
sequence
|
|
real :: inextensible2Field
|
|
end type
|
|
!ERROR: The parent type is not extensible
|
|
type, extends(inextensible2) :: badExtends2
|
|
end type
|
|
!ERROR: Derived type 'real' not found
|
|
type, extends(real) :: badExtends3
|
|
end type
|
|
type :: base
|
|
real :: component
|
|
contains
|
|
!ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED
|
|
procedure(s2), deferred :: bb1
|
|
!ERROR: DEFERRED is only allowed when an interface-name is provided
|
|
procedure, deferred :: bb2 => s2
|
|
end type
|
|
type, extends(base) :: extension
|
|
contains
|
|
!ERROR: A type-bound procedure binding may not have the same name as a parent component
|
|
procedure :: component => s3
|
|
end type
|
|
type :: nopassBase
|
|
contains
|
|
procedure, nopass :: tbp => s1
|
|
end type
|
|
type, extends(nopassBase) :: passExtends
|
|
contains
|
|
!ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure
|
|
procedure :: tbp => s5
|
|
end type
|
|
type :: passBase
|
|
contains
|
|
procedure :: tbp => s6
|
|
end type
|
|
type, extends(passBase) :: nopassExtends
|
|
contains
|
|
!ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure
|
|
procedure, nopass :: tbp => s1
|
|
end type
|
|
contains
|
|
subroutine s1(x)
|
|
class(abstract), intent(in) :: x
|
|
end subroutine s1
|
|
subroutine s2(x)
|
|
class(base), intent(in) :: x
|
|
end subroutine s2
|
|
subroutine s3(x)
|
|
class(extension), intent(in) :: x
|
|
end subroutine s3
|
|
subroutine s4(x)
|
|
class(missing), intent(in) :: x
|
|
end subroutine s4
|
|
subroutine s5(x)
|
|
class(passExtends), intent(in) :: x
|
|
end subroutine s5
|
|
subroutine s6(x)
|
|
class(passBase), intent(in) :: x
|
|
end subroutine s6
|
|
subroutine s7(x)
|
|
class(intermediate), intent(in) :: x
|
|
end subroutine s7
|
|
end module
|
|
|
|
module m1
|
|
implicit none
|
|
interface g
|
|
module procedure mp
|
|
end interface g
|
|
|
|
type t
|
|
contains
|
|
!ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface
|
|
procedure,pass(x) :: tbp => g
|
|
end type t
|
|
|
|
contains
|
|
subroutine mp(x)
|
|
class(t),intent(in) :: x
|
|
end subroutine
|
|
end module m1
|
|
|
|
program test
|
|
use m1
|
|
type,extends(t) :: t2
|
|
end type
|
|
type(t2) a
|
|
call a%tbp
|
|
end program
|