flang/test/Lower/select-case-statement.f90

   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