1! { dg-do compile }
2
3! Type-bound procedures
4! Compiling and errors with GENERIC binding declarations.
5! Bindings with NOPASS.
6
7MODULE m
8  IMPLICIT NONE
9
10  TYPE somet
11  CONTAINS
12    PROCEDURE, NOPASS :: p1 => intf1
13    PROCEDURE, NOPASS :: p1a => intf1a
14    PROCEDURE, NOPASS :: p2 => intf2
15    PROCEDURE, NOPASS :: p3 => intf3
16    PROCEDURE, NOPASS :: subr
17
18    GENERIC :: gen1 => p1a ! { dg-error "are ambiguous" }
19
20    GENERIC, PUBLIC :: gen1 => p1, p2
21    GENERIC :: gen1 => p3 ! Implicitly PUBLIC.
22    GENERIC, PRIVATE :: gen2 => p1
23
24    GENERIC :: gen2 => p2 ! { dg-error "same access" }
25    GENERIC :: gen1 => p1 ! { dg-error "already defined as specific binding" }
26    GENERIC, PASS :: gen3 => p1 ! { dg-error "Expected access-specifier" }
27    GENERIC :: p1 => p1 ! { dg-error "already a non-generic procedure" }
28    PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "already a procedure" }
29    GENERIC :: gen3 => ! { dg-error "specific binding" }
30    GENERIC :: gen4 => p1 x ! { dg-error "Junk after" }
31    GENERIC :: gen5 => p_notthere ! { dg-error "Undefined specific binding" }
32    GENERIC :: gen6 => p1
33    GENERIC :: gen7 => gen6 ! { dg-error "must target a specific binding" }
34
35    GENERIC :: gensubr => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
36    GENERIC :: gensubr => subr
37
38  END TYPE somet
39
40  TYPE supert
41  CONTAINS
42    PROCEDURE, NOPASS :: p1 => intf1
43    PROCEDURE, NOPASS :: p1a => intf1a
44    PROCEDURE, NOPASS :: p2 => intf2
45    PROCEDURE, NOPASS :: p3 => intf3
46    PROCEDURE, NOPASS :: sub1 => subr
47
48    GENERIC :: gen1 => p1, p2
49    GENERIC :: gen1 => p3
50    GENERIC :: gen2 => p1
51    GENERIC :: gensub => sub1
52  END TYPE supert
53
54  TYPE, EXTENDS(supert) :: t
55  CONTAINS
56    GENERIC :: gen2 => p1a ! { dg-error "are ambiguous" }
57    GENERIC :: gen2 => p3
58    GENERIC :: p1 => p2 ! { dg-error "cannot overwrite specific" }
59    GENERIC :: gensub => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
60
61    PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "Cannot overwrite GENERIC" }
62  END TYPE t
63
64CONTAINS
65
66  INTEGER FUNCTION intf1 (a, b)
67    IMPLICIT NONE
68    INTEGER :: a, b
69    intf1 = 42
70  END FUNCTION intf1
71
72  INTEGER FUNCTION intf1a (a, b)
73    IMPLICIT NONE
74    INTEGER :: a, b
75    intf1a = 42
76  END FUNCTION intf1a
77
78  INTEGER FUNCTION intf2 (a, b)
79    IMPLICIT NONE
80    REAL :: a, b
81    intf2 = 42.0
82  END FUNCTION intf2
83
84  LOGICAL FUNCTION intf3 ()
85    IMPLICIT NONE
86    intf3 = .TRUE.
87  END FUNCTION intf3
88
89  SUBROUTINE subr (x)
90    IMPLICIT NONE
91    INTEGER :: x
92  END SUBROUTINE subr
93
94END MODULE m
95