1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
! { dg-do compile }
! Type-bound procedures
! Test for errors in specific bindings, during resolution.
MODULE othermod
IMPLICIT NONE
CONTAINS
REAL FUNCTION proc_noarg ()
IMPLICIT NONE
END FUNCTION proc_noarg
END MODULE othermod
MODULE testmod
USE othermod
IMPLICIT NONE
INTEGER :: noproc
PROCEDURE() :: proc_nointf
INTERFACE
SUBROUTINE proc_intf ()
END SUBROUTINE proc_intf
END INTERFACE
ABSTRACT INTERFACE
SUBROUTINE proc_abstract_intf ()
END SUBROUTINE proc_abstract_intf
END INTERFACE
TYPE supert
CONTAINS
PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
PROCEDURE, NOPASS, NON_OVERRIDABLE :: super_nonoverrid => proc_sub_noarg
END TYPE supert
TYPE, EXTENDS(supert) :: t
CONTAINS
! Bindings that should succeed
PROCEDURE, NOPASS :: p0 => proc_noarg
PROCEDURE, PASS :: p1 => proc_arg_first
PROCEDURE proc_arg_first
PROCEDURE, PASS(me) :: p2 => proc_arg_middle
PROCEDURE, PASS(me), NON_OVERRIDABLE :: p3 => proc_arg_last
PROCEDURE, NOPASS :: p4 => proc_nome
PROCEDURE, NOPASS :: p5 => proc_intf
PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
! Bindings that should not succeed
PROCEDURE :: e0 => undefined ! { dg-error "has no IMPLICIT|module procedure" }
PROCEDURE, PASS :: e1 => proc_noarg ! { dg-error "at least one argument" }
PROCEDURE :: e2 => proc_noarg ! { dg-error "at least one argument" }
PROCEDURE, PASS(me) :: e3 => proc_nome ! { dg-error "no argument 'me'" }
PROCEDURE, PASS(me) :: e4 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
PROCEDURE, PASS :: e5 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
PROCEDURE :: e6 => noproc ! { dg-error "module procedure" }
PROCEDURE :: e7 => proc_nointf ! { dg-error "explicit interface" }
PROCEDURE, NOPASS :: e8 => proc_abstract_intf ! { dg-error "explicit interface" }
PROCEDURE :: super_nonoverrid => proc_arg_first ! { dg-error "NON_OVERRIDABLE" }
END TYPE t
CONTAINS
SUBROUTINE proc_arg_first (me, x)
IMPLICIT NONE
CLASS(t) :: me
REAL :: x
END SUBROUTINE proc_arg_first
INTEGER FUNCTION proc_arg_middle (x, me, y)
IMPLICIT NONE
REAL :: x, y
CLASS(t) :: me
END FUNCTION proc_arg_middle
SUBROUTINE proc_arg_last (x, me)
IMPLICIT NONE
CLASS(t) :: me
REAL :: x
END SUBROUTINE proc_arg_last
SUBROUTINE proc_nome (arg, x, y)
IMPLICIT NONE
TYPE(t) :: arg
REAL :: x, y
END SUBROUTINE proc_nome
SUBROUTINE proc_mewrong (me, x)
IMPLICIT NONE
REAL :: x
INTEGER :: me
END SUBROUTINE proc_mewrong
SUBROUTINE proc_sub_noarg ()
END SUBROUTINE proc_sub_noarg
END MODULE testmod
PROGRAM main
IMPLICIT NONE
TYPE t
CONTAINS
PROCEDURE, NOPASS :: proc_no_module ! { dg-error "module procedure" }
END TYPE t
CONTAINS
SUBROUTINE proc_no_module ()
END SUBROUTINE proc_no_module
END PROGRAM main
|
