1! RUN: %S/test_errors.sh %s %t %f18
2! Confirm enforcement of constraints and restrictions in 7.5.7.3
3! and C733, C734 and C779, C780, C782, C783, C784, and C785.
4
5module m
6  !ERROR: An ABSTRACT derived type must be extensible
7  type, abstract, bind(c) :: badAbstract1
8  end type
9  !ERROR: An ABSTRACT derived type must be extensible
10  type, abstract :: badAbstract2
11    sequence
12    real :: badAbstract2Field
13  end type
14  type, abstract :: abstract
15   contains
16    !ERROR: DEFERRED is required when an interface-name is provided
17    procedure(s1), pass :: ab1
18    !ERROR: Type-bound procedure 'ab3' may not be both DEFERRED and NON_OVERRIDABLE
19    procedure(s1), deferred, non_overridable :: ab3
20    !ERROR: DEFERRED is only allowed when an interface-name is provided
21    procedure, deferred, non_overridable :: ab4 => s1
22  end type
23  type :: nonoverride
24   contains
25    procedure, non_overridable, nopass :: no1 => s1
26  end type
27  type, extends(nonoverride) :: nonoverride2
28  end type
29  type, extends(nonoverride2) :: nonoverride3
30   contains
31    !ERROR: Override of NON_OVERRIDABLE 'no1' is not permitted
32    procedure, nopass :: no1 => s1
33  end type
34  type, abstract :: missing
35   contains
36    procedure(s4), deferred :: am1
37  end type
38  !ERROR: Non-ABSTRACT extension of ABSTRACT derived type 'missing' lacks a binding for DEFERRED procedure 'am1'
39  type, extends(missing) :: concrete
40  end type
41  type, extends(missing) :: intermediate
42   contains
43    procedure :: am1 => s7
44  end type
45  type, extends(intermediate) :: concrete2  ! ensure no false missing binding error
46  end type
47  type, bind(c) :: inextensible1
48  end type
49  !ERROR: The parent type is not extensible
50  type, extends(inextensible1) :: badExtends1
51  end type
52  type :: inextensible2
53    sequence
54    real :: inextensible2Field
55  end type
56  !ERROR: The parent type is not extensible
57  type, extends(inextensible2) :: badExtends2
58  end type
59  !ERROR: Derived type 'real' not found
60  type, extends(real) :: badExtends3
61  end type
62  type :: base
63    real :: component
64   contains
65    !ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED
66    procedure(s2), deferred :: bb1
67    !ERROR: DEFERRED is only allowed when an interface-name is provided
68    procedure, deferred :: bb2 => s2
69  end type
70  type, extends(base) :: extension
71   contains
72     !ERROR: A type-bound procedure binding may not have the same name as a parent component
73     procedure :: component => s3
74  end type
75  type :: nopassBase
76   contains
77    procedure, nopass :: tbp => s1
78  end type
79  type, extends(nopassBase) :: passExtends
80   contains
81    !ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure
82    procedure :: tbp => s5
83  end type
84  type :: passBase
85   contains
86    procedure :: tbp => s6
87  end type
88  type, extends(passBase) :: nopassExtends
89   contains
90    !ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure
91    procedure, nopass :: tbp => s1
92  end type
93 contains
94  subroutine s1(x)
95    class(abstract), intent(in) :: x
96  end subroutine s1
97  subroutine s2(x)
98    class(base), intent(in) :: x
99  end subroutine s2
100  subroutine s3(x)
101    class(extension), intent(in) :: x
102  end subroutine s3
103  subroutine s4(x)
104    class(missing), intent(in) :: x
105  end subroutine s4
106  subroutine s5(x)
107    class(passExtends), intent(in) :: x
108  end subroutine s5
109  subroutine s6(x)
110    class(passBase), intent(in) :: x
111  end subroutine s6
112  subroutine s7(x)
113    class(intermediate), intent(in) :: x
114  end subroutine s7
115end module
116
117module m1
118  implicit none
119  interface g
120    module procedure mp
121  end interface g
122
123  type t
124  contains
125    !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface
126    procedure,pass(x) :: tbp => g
127  end type t
128
129contains
130  subroutine mp(x)
131    class(t),intent(in) :: x
132  end subroutine
133end module m1
134
135program test
136  use m1
137  type,extends(t) :: t2
138  end type
139  type(t2) a
140  call a%tbp
141end program
142