1! RUN: bbc -emit-fir -o - %s | FileCheck %s 2 3 ! CHECK-LABEL: sinteger 4 function sinteger(n) 5 integer sinteger 6 nn = -88 7 ! CHECK: fir.select_case {{.*}} : i32 8 ! CHECK-SAME: upper, %c1 9 ! CHECK-SAME: point, %c2 10 ! CHECK-SAME: point, %c3 11 ! CHECK-SAME: interval, %c4{{.*}} %c5 12 ! CHECK-SAME: point, %c6 13 ! CHECK-SAME: point, %c7 14 ! CHECK-SAME: interval, %c8{{.*}} %c15 15 ! CHECK-SAME: lower, %c21 16 ! CHECK-SAME: unit 17 select case(n) 18 case (:1) 19 nn = 1 20 case (2) 21 nn = 2 22 case default 23 nn = 0 24 case (3) 25 nn = 3 26 case (4:5+1-1) 27 nn = 4 28 case (6) 29 nn = 6 30 case (7,8:15,21:) 31 nn = 7 32 end select 33 sinteger = nn 34 end 35 36 ! CHECK-LABEL: slogical 37 subroutine slogical(L) 38 logical :: L 39 n1 = 0 40 n2 = 0 41 n3 = 0 42 n4 = 0 43 n5 = 0 44 n6 = 0 45 n7 = 0 46 n8 = 0 47 48 select case (L) 49 end select 50 51 select case (L) 52 ! CHECK: cmpi eq, {{.*}} %false 53 ! CHECK: cond_br 54 case (.false.) 55 n2 = 1 56 end select 57 58 select case (L) 59 ! CHECK: cmpi eq, {{.*}} %true 60 ! CHECK: cond_br 61 case (.true.) 62 n3 = 2 63 end select 64 65 select case (L) 66 case default 67 n4 = 3 68 end select 69 70 select case (L) 71 ! CHECK: cmpi eq, {{.*}} %false 72 ! CHECK: cond_br 73 case (.false.) 74 n5 = 1 75 ! CHECK: cmpi eq, {{.*}} %true 76 ! CHECK: cond_br 77 case (.true.) 78 n5 = 2 79 end select 80 81 select case (L) 82 ! CHECK: cmpi eq, {{.*}} %false 83 ! CHECK: cond_br 84 case (.false.) 85 n6 = 1 86 case default 87 n6 = 3 88 end select 89 90 select case (L) 91 ! CHECK: cmpi eq, {{.*}} %true 92 ! CHECK: cond_br 93 case (.true.) 94 n7 = 2 95 case default 96 n7 = 3 97 end select 98 99 select case (L) 100 ! CHECK: cmpi eq, {{.*}} %false 101 ! CHECK: cond_br 102 case (.false.) 103 n8 = 1 104 ! CHECK: cmpi eq, {{.*}} %true 105 ! CHECK: cond_br 106 case (.true.) 107 n8 = 2 108 ! CHECK-NOT: constant 888 109 case default ! dead 110 n8 = 888 111 end select 112 113 print*, n1, n2, n3, n4, n5, n6, n7, n8 114 end 115 116 ! CHECK-LABEL: scharacter 117 subroutine scharacter(c) 118 character(*) :: c 119 nn = 0 120 select case (c) 121 case default 122 nn = -1 123 ! CHECK: CharacterCompareScalar1 124 ! CHECK-NEXT: constant 0 125 ! CHECK-NEXT: cmpi sle, {{.*}} %c0 126 ! CHECK-NEXT: cond_br 127 case (:'d') 128 nn = 10 129 ! CHECK: CharacterCompareScalar1 130 ! CHECK-NEXT: constant 0 131 ! CHECK-NEXT: cmpi sge, {{.*}} %c0 132 ! CHECK-NEXT: cond_br 133 ! CHECK: CharacterCompareScalar1 134 ! CHECK-NEXT: constant 0 135 ! CHECK-NEXT: cmpi sle, {{.*}} %c0 136 ! CHECK-NEXT: cond_br 137 case ('ff':'ffff') 138 nn = 20 139 ! CHECK: CharacterCompareScalar1 140 ! CHECK-NEXT: constant 0 141 ! CHECK-NEXT: cmpi eq, {{.*}} %c0 142 ! CHECK-NEXT: cond_br 143 case ('m') 144 nn = 30 145 ! CHECK: CharacterCompareScalar1 146 ! CHECK-NEXT: constant 0 147 ! CHECK-NEXT: cmpi eq, {{.*}} %c0 148 ! CHECK-NEXT: cond_br 149 case ('qq') 150 nn = 40 151 ! CHECK: CharacterCompareScalar1 152 ! CHECK-NEXT: constant 0 153 ! CHECK-NEXT: cmpi sge, {{.*}} %c0 154 ! CHECK-NEXT: cond_br 155 case ('x':) 156 nn = 50 157 end select 158 print*, nn 159 end 160 161 ! CHECK-LABEL: func @_QPscharacter1 162 subroutine scharacter1(s) 163 ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> 164 character(len=3) :: s 165 ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFscharacter1En"} 166 ! CHECK: fir.store %c0{{.*}} to %[[V_1]] : !fir.ref<i32> 167 n = 0 168 169 ! CHECK: %[[V_8:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 170 ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi sge, %[[V_8]], %c0{{.*}} : i32 171 ! CHECK: cond_br %[[V_9]], ^bb1, ^bb15 172 ! CHECK: ^bb1: // pred: ^bb0 173 if (lge(s,'00')) then 174 175 ! CHECK: %[[V_18:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 176 ! CHECK: %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 177 ! CHECK: %[[V_42:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 178 ! CHECK: %[[V_43:[0-9]+]] = arith.cmpi eq, %[[V_42]], %c0{{.*}} : i32 179 ! CHECK: fir.if %[[V_43]] { 180 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 181 ! CHECK: } 182 ! CHECK: cond_br %[[V_43]], ^bb3, ^bb2 183 ! CHECK: ^bb2: // pred: ^bb1 184 select case(trim(s)) 185 case('11') 186 n = 1 187 188 case default 189 continue 190 191 ! CHECK: %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 192 ! CHECK: %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32 193 ! CHECK: fir.if %[[V_49]] { 194 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 195 ! CHECK: } 196 ! CHECK: cond_br %[[V_49]], ^bb6, ^bb5 197 ! CHECK: ^bb3: // pred: ^bb1 198 ! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32> 199 ! CHECK: ^bb4: // pred: ^bb13 200 ! CHECK: ^bb5: // pred: ^bb2 201 case('22') 202 n = 2 203 204 ! CHECK: %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 205 ! CHECK: %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32 206 ! CHECK: fir.if %[[V_55]] { 207 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 208 ! CHECK: } 209 ! CHECK: cond_br %[[V_55]], ^bb8, ^bb7 210 ! CHECK: ^bb6: // pred: ^bb2 211 ! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32> 212 ! CHECK: ^bb7: // pred: ^bb5 213 case('33') 214 n = 3 215 216 case('44':'55','66':'77','88':) 217 n = 4 218 ! CHECK: %[[V_60:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 219 ! CHECK: %[[V_61:[0-9]+]] = arith.cmpi sge, %[[V_60]], %c0{{.*}} : i32 220 ! CHECK: cond_br %[[V_61]], ^bb9, ^bb10 221 ! CHECK: ^bb8: // pred: ^bb5 222 ! CHECK: fir.store %c3{{.*}} to %[[V_1]] : !fir.ref<i32> 223 ! CHECK: ^bb9: // pred: ^bb7 224 ! CHECK: %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 225 ! CHECK: %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32 226 ! CHECK: fir.if %[[V_67]] { 227 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 228 ! CHECK: } 229 ! CHECK: cond_br %[[V_67]], ^bb14, ^bb10 230 ! CHECK: ^bb10: // 2 preds: ^bb7, ^bb9 231 ! CHECK: %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 232 ! CHECK: %[[V_73:[0-9]+]] = arith.cmpi sge, %[[V_72]], %c0{{.*}} : i32 233 ! CHECK: cond_br %[[V_73]], ^bb11, ^bb12 234 ! CHECK: ^bb11: // pred: ^bb10 235 ! CHECK: %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 236 ! CHECK: %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32 237 ! CHECK: fir.if %[[V_79]] { 238 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 239 ! CHECK: } 240 ! CHECK: ^bb12: // 2 preds: ^bb10, ^bb11 241 ! CHECK: %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 242 ! CHECK: %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32 243 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 244 ! CHECK: cond_br %[[V_85]], ^bb14, ^bb13 245 ! CHECK: ^bb13: // pred: ^bb12 246 ! CHECK: ^bb14: // 3 preds: ^bb9, ^bb11, ^bb12 247 ! CHECK: fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32> 248 ! CHECK: ^bb15: // 6 preds: ^bb0, ^bb3, ^bb4, ^bb6, ^bb8, ^bb14 249 end select 250 end if 251 ! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32> 252 print*, n 253 end subroutine 254 255 256 ! CHECK-LABEL: func @_QPscharacter2 257 subroutine scharacter2(s) 258 ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> 259 ! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> 260 character(len=3) :: s 261 n = 0 262 263 ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 264 ! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 265 ! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>> 266 ! CHECK: br ^bb1 267 ! CHECK: ^bb1: // pred: ^bb0 268 ! CHECK: br ^bb2 269 n = -10 270 select case(trim(s)) 271 case default 272 n = 9 273 end select 274 print*, n 275 276 ! CHECK: ^bb2: // pred: ^bb1 277 ! CHECK: %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 278 ! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 279 ! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>> 280 ! CHECK: br ^bb3 281 ! CHECK: ^bb3: // pred: ^bb2 282 n = -2 283 select case(trim(s)) 284 end select 285 print*, n 286 end subroutine 287 288 ! CHECK-LABEL: func @_QPswhere 289 subroutine swhere(num) 290 implicit none 291 292 integer, intent(in) :: num 293 real, dimension(1) :: array 294 295 array = 0.0 296 297 select case (num) 298 ! CHECK: ^bb1: // pred: ^bb0 299 case (1) 300 where (array >= 0.0) 301 array = 42 302 end where 303 ! CHECK: cf.br ^bb3 304 ! CHECK: ^bb2: // pred: ^bb0 305 case default 306 array = -1 307 end select 308 ! CHECK: cf.br ^bb3 309 ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 310 print*, array(1) 311 end subroutine swhere 312 313 ! CHECK-LABEL: func @_QPsforall 314 subroutine sforall(num) 315 implicit none 316 317 integer, intent(in) :: num 318 real, dimension(1) :: array 319 320 array = 0.0 321 322 select case (num) 323 ! CHECK: ^bb1: // pred: ^bb0 324 case (1) 325 where (array >= 0.0) 326 array = 42 327 end where 328 ! CHECK: cf.br ^bb3 329 ! CHECK: ^bb2: // pred: ^bb0 330 case default 331 array = -1 332 end select 333 ! CHECK: cf.br ^bb3 334 ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 335 print*, array(1) 336 end subroutine sforall 337 338 ! CHECK-LABEL: main 339 program p 340 integer sinteger, v(10) 341 342 n = -10 343 do j = 1, 4 344 do k = 1, 10 345 n = n + 1 346 v(k) = sinteger(n) 347 enddo 348 ! expected output: 1 1 1 1 1 1 1 1 1 1 349 ! 1 2 3 4 4 6 7 7 7 7 350 ! 7 7 7 7 7 0 0 0 0 0 351 ! 7 7 7 7 7 7 7 7 7 7 352 print*, v 353 enddo 354 355 print* 356 call slogical(.false.) ! expected output: 0 1 0 3 1 1 3 1 357 call slogical(.true.) ! expected output: 0 0 2 3 2 3 2 2 358 359 print* 360 call scharacter('aa') ! expected output: 10 361 call scharacter('d') ! expected output: 10 362 call scharacter('f') ! expected output: -1 363 call scharacter('ff') ! expected output: 20 364 call scharacter('fff') ! expected output: 20 365 call scharacter('ffff') ! expected output: 20 366 call scharacter('fffff') ! expected output: -1 367 call scharacter('jj') ! expected output: -1 368 call scharacter('m') ! expected output: 30 369 call scharacter('q') ! expected output: -1 370 call scharacter('qq') ! expected output: 40 371 call scharacter('qqq') ! expected output: -1 372 call scharacter('vv') ! expected output: -1 373 call scharacter('xx') ! expected output: 50 374 call scharacter('zz') ! expected output: 50 375 376 print* 377 call scharacter1('99 ') ! expected output: 4 378 call scharacter1('88 ') ! expected output: 4 379 call scharacter1('77 ') ! expected output: 4 380 call scharacter1('66 ') ! expected output: 4 381 call scharacter1('55 ') ! expected output: 4 382 call scharacter1('44 ') ! expected output: 4 383 call scharacter1('33 ') ! expected output: 3 384 call scharacter1('22 ') ! expected output: 2 385 call scharacter1('11 ') ! expected output: 1 386 call scharacter1('00 ') ! expected output: 0 387 call scharacter1('. ') ! expected output: 0 388 call scharacter1(' ') ! expected output: 0 389 390 print* 391 call scharacter2('99 ') ! expected output: 9 -2 392 call scharacter2('22 ') ! expected output: 9 -2 393 call scharacter2('. ') ! expected output: 9 -2 394 call scharacter2(' ') ! expected output: 9 -2 395 396 print* 397 call swhere(1) ! expected output: 42. 398 call sforall(1) ! expected output: 42. 399 end 400