1! RUN: bbc -emit-fir -hlfir=false -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, ^bb16 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: cond_br %[[V_43]], ^bb3, ^bb2 180 ! CHECK: ^bb2: // pred: ^bb1 181 select case(trim(s)) 182 case('11') 183 n = 1 184 185 case default 186 continue 187 188 ! CHECK: %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 189 ! CHECK: %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32 190 ! CHECK: cond_br %[[V_49]], ^bb6, ^bb5 191 ! CHECK: ^bb3: // pred: ^bb1 192 ! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32> 193 ! CHECK: ^bb4: // pred: ^bb13 194 ! CHECK: ^bb5: // pred: ^bb2 195 case('22') 196 n = 2 197 198 ! CHECK: %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 199 ! CHECK: %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32 200 ! CHECK: cond_br %[[V_55]], ^bb8, ^bb7 201 ! CHECK: ^bb6: // pred: ^bb2 202 ! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32> 203 ! CHECK: ^bb7: // pred: ^bb5 204 case('33') 205 n = 3 206 207 case('44':'55','66':'77','88':) 208 n = 4 209 ! CHECK: %[[V_60:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 210 ! CHECK: %[[V_61:[0-9]+]] = arith.cmpi sge, %[[V_60]], %c0{{.*}} : i32 211 ! CHECK: cond_br %[[V_61]], ^bb9, ^bb10 212 ! CHECK: ^bb8: // pred: ^bb5 213 ! CHECK: fir.store %c3{{.*}} to %[[V_1]] : !fir.ref<i32> 214 ! CHECK: ^bb9: // pred: ^bb7 215 ! CHECK: %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 216 ! CHECK: %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32 217 ! CHECK: cond_br %[[V_67]], ^bb14, ^bb10 218 ! CHECK: ^bb10: // 2 preds: ^bb7, ^bb9 219 ! CHECK: %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 220 ! CHECK: %[[V_73:[0-9]+]] = arith.cmpi sge, %[[V_72]], %c0{{.*}} : i32 221 ! CHECK: cond_br %[[V_73]], ^bb11, ^bb12 222 ! CHECK: ^bb11: // pred: ^bb10 223 ! CHECK: %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 224 ! CHECK: %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32 225 ! CHECK: ^bb12: // 2 preds: ^bb10, ^bb11 226 ! CHECK: %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 227 ! CHECK: %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32 228 ! CHECK: cond_br %[[V_85]], ^bb14, ^bb13 229 ! CHECK: ^bb13: // pred: ^bb12 230 ! CHECK: ^bb14: // 3 preds: ^bb9, ^bb11, ^bb12 231 ! CHECK: fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32> 232 ! CHECK: ^bb15: // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14 233 ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> 234 end select 235 end if 236 ! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32> 237 print*, n 238 end subroutine 239 240 ! CHECK-LABEL: func @_QPscharacter2 241 subroutine scharacter2(s) 242 ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> 243 ! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> 244 character(len=3) :: s 245 246 n = -10 247 ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 248 ! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 249 ! CHECK: br ^bb1 250 ! CHECK: ^bb1: // pred: ^bb0 251 ! CHECK: fir.store %c9{{.*}} 252 ! CHECK: br ^bb2 253 ! CHECK: ^bb2: // pred: ^bb1 254 ! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>> 255 select case(trim(s)) 256 case default 257 n = 9 258 end select 259 print*, n 260 261 n = -2 262 ! CHECK: %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 263 ! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 264 ! CHECK: br ^bb3 265 ! CHECK: ^bb3: // pred: ^bb2 266 ! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>> 267 select case(trim(s)) 268 end select 269 print*, n 270 end subroutine 271 272 ! CHECK-LABEL: func @_QPsempty 273 ! empty select case blocks 274 subroutine sempty(n) 275 ! CHECK: %[[selectI1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32> 276 ! CHECK: fir.select_case %[[selectI1]] : i32 [#fir.point, %c1{{.*}}, ^bb1, #fir.point, %c2{{.*}}, ^bb2, unit, ^bb3] 277 ! CHECK: ^bb1: // pred: ^bb0 278 ! CHECK: fir.call @_FortranAioBeginExternalListOutput 279 ! CHECK: br ^bb4 280 ! CHECK: ^bb2: // pred: ^bb0 281 ! CHECK: br ^bb4 282 ! CHECK: ^bb3: // pred: ^bb0 283 ! CHECK: fir.call @_FortranAioBeginExternalListOutput 284 ! CHECK: br ^bb4 285 select case (n) 286 case (1) 287 print*, n, 'i:case 1' 288 case (2) 289 ! print*, n, 'i:case 2' 290 case default 291 print*, n, 'i:case default' 292 end select 293 ! CHECK: ^bb4: // 3 preds: ^bb1, ^bb2, ^bb3 294 ! CHECK: %[[cmpC1:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 295 ! CHECK: %[[selectC1:[0-9]+]] = arith.cmpi eq, %[[cmpC1]], %c0{{.*}} : i32 296 ! CHECK: cond_br %[[selectC1]], ^bb6, ^bb5 297 ! CHECK: ^bb5: // pred: ^bb4 298 ! CHECK: %[[cmpC2:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 299 ! CHECK: %[[selectC2:[0-9]+]] = arith.cmpi eq, %[[cmpC2]], %c0{{.*}} : i32 300 ! CHECK: cond_br %[[selectC2]], ^bb8, ^bb7 301 ! CHECK: ^bb6: // pred: ^bb4 302 ! CHECK: fir.call @_FortranAioBeginExternalListOutput 303 ! print*, n, 'c:case 2' 304 ! CHECK: br ^bb10 305 ! CHECK: ^bb7: // pred: ^bb5 306 ! CHECK: br ^bb9 307 ! CHECK: ^bb8: // pred: ^bb5 308 ! CHECK: br ^bb10 309 ! CHECK: ^bb9: // pred: ^bb7 310 ! CHECK: fir.call @_FortranAioBeginExternalListOutput 311 ! CHECK: br ^bb10 312 ! CHECK: ^bb10: // 3 preds: ^bb6, ^bb8, ^bb9 313 select case (char(ichar('0')+n)) 314 case ('1') 315 print*, n, 'c:case 1' 316 case ('2') 317 ! print*, n, 'c:case 2' 318 case default 319 print*, n, 'c:case default' 320 end select 321 ! CHECK: return 322 end subroutine 323 324 ! CHECK-LABEL: func @_QPsgoto 325 ! select case with goto exit 326 subroutine sgoto 327 n = 0 328 do i=1,8 329 ! CHECK: %[[i:[0-9]+]] = fir.alloca {{.*}} "_QFsgotoEi" 330 ! CHECK: ^bb2: // pred: ^bb1 331 ! CHECK: %[[selector:[0-9]+]] = fir.load %[[i]] : !fir.ref<i32> 332 ! CHECK: fir.select_case %[[selector]] : i32 [#fir.upper, %c2{{.*}}, ^bb3, #fir.lower, %c5{{.*}}, ^bb4, unit, ^bb7] 333 ! CHECK: ^bb3: // pred: ^bb2 334 ! CHECK: arith.muli %c10{{[^0]}} 335 ! CHECK: br ^bb8 336 ! CHECK: ^bb4: // pred: ^bb2 337 ! CHECK: arith.muli %c1000{{[^0]}} 338 ! CHECK: cond_br {{.*}}, ^bb5, ^bb6 339 ! CHECK: ^bb5: // pred: ^bb4 340 ! CHECK: br ^bb8 341 ! CHECK: ^bb6: // pred: ^bb4 342 ! CHECK: arith.muli %c10000{{[^0]}} 343 ! CHECK: br ^bb8 344 ! CHECK: ^bb7: // pred: ^bb2 345 ! CHECK: arith.muli %c100{{[^0]}} 346 ! CHECK: br ^bb8 347 ! CHECK: ^bb8: // 4 preds: ^bb3, ^bb5, ^bb6, ^bb7 348 ! CHECK: fir.call @_FortranAioBeginExternalListOutput 349 ! CHECK: br ^bb1 350 ! CHECK: ^bb9: // pred: ^bb1 351 select case(i) 352 case (:2) 353 n = i * 10 354 case (5:) 355 n = i * 1000 356 if (i <= 6) goto 9 357 n = i * 10000 358 case default 359 n = i * 100 360 9 end select 361 print*, n 362 enddo 363 ! CHECK: return 364 end 365 366 ! CHECK-LABEL: func @_QPswhere 367 subroutine swhere(num) 368 implicit none 369 370 integer, intent(in) :: num 371 real, dimension(1) :: array 372 373 array = 0.0 374 375 select case (num) 376 ! CHECK: ^bb1: // pred: ^bb0 377 case (1) 378 where (array >= 0.0) 379 array = 42 380 end where 381 ! CHECK: cf.br ^bb3 382 ! CHECK: ^bb2: // pred: ^bb0 383 case default 384 array = -1 385 end select 386 ! CHECK: cf.br ^bb3 387 ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 388 print*, array(1) 389 end subroutine swhere 390 391 ! CHECK-LABEL: func @_QPsforall 392 subroutine sforall(num) 393 implicit none 394 395 integer, intent(in) :: num 396 real, dimension(1) :: array 397 398 array = 0.0 399 400 select case (num) 401 ! CHECK: ^bb1: // pred: ^bb0 402 case (1) 403 where (array >= 0.0) 404 array = 42 405 end where 406 ! CHECK: cf.br ^bb3 407 ! CHECK: ^bb2: // pred: ^bb0 408 case default 409 array = -1 410 end select 411 ! CHECK: cf.br ^bb3 412 ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 413 print*, array(1) 414 end subroutine sforall 415 416 ! CHECK-LABEL: func @_QPsnested 417 subroutine snested(str) 418 character(*), optional :: str 419 integer :: num 420 421 if (present(str)) then 422 select case (trim(str)) 423 case ('a') 424 num = 10 425 case default 426 num = 20 427 end select 428 ! CHECK: ^bb5: // 2 preds: ^bb3, ^bb4 429 ! CHECK: fir.freemem %{{[0-9]+}} : !fir.heap<!fir.char<1,?>> 430 ! CHECK: cf.br ^bb7 431 else 432 num = 30 433 end if 434 ! CHECK: ^bb7: // 2 preds: ^bb5, ^bb6 435 end subroutine snested 436 437 ! CHECK-LABEL: main 438 program p 439 integer sinteger, v(10) 440 441 n = -10 442 do j = 1, 4 443 do k = 1, 10 444 n = n + 1 445 v(k) = sinteger(n) 446 enddo 447 ! expected output: 1 1 1 1 1 1 1 1 1 1 448 ! 1 2 3 4 4 6 7 7 7 7 449 ! 7 7 7 7 7 0 0 0 0 0 450 ! 7 7 7 7 7 7 7 7 7 7 451 print*, v 452 enddo 453 454 print* 455 call slogical(.false.) ! expected output: 0 1 0 3 1 1 3 1 456 call slogical(.true.) ! expected output: 0 0 2 3 2 3 2 2 457 458 print* 459 call scharacter('aa') ! expected output: 10 460 call scharacter('d') ! expected output: 10 461 call scharacter('f') ! expected output: -1 462 call scharacter('ff') ! expected output: 20 463 call scharacter('fff') ! expected output: 20 464 call scharacter('ffff') ! expected output: 20 465 call scharacter('fffff') ! expected output: -1 466 call scharacter('jj') ! expected output: -1 467 call scharacter('m') ! expected output: 30 468 call scharacter('q') ! expected output: -1 469 call scharacter('qq') ! expected output: 40 470 call scharacter('qqq') ! expected output: -1 471 call scharacter('vv') ! expected output: -1 472 call scharacter('xx') ! expected output: 50 473 call scharacter('zz') ! expected output: 50 474 475 print* 476 call scharacter1('99 ') ! expected output: 4 477 call scharacter1('88 ') ! expected output: 4 478 call scharacter1('77 ') ! expected output: 4 479 call scharacter1('66 ') ! expected output: 4 480 call scharacter1('55 ') ! expected output: 4 481 call scharacter1('44 ') ! expected output: 4 482 call scharacter1('33 ') ! expected output: 3 483 call scharacter1('22 ') ! expected output: 2 484 call scharacter1('11 ') ! expected output: 1 485 call scharacter1('00 ') ! expected output: 0 486 call scharacter1('. ') ! expected output: 0 487 call scharacter1(' ') ! expected output: 0 488 489 print* 490 call scharacter2('99 ') ! expected output: 9 -2 491 call scharacter2('22 ') ! expected output: 9 -2 492 call scharacter2('. ') ! expected output: 9 -2 493 call scharacter2(' ') ! expected output: 9 -2 494 495 print* 496 call sempty(0) ! expected output: 0 i:case default 0; c:case default 497 call sempty(1) ! expected output: 1 i:case 1; 1 c:case 1 498 call sempty(2) ! no output 499 call sempty(3) ! expected output: 3 i:case default; 3 c:case default 500 501 print* 502 call sgoto ! expected output: 10 20 300 400 5000 6000 70000 80000 503 504 print* 505 call swhere(1) ! expected output: 42. 506 call sforall(1) ! expected output: 42. 507 end 508