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

   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, ^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:   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:  // 5 preds: ^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   ! CHECK-LABEL: func @_QPscharacter2
 256   subroutine scharacter2(s)
 257     ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
 258     ! CHECK:   %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
 259     character(len=3) :: s
 260     n = 0
 261
 262     ! CHECK:   %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
 263     ! CHECK:   %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
 264     ! CHECK:   fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
 265     ! CHECK:   br ^bb1
 266     ! CHECK: ^bb1:  // pred: ^bb0
 267     ! CHECK:   br ^bb2
 268     n = -10
 269     select case(trim(s))
 270     case default
 271       n = 9
 272     end select
 273     print*, n
 274
 275     ! CHECK: ^bb2:  // pred: ^bb1
 276     ! CHECK:   %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
 277     ! CHECK:   %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
 278     ! CHECK:   fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
 279     ! CHECK:   br ^bb3
 280     ! CHECK: ^bb3:  // pred: ^bb2
 281     n = -2
 282     select case(trim(s))
 283     end select
 284     print*, n
 285   end subroutine
 286
 287   ! CHECK-LABEL: func @_QPsempty
 288   ! empty select case blocks
 289   subroutine sempty(n)
 290     ! CHECK:   %[[selectI1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
 291     ! CHECK:   fir.select_case %[[selectI1]] : i32 [#fir.point, %c1{{.*}}, ^bb1, #fir.point, %c2{{.*}}, ^bb2, unit, ^bb3]
 292     ! CHECK: ^bb1:  // pred: ^bb0
 293     ! CHECK:   fir.call @_FortranAioBeginExternalListOutput
 294     ! CHECK:   br ^bb4
 295     ! CHECK: ^bb2:  // pred: ^bb0
 296     ! CHECK:   br ^bb4
 297     ! CHECK: ^bb3:  // pred: ^bb0
 298     ! CHECK:   fir.call @_FortranAioBeginExternalListOutput
 299     ! CHECK:   br ^bb4
 300     select case (n)
 301       case (1)
 302         print*, n, 'i:case 1'
 303       case (2)
 304       ! print*, n, 'i:case 2'
 305       case default
 306         print*, n, 'i:case default'
 307     end select
 308     ! CHECK: ^bb4:  // 3 preds: ^bb1, ^bb2, ^bb3
 309     ! CHECK:   %[[cmpC1:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
 310     ! CHECK:   %[[selectC1:[0-9]+]] = arith.cmpi eq, %[[cmpC1]], %c0{{.*}} : i32
 311     ! CHECK:   cond_br %[[selectC1]], ^bb6, ^bb5
 312     ! CHECK: ^bb5:  // pred: ^bb4
 313     ! CHECK:   %[[cmpC2:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
 314     ! CHECK:   %[[selectC2:[0-9]+]] = arith.cmpi eq, %[[cmpC2]], %c0{{.*}} : i32
 315     ! CHECK:   cond_br %[[selectC2]], ^bb8, ^bb7
 316     ! CHECK: ^bb6:  // pred: ^bb4
 317     ! CHECK:   fir.call @_FortranAioBeginExternalListOutput
 318     ! print*, n, 'c:case 2'
 319     ! CHECK:   br ^bb10
 320     ! CHECK: ^bb7:  // pred: ^bb5
 321     ! CHECK:   br ^bb9
 322     ! CHECK: ^bb8:  // pred: ^bb5
 323     ! CHECK:   br ^bb10
 324     ! CHECK: ^bb9:  // pred: ^bb7
 325     ! CHECK:   fir.call @_FortranAioBeginExternalListOutput
 326     ! CHECK:   br ^bb10
 327     ! CHECK: ^bb10:  // 3 preds: ^bb6, ^bb8, ^bb9
 328     select case (char(ichar('0')+n))
 329       case ('1')
 330         print*, n, 'c:case 1'
 331       case ('2')
 332       ! print*, n, 'c:case 2'
 333       case default
 334         print*, n, 'c:case default'
 335     end select
 336     ! CHECK:   return
 337   end subroutine
 338
 339   ! CHECK-LABEL: func @_QPsgoto
 340   ! select case with goto exit
 341   subroutine sgoto
 342     n = 0
 343     do i=1,8
 344       ! CHECK:   %[[i:[0-9]+]] = fir.alloca {{.*}} "_QFsgotoEi"
 345       ! CHECK: ^bb2:  // pred: ^bb1
 346       ! CHECK:   %[[selector:[0-9]+]] = fir.load %[[i]] : !fir.ref<i32>
 347       ! CHECK:   fir.select_case %[[selector]] : i32 [#fir.upper, %c2{{.*}}, ^bb3, #fir.lower, %c5{{.*}}, ^bb4, unit, ^bb7]
 348       ! CHECK: ^bb3:  // pred: ^bb2
 349       ! CHECK:   arith.muli %c10{{[^0]}}
 350       ! CHECK:   br ^bb8
 351       ! CHECK: ^bb4:  // pred: ^bb2
 352       ! CHECK:   arith.muli %c1000{{[^0]}}
 353       ! CHECK:   cond_br {{.*}}, ^bb5, ^bb6
 354       ! CHECK: ^bb5:  // pred: ^bb4
 355       ! CHECK:   br ^bb8
 356       ! CHECK: ^bb6:  // pred: ^bb4
 357       ! CHECK:   arith.muli %c10000{{[^0]}}
 358       ! CHECK:   br ^bb8
 359       ! CHECK: ^bb7:  // pred: ^bb2
 360       ! CHECK:   arith.muli %c100{{[^0]}}
 361       ! CHECK:   br ^bb8
 362       ! CHECK: ^bb8:  // 4 preds: ^bb3, ^bb5, ^bb6, ^bb7
 363       ! CHECK:   fir.call @_FortranAioBeginExternalListOutput
 364       ! CHECK:   br ^bb1
 365       ! CHECK: ^bb9:  // pred: ^bb1
 366       select case(i)
 367       case (:2)
 368         n = i * 10
 369       case (5:)
 370         n = i * 1000
 371         if (i <= 6) goto 9
 372         n = i * 10000
 373       case default
 374         n = i * 100
 375   9   end select
 376       print*, n
 377     enddo
 378     ! CHECK:   return
 379   end
 380
 381   ! CHECK-LABEL: func @_QPswhere
 382   subroutine swhere(num)
 383     implicit none
 384
 385     integer, intent(in) :: num
 386     real, dimension(1) :: array
 387
 388     array = 0.0
 389
 390     select case (num)
 391     ! CHECK: ^bb1:  // pred: ^bb0
 392     case (1)
 393       where (array >= 0.0)
 394         array = 42
 395       end where
 396     ! CHECK: cf.br ^bb3
 397     ! CHECK: ^bb2:  // pred: ^bb0
 398     case default
 399       array = -1
 400     end select
 401     ! CHECK: cf.br ^bb3
 402     ! CHECK: ^bb3:  // 2 preds: ^bb1, ^bb2
 403     print*, array(1)
 404   end subroutine swhere
 405
 406   ! CHECK-LABEL: func @_QPsforall
 407   subroutine sforall(num)
 408     implicit none
 409
 410     integer, intent(in) :: num
 411     real, dimension(1) :: array
 412
 413     array = 0.0
 414
 415     select case (num)
 416     ! CHECK: ^bb1:  // pred: ^bb0
 417     case (1)
 418       where (array >= 0.0)
 419         array = 42
 420       end where
 421     ! CHECK: cf.br ^bb3
 422     ! CHECK: ^bb2:  // pred: ^bb0
 423     case default
 424       array = -1
 425     end select
 426     ! CHECK: cf.br ^bb3
 427     ! CHECK: ^bb3:  // 2 preds: ^bb1, ^bb2
 428     print*, array(1)
 429   end subroutine sforall
 430
 431   ! CHECK-LABEL: main
 432   program p
 433     integer sinteger, v(10)
 434
 435     n = -10
 436     do j = 1, 4
 437       do k = 1, 10
 438         n = n + 1
 439         v(k) = sinteger(n)
 440       enddo
 441       ! expected output:  1 1 1 1 1 1 1 1 1 1
 442       !                   1 2 3 4 4 6 7 7 7 7
 443       !                   7 7 7 7 7 0 0 0 0 0
 444       !                   7 7 7 7 7 7 7 7 7 7
 445       print*, v
 446     enddo
 447
 448     print*
 449     call slogical(.false.)    ! expected output:  0 1 0 3 1 1 3 1
 450     call slogical(.true.)     ! expected output:  0 0 2 3 2 3 2 2
 451
 452     print*
 453     call scharacter('aa')     ! expected output: 10
 454     call scharacter('d')      ! expected output: 10
 455     call scharacter('f')      ! expected output: -1
 456     call scharacter('ff')     ! expected output: 20
 457     call scharacter('fff')    ! expected output: 20
 458     call scharacter('ffff')   ! expected output: 20
 459     call scharacter('fffff')  ! expected output: -1
 460     call scharacter('jj')     ! expected output: -1
 461     call scharacter('m')      ! expected output: 30
 462     call scharacter('q')      ! expected output: -1
 463     call scharacter('qq')     ! expected output: 40
 464     call scharacter('qqq')    ! expected output: -1
 465     call scharacter('vv')     ! expected output: -1
 466     call scharacter('xx')     ! expected output: 50
 467     call scharacter('zz')     ! expected output: 50
 468
 469     print*
 470     call scharacter1('99 ')   ! expected output:  4
 471     call scharacter1('88 ')   ! expected output:  4
 472     call scharacter1('77 ')   ! expected output:  4
 473     call scharacter1('66 ')   ! expected output:  4
 474     call scharacter1('55 ')   ! expected output:  4
 475     call scharacter1('44 ')   ! expected output:  4
 476     call scharacter1('33 ')   ! expected output:  3
 477     call scharacter1('22 ')   ! expected output:  2
 478     call scharacter1('11 ')   ! expected output:  1
 479     call scharacter1('00 ')   ! expected output:  0
 480     call scharacter1('.  ')   ! expected output:  0
 481     call scharacter1('   ')   ! expected output:  0
 482
 483     print*
 484     call scharacter2('99 ')   ! expected output:  9 -2
 485     call scharacter2('22 ')   ! expected output:  9 -2
 486     call scharacter2('.  ')   ! expected output:  9 -2
 487     call scharacter2('   ')   ! expected output:  9 -2
 488
 489     print*
 490     call sempty(0)            ! expected output: 0 i:case default 0; c:case default
 491     call sempty(1)            ! expected output: 1 i:case 1; 1 c:case 1
 492     call sempty(2)            ! no output
 493     call sempty(3)            ! expected output: 3 i:case default; 3 c:case default
 494
 495     print*
 496     call sgoto                ! expected output:  10 20 300 400 5000 6000 70000 80000
 497
 498     print*
 499     call swhere(1)            ! expected output: 42.
 500     call sforall(1)           ! expected output: 42.
 501   end