1! { dg-do compile } 2 3! Type-bound procedures 4! Test for the check if overriding methods "match" the overridden ones by their 5! characteristics. 6 7MODULE testmod 8 IMPLICIT NONE 9 10 TYPE supert 11 CONTAINS 12 13 ! For checking the PURE/ELEMENTAL matching. 14 PROCEDURE, NOPASS :: pure1 => proc_pure 15 PROCEDURE, NOPASS :: pure2 => proc_pure 16 PROCEDURE, NOPASS :: nonpure => proc_sub 17 PROCEDURE, NOPASS :: elemental1 => proc_elemental 18 PROCEDURE, NOPASS :: elemental2 => proc_elemental 19 PROCEDURE, NOPASS :: nonelem1 => proc_nonelem 20 PROCEDURE, NOPASS :: nonelem2 => proc_nonelem 21 22 ! Same number of arguments! 23 PROCEDURE, NOPASS :: three_args_1 => proc_threearg 24 PROCEDURE, NOPASS :: three_args_2 => proc_threearg 25 26 ! For SUBROUTINE/FUNCTION/result checking. 27 PROCEDURE, NOPASS :: subroutine1 => proc_sub 28 PROCEDURE, NOPASS :: subroutine2 => proc_sub 29 PROCEDURE, NOPASS :: intfunction1 => proc_intfunc 30 PROCEDURE, NOPASS :: intfunction2 => proc_intfunc 31 PROCEDURE, NOPASS :: intfunction3 => proc_intfunc 32 33 ! For access-based checks. 34 PROCEDURE, NOPASS, PRIVATE :: priv => proc_sub 35 PROCEDURE, NOPASS, PUBLIC :: publ1 => proc_sub 36 PROCEDURE, NOPASS, PUBLIC :: publ2 => proc_sub 37 38 ! For passed-object dummy argument checks. 39 PROCEDURE, NOPASS :: nopass1 => proc_stme1 40 PROCEDURE, NOPASS :: nopass2 => proc_stme1 41 PROCEDURE, PASS :: pass1 => proc_stme1 42 PROCEDURE, PASS(me) :: pass2 => proc_stme1 43 PROCEDURE, PASS(me1) :: pass3 => proc_stmeme 44 45 ! For corresponding dummy arguments. 46 PROCEDURE, PASS :: corresp1 => proc_stmeint 47 PROCEDURE, PASS :: corresp2 => proc_stmeint 48 PROCEDURE, PASS :: corresp3 => proc_stmeint 49 50 END TYPE supert 51 52 ! Checking for NON_OVERRIDABLE is in typebound_proc_5.f03. 53 54 TYPE, EXTENDS(supert) :: t 55 CONTAINS 56 57 ! For checking the PURE/ELEMENTAL matching. 58 PROCEDURE, NOPASS :: pure1 => proc_pure ! Ok, both pure. 59 PROCEDURE, NOPASS :: pure2 => proc_sub ! { dg-error "must also be PURE" } 60 PROCEDURE, NOPASS :: nonpure => proc_pure ! Ok, overridden not pure. 61 PROCEDURE, NOPASS :: elemental1 => proc_elemental ! Ok, both elemental. 62 PROCEDURE, NOPASS :: elemental2 => proc_nonelem ! { dg-error "must also be" } 63 PROCEDURE, NOPASS :: nonelem1 => proc_nonelem ! Ok, non elemental. 64 PROCEDURE, NOPASS :: nonelem2 => proc_elemental ! { dg-error "must not be ELEMENTAL" } 65 66 ! Same number of arguments! 67 PROCEDURE, NOPASS :: three_args_1 => proc_threearg ! Ok. 68 PROCEDURE, NOPASS :: three_args_2 => proc_twoarg ! { dg-error "same number of formal arguments" } 69 70 ! For SUBROUTINE/FUNCTION/result checking. 71 PROCEDURE, NOPASS :: subroutine1 => proc_sub ! Ok, both subroutines. 72 PROCEDURE, NOPASS :: subroutine2 => proc_intfunc ! { dg-error "must also be a SUBROUTINE" } 73 PROCEDURE, NOPASS :: intfunction1 => proc_intfunc ! Ok, matching functions. 74 PROCEDURE, NOPASS :: intfunction2 => proc_sub ! { dg-error "must also be a FUNCTION" } 75 PROCEDURE, NOPASS :: intfunction3 => proc_realfunc ! { dg-error "Type/rank mismatch in function result" } 76 77 ! For access-based checks. 78 PROCEDURE, NOPASS, PUBLIC :: priv => proc_sub ! Ok, increases visibility. 79 PROCEDURE, NOPASS, PUBLIC :: publ1 => proc_sub ! Ok, both PUBLIC. 80 PROCEDURE, NOPASS, PRIVATE :: publ2 => proc_sub ! { dg-error "must not be PRIVATE" } 81 82 ! For passed-object dummy argument checks. 83 PROCEDURE, NOPASS :: nopass1 => proc_stme1 ! Ok, both NOPASS. 84 PROCEDURE, PASS :: nopass2 => proc_tme1 ! { dg-error "must also be NOPASS" } 85 PROCEDURE, PASS :: pass1 => proc_tme1 ! Ok. 86 PROCEDURE, NOPASS :: pass2 => proc_stme1 ! { dg-error "must also be PASS" } 87 PROCEDURE, PASS(me2) :: pass3 => proc_tmeme ! { dg-error "same position" } 88 89 ! For corresponding dummy arguments. 90 PROCEDURE, PASS :: corresp1 => proc_tmeint ! Ok. 91 PROCEDURE, PASS :: corresp2 => proc_tmeintx ! { dg-error "should be named 'a'" } 92 PROCEDURE, PASS :: corresp3 => proc_tmereal ! { dg-error "Type/rank mismatch in argument 'a'" } 93 94 END TYPE t 95 96CONTAINS 97 98 PURE SUBROUTINE proc_pure () 99 END SUBROUTINE proc_pure 100 101 ELEMENTAL SUBROUTINE proc_elemental (arg) 102 IMPLICIT NONE 103 INTEGER, INTENT(INOUT) :: arg 104 END SUBROUTINE proc_elemental 105 106 SUBROUTINE proc_nonelem (arg) 107 IMPLICIT NONE 108 INTEGER, INTENT(INOUT) :: arg 109 END SUBROUTINE proc_nonelem 110 111 SUBROUTINE proc_threearg (a, b, c) 112 IMPLICIT NONE 113 INTEGER :: a, b, c 114 END SUBROUTINE proc_threearg 115 116 SUBROUTINE proc_twoarg (a, b) 117 IMPLICIT NONE 118 INTEGER :: a, b 119 END SUBROUTINE proc_twoarg 120 121 SUBROUTINE proc_sub () 122 END SUBROUTINE proc_sub 123 124 INTEGER FUNCTION proc_intfunc () 125 proc_intfunc = 42 126 END FUNCTION proc_intfunc 127 128 REAL FUNCTION proc_realfunc () 129 proc_realfunc = 42.0 130 END FUNCTION proc_realfunc 131 132 SUBROUTINE proc_stme1 (me, a) 133 IMPLICIT NONE 134 CLASS(supert) :: me 135 INTEGER :: a 136 END SUBROUTINE proc_stme1 137 138 SUBROUTINE proc_tme1 (me, a) 139 IMPLICIT NONE 140 CLASS(t) :: me 141 INTEGER :: a 142 END SUBROUTINE proc_tme1 143 144 SUBROUTINE proc_stmeme (me1, me2) 145 IMPLICIT NONE 146 CLASS(supert) :: me1, me2 147 END SUBROUTINE proc_stmeme 148 149 SUBROUTINE proc_tmeme (me1, me2) 150 IMPLICIT NONE 151 CLASS(t) :: me1, me2 152 END SUBROUTINE proc_tmeme 153 154 SUBROUTINE proc_stmeint (me, a) 155 IMPLICIT NONE 156 CLASS(supert) :: me 157 INTEGER :: a 158 END SUBROUTINE proc_stmeint 159 160 SUBROUTINE proc_tmeint (me, a) 161 IMPLICIT NONE 162 CLASS(t) :: me 163 INTEGER :: a 164 END SUBROUTINE proc_tmeint 165 166 SUBROUTINE proc_tmeintx (me, x) 167 IMPLICIT NONE 168 CLASS(t) :: me 169 INTEGER :: x 170 END SUBROUTINE proc_tmeintx 171 172 SUBROUTINE proc_tmereal (me, a) 173 IMPLICIT NONE 174 CLASS(t) :: me 175 REAL :: a 176 END SUBROUTINE proc_tmereal 177 178END MODULE testmod 179