1! RUN: %python %S/test_errors.py %s %flang_fc1 2! Test SELECT CASE Constraints: C1145, C1146, C1147, C1148, C1149 3program selectCaseProg 4 implicit none 5 ! local variable declaration 6 character :: grade1 = 'B' 7 integer :: grade2 = 3 8 logical :: grade3 = .false. 9 real :: grade4 = 2.0 10 character (len = 10) :: name = 'test' 11 logical, parameter :: grade5 = .false. 12 CHARACTER(KIND=1), parameter :: ASCII_parm1 = 'a', ASCII_parm2='b' 13 CHARACTER(KIND=2), parameter :: UCS16_parm = 'c' 14 CHARACTER(KIND=4), parameter :: UCS32_parm ='d' 15 type scores 16 integer :: val 17 end type 18 type (scores) :: score = scores(25) 19 type (scores), parameter :: score_val = scores(50) 20 21 ! Valid Cases 22 select case (grade1) 23 case ('A') 24 case ('B') 25 case ('C') 26 case default 27 end select 28 29 select case (grade2) 30 case (1) 31 case (2) 32 case (3) 33 case default 34 end select 35 36 select case (grade3) 37 case (.true.) 38 case (.false.) 39 end select 40 41 select case (name) 42 case default 43 case ('now') 44 case ('test') 45 end select 46 47 ! C1145 48 !ERROR: SELECT CASE expression must be integer, logical, or character 49 select case (grade4) 50 case (1.0) 51 case (2.0) 52 case (3.0) 53 case default 54 end select 55 56 !ERROR: SELECT CASE expression must be integer, logical, or character 57 select case (score) 58 case (score_val) 59 case (scores(100)) 60 end select 61 62 ! C1146 63 select case (grade3) 64 case default 65 case (.true.) 66 !ERROR: CASE DEFAULT conflicts with previous cases 67 case default 68 end select 69 70 ! C1147 71 select case (grade2) 72 !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' 73 case (:'Z') 74 case default 75 end select 76 77 select case (grade1) 78 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' 79 case (:1) 80 case default 81 end select 82 83 select case (grade3) 84 case default 85 case (.true.) 86 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'LOGICAL(4)' 87 case (3) 88 end select 89 90 select case (grade2) 91 case default 92 case (2 :) 93 !ERROR: CASE value has type 'LOGICAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' 94 case (.true. :) 95 !ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' 96 case (1.0) 97 !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=3_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' 98 case ('wow') 99 end select 100 101 select case (ASCII_parm1) 102 case (ASCII_parm2) 103 !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' 104 case (UCS32_parm) 105 !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' 106 case (UCS16_parm) 107 !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' 108 case (4_"ucs-32") 109 !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' 110 case (2_"ucs-16") 111 case default 112 end select 113 114 ! C1148 115 select case (grade3) 116 case default 117 !ERROR: CASE range is not allowed for LOGICAL 118 case (.true. :) 119 end select 120 121 ! C1149 122 select case (grade3) 123 case (.true.) 124 case (.false.) 125 !ERROR: CASE (.true._1) conflicts with previous cases 126 case (.true.) 127 !ERROR: CASE (.false._1) conflicts with previous cases 128 case (grade5) 129 end select 130 131 select case (grade2) 132 !WARNING: CASE has lower bound greater than upper bound 133 case (51:50) 134 case (100:) 135 case (:30) 136 case (40) 137 case (90) 138 case (91:99) 139 !ERROR: CASE (81_4:90_4) conflicts with previous cases 140 case (81:90) 141 !ERROR: CASE (:80_4) conflicts with previous cases 142 case (:80) 143 !ERROR: CASE (200_4) conflicts with previous cases 144 case (200) 145 case default 146 end select 147 148 select case (name) 149 case ('hello') 150 case ('hey') 151 !ERROR: CASE (:"hh") conflicts with previous cases 152 case (:'hh') 153 !ERROR: CASE (:"hd") conflicts with previous cases 154 case (:'hd') 155 case ( 'hu':) 156 case ('hi':'ho') 157 !ERROR: CASE ("hj") conflicts with previous cases 158 case ('hj') 159 !ERROR: CASE ("ha") conflicts with previous cases 160 case ('ha') 161 !ERROR: CASE ("hz") conflicts with previous cases 162 case ('hz') 163 case default 164 end select 165 166end program 167 168subroutine test_overlap 169 integer :: i 170 !OK: these cases do not overlap 171 select case(i) 172 case(0:) 173 case(:-1) 174 end select 175 select case(i) 176 case(-1:) 177 !ERROR: CASE (:0_4) conflicts with previous cases 178 case(:0) 179 end select 180end 181 182subroutine test_overflow 183 integer :: j 184 select case(1_1) 185 case (127) 186 !WARNING: CASE value (128_4) overflows type (INTEGER(1)) of SELECT CASE expression 187 case (128) 188 !WARNING: CASE value (129_4) overflows type (INTEGER(1)) of SELECT CASE expression 189 !WARNING: CASE value (130_4) overflows type (INTEGER(1)) of SELECT CASE expression 190 case (129:130) 191 !WARNING: CASE value (-130_4) overflows type (INTEGER(1)) of SELECT CASE expression 192 !WARNING: CASE value (-129_4) overflows type (INTEGER(1)) of SELECT CASE expression 193 case (-130:-129) 194 case (-128) 195 !ERROR: Must be a scalar value, but is a rank-1 array 196 case ([1, 2]) 197 !ERROR: Must be a constant value 198 case (j) 199 case default 200 end select 201end 202