| ! RUN: bbc -emit-fir -hlfir=false -o - %s | FileCheck %s | |
| ! CHECK-LABEL: sinteger | |
| function sinteger(n) | |
| integer sinteger | |
| nn = -88 | |
| ! CHECK: fir.select_case {{.*}} : i32 | |
| ! CHECK-SAME: upper, %c1 | |
| ! CHECK-SAME: point, %c2 | |
| ! CHECK-SAME: point, %c3 | |
| ! CHECK-SAME: interval, %c4{{.*}} %c5 | |
| ! CHECK-SAME: point, %c6 | |
| ! CHECK-SAME: point, %c7 | |
| ! CHECK-SAME: interval, %c8{{.*}} %c15 | |
| ! CHECK-SAME: lower, %c21 | |
| ! CHECK-SAME: unit | |
| select case(n) | |
| case (:1) | |
| nn = 1 | |
| case (2) | |
| nn = 2 | |
| case default | |
| nn = 0 | |
| case (3) | |
| nn = 3 | |
| case (4:5+1-1) | |
| nn = 4 | |
| case (6) | |
| nn = 6 | |
| case (7,8:15,21:) | |
| nn = 7 | |
| end select | |
| sinteger = nn | |
| end | |
| ! CHECK-LABEL: slogical | |
| subroutine slogical(L) | |
| logical :: L | |
| n1 = 0 | |
| n2 = 0 | |
| n3 = 0 | |
| n4 = 0 | |
| n5 = 0 | |
| n6 = 0 | |
| n7 = 0 | |
| n8 = 0 | |
| select case (L) | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %false | |
| ! CHECK: cond_br | |
| case (.false.) | |
| n2 = 1 | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %true | |
| ! CHECK: cond_br | |
| case (.true.) | |
| n3 = 2 | |
| end select | |
| select case (L) | |
| case default | |
| n4 = 3 | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %false | |
| ! CHECK: cond_br | |
| case (.false.) | |
| n5 = 1 | |
| ! CHECK: cmpi eq, {{.*}} %true | |
| ! CHECK: cond_br | |
| case (.true.) | |
| n5 = 2 | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %false | |
| ! CHECK: cond_br | |
| case (.false.) | |
| n6 = 1 | |
| case default | |
| n6 = 3 | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %true | |
| ! CHECK: cond_br | |
| case (.true.) | |
| n7 = 2 | |
| case default | |
| n7 = 3 | |
| end select | |
| select case (L) | |
| ! CHECK: cmpi eq, {{.*}} %false | |
| ! CHECK: cond_br | |
| case (.false.) | |
| n8 = 1 | |
| ! CHECK: cmpi eq, {{.*}} %true | |
| ! CHECK: cond_br | |
| case (.true.) | |
| n8 = 2 | |
| ! CHECK-NOT: constant 888 | |
| case default ! dead | |
| n8 = 888 | |
| end select | |
| print*, n1, n2, n3, n4, n5, n6, n7, n8 | |
| end | |
| ! CHECK-LABEL: scharacter | |
| subroutine scharacter(c) | |
| character(*) :: c | |
| nn = 0 | |
| select case (c) | |
| case default | |
| nn = -1 | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi sle, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| case (:'d') | |
| nn = 10 | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi sge, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi sle, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| case ('ff':'ffff') | |
| nn = 20 | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi eq, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| case ('m') | |
| nn = 30 | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi eq, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| case ('qq') | |
| nn = 40 | |
| ! CHECK: CharacterCompareScalar1 | |
| ! CHECK-NEXT: constant 0 | |
| ! CHECK-NEXT: cmpi sge, {{.*}} %c0 | |
| ! CHECK-NEXT: cond_br | |
| case ('x':) | |
| nn = 50 | |
| end select | |
| print*, nn | |
| end | |
| ! CHECK-LABEL: func @_QPscharacter1 | |
| subroutine scharacter1(s) | |
| ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> | |
| character(len=3) :: s | |
| ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFscharacter1En"} | |
| ! CHECK: fir.store %c0{{.*}} to %[[V_1]] : !fir.ref<i32> | |
| n = 0 | |
| ! CHECK: %[[V_8:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi sge, %[[V_8]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_9]], ^bb1, ^bb16 | |
| ! CHECK: ^bb1: // pred: ^bb0 | |
| if (lge(s,'00')) then | |
| ! CHECK: %[[V_18:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> | |
| ! CHECK: %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> | |
| ! CHECK: %[[V_42:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_43:[0-9]+]] = arith.cmpi eq, %[[V_42]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_43]], ^bb3, ^bb2 | |
| ! CHECK: ^bb2: // pred: ^bb1 | |
| select case(trim(s)) | |
| case('11') | |
| n = 1 | |
| case default | |
| continue | |
| ! CHECK: %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_49]], ^bb6, ^bb5 | |
| ! CHECK: ^bb3: // pred: ^bb1 | |
| ! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32> | |
| ! CHECK: ^bb4: // pred: ^bb13 | |
| ! CHECK: ^bb5: // pred: ^bb2 | |
| case('22') | |
| n = 2 | |
| ! CHECK: %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_55]], ^bb8, ^bb7 | |
| ! CHECK: ^bb6: // pred: ^bb2 | |
| ! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32> | |
| ! CHECK: ^bb7: // pred: ^bb5 | |
| case('33') | |
| n = 3 | |
| case('44':'55','66':'77','88':) | |
| n = 4 | |
| ! CHECK: %[[V_60:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_61:[0-9]+]] = arith.cmpi sge, %[[V_60]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_61]], ^bb9, ^bb10 | |
| ! CHECK: ^bb8: // pred: ^bb5 | |
| ! CHECK: fir.store %c3{{.*}} to %[[V_1]] : !fir.ref<i32> | |
| ! CHECK: ^bb9: // pred: ^bb7 | |
| ! CHECK: %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_67]], ^bb14, ^bb10 | |
| ! CHECK: ^bb10: // 2 preds: ^bb7, ^bb9 | |
| ! CHECK: %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_73:[0-9]+]] = arith.cmpi sge, %[[V_72]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_73]], ^bb11, ^bb12 | |
| ! CHECK: ^bb11: // pred: ^bb10 | |
| ! CHECK: %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32 | |
| ! CHECK: ^bb12: // 2 preds: ^bb10, ^bb11 | |
| ! CHECK: %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[V_85]], ^bb14, ^bb13 | |
| ! CHECK: ^bb13: // pred: ^bb12 | |
| ! CHECK: ^bb14: // 3 preds: ^bb9, ^bb11, ^bb12 | |
| ! CHECK: fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32> | |
| ! CHECK: ^bb15: // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14 | |
| ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>> | |
| end select | |
| end if | |
| ! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32> | |
| print*, n | |
| end subroutine | |
| ! CHECK-LABEL: func @_QPscharacter2 | |
| subroutine scharacter2(s) | |
| ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> | |
| ! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> | |
| character(len=3) :: s | |
| n = -10 | |
| ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> | |
| ! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> | |
| ! CHECK: br ^bb1 | |
| ! CHECK: ^bb1: // pred: ^bb0 | |
| ! CHECK: fir.store %c9{{.*}} | |
| ! CHECK: br ^bb2 | |
| ! CHECK: ^bb2: // pred: ^bb1 | |
| ! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>> | |
| select case(trim(s)) | |
| case default | |
| n = 9 | |
| end select | |
| print*, n | |
| n = -2 | |
| ! CHECK: %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> | |
| ! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> | |
| ! CHECK: br ^bb3 | |
| ! CHECK: ^bb3: // pred: ^bb2 | |
| ! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>> | |
| select case(trim(s)) | |
| end select | |
| print*, n | |
| end subroutine | |
| ! CHECK-LABEL: func @_QPsempty | |
| ! empty select case blocks | |
| subroutine sempty(n) | |
| ! CHECK: %[[selectI1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32> | |
| ! CHECK: fir.select_case %[[selectI1]] : i32 [#fir.point, %c1{{.*}}, ^bb1, #fir.point, %c2{{.*}}, ^bb2, unit, ^bb3] | |
| ! CHECK: ^bb1: // pred: ^bb0 | |
| ! CHECK: fir.call @_FortranAioBeginExternalListOutput | |
| ! CHECK: br ^bb4 | |
| ! CHECK: ^bb2: // pred: ^bb0 | |
| ! CHECK: br ^bb4 | |
| ! CHECK: ^bb3: // pred: ^bb0 | |
| ! CHECK: fir.call @_FortranAioBeginExternalListOutput | |
| ! CHECK: br ^bb4 | |
| select case (n) | |
| case (1) | |
| print*, n, 'i:case 1' | |
| case (2) | |
| ! print*, n, 'i:case 2' | |
| case default | |
| print*, n, 'i:case default' | |
| end select | |
| ! CHECK: ^bb4: // 3 preds: ^bb1, ^bb2, ^bb3 | |
| ! CHECK: %[[cmpC1:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[selectC1:[0-9]+]] = arith.cmpi eq, %[[cmpC1]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[selectC1]], ^bb6, ^bb5 | |
| ! CHECK: ^bb5: // pred: ^bb4 | |
| ! CHECK: %[[cmpC2:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1 | |
| ! CHECK: %[[selectC2:[0-9]+]] = arith.cmpi eq, %[[cmpC2]], %c0{{.*}} : i32 | |
| ! CHECK: cond_br %[[selectC2]], ^bb8, ^bb7 | |
| ! CHECK: ^bb6: // pred: ^bb4 | |
| ! CHECK: fir.call @_FortranAioBeginExternalListOutput | |
| ! print*, n, 'c:case 2' | |
| ! CHECK: br ^bb10 | |
| ! CHECK: ^bb7: // pred: ^bb5 | |
| ! CHECK: br ^bb9 | |
| ! CHECK: ^bb8: // pred: ^bb5 | |
| ! CHECK: br ^bb10 | |
| ! CHECK: ^bb9: // pred: ^bb7 | |
| ! CHECK: fir.call @_FortranAioBeginExternalListOutput | |
| ! CHECK: br ^bb10 | |
| ! CHECK: ^bb10: // 3 preds: ^bb6, ^bb8, ^bb9 | |
| select case (char(ichar('0')+n)) | |
| case ('1') | |
| print*, n, 'c:case 1' | |
| case ('2') | |
| ! print*, n, 'c:case 2' | |
| case default | |
| print*, n, 'c:case default' | |
| end select | |
| ! CHECK: return | |
| end subroutine | |
| ! CHECK-LABEL: func @_QPsgoto | |
| ! select case with goto exit | |
| subroutine sgoto | |
| n = 0 | |
| do i=1,8 | |
| ! CHECK: %[[i:[0-9]+]] = fir.alloca {{.*}} "_QFsgotoEi" | |
| ! CHECK: ^bb2: // pred: ^bb1 | |
| ! CHECK: %[[selector:[0-9]+]] = fir.load %[[i]] : !fir.ref<i32> | |
| ! CHECK: fir.select_case %[[selector]] : i32 [#fir.upper, %c2{{.*}}, ^bb3, #fir.lower, %c5{{.*}}, ^bb4, unit, ^bb7] | |
| ! CHECK: ^bb3: // pred: ^bb2 | |
| ! CHECK: arith.muli %c10{{[^0]}} | |
| ! CHECK: br ^bb8 | |
| ! CHECK: ^bb4: // pred: ^bb2 | |
| ! CHECK: arith.muli %c1000{{[^0]}} | |
| ! CHECK: cond_br {{.*}}, ^bb5, ^bb6 | |
| ! CHECK: ^bb5: // pred: ^bb4 | |
| ! CHECK: br ^bb8 | |
| ! CHECK: ^bb6: // pred: ^bb4 | |
| ! CHECK: arith.muli %c10000{{[^0]}} | |
| ! CHECK: br ^bb8 | |
| ! CHECK: ^bb7: // pred: ^bb2 | |
| ! CHECK: arith.muli %c100{{[^0]}} | |
| ! CHECK: br ^bb8 | |
| ! CHECK: ^bb8: // 4 preds: ^bb3, ^bb5, ^bb6, ^bb7 | |
| ! CHECK: fir.call @_FortranAioBeginExternalListOutput | |
| ! CHECK: br ^bb1 | |
| ! CHECK: ^bb9: // pred: ^bb1 | |
| select case(i) | |
| case (:2) | |
| n = i * 10 | |
| case (5:) | |
| n = i * 1000 | |
| if (i <= 6) goto 9 | |
| n = i * 10000 | |
| case default | |
| n = i * 100 | |
| 9 end select | |
| print*, n | |
| enddo | |
| ! CHECK: return | |
| end | |
| ! CHECK-LABEL: func @_QPswhere | |
| subroutine swhere(num) | |
| implicit none | |
| integer, intent(in) :: num | |
| real, dimension(1) :: array | |
| array = 0.0 | |
| select case (num) | |
| ! CHECK: ^bb1: // pred: ^bb0 | |
| case (1) | |
| where (array >= 0.0) | |
| array = 42 | |
| end where | |
| ! CHECK: cf.br ^bb3 | |
| ! CHECK: ^bb2: // pred: ^bb0 | |
| case default | |
| array = -1 | |
| end select | |
| ! CHECK: cf.br ^bb3 | |
| ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 | |
| print*, array(1) | |
| end subroutine swhere | |
| ! CHECK-LABEL: func @_QPsforall | |
| subroutine sforall(num) | |
| implicit none | |
| integer, intent(in) :: num | |
| real, dimension(1) :: array | |
| array = 0.0 | |
| select case (num) | |
| ! CHECK: ^bb1: // pred: ^bb0 | |
| case (1) | |
| where (array >= 0.0) | |
| array = 42 | |
| end where | |
| ! CHECK: cf.br ^bb3 | |
| ! CHECK: ^bb2: // pred: ^bb0 | |
| case default | |
| array = -1 | |
| end select | |
| ! CHECK: cf.br ^bb3 | |
| ! CHECK: ^bb3: // 2 preds: ^bb1, ^bb2 | |
| print*, array(1) | |
| end subroutine sforall | |
| ! CHECK-LABEL: func @_QPsnested | |
| subroutine snested(str) | |
| character(*), optional :: str | |
| integer :: num | |
| if (present(str)) then | |
| select case (trim(str)) | |
| case ('a') | |
| num = 10 | |
| case default | |
| num = 20 | |
| end select | |
| ! CHECK: ^bb5: // 2 preds: ^bb3, ^bb4 | |
| ! CHECK: fir.freemem %{{[0-9]+}} : !fir.heap<!fir.char<1,?>> | |
| ! CHECK: cf.br ^bb7 | |
| else | |
| num = 30 | |
| end if | |
| ! CHECK: ^bb7: // 2 preds: ^bb5, ^bb6 | |
| end subroutine snested | |
| ! CHECK-LABEL: main | |
| program p | |
| integer sinteger, v(10) | |
| n = -10 | |
| do j = 1, 4 | |
| do k = 1, 10 | |
| n = n + 1 | |
| v(k) = sinteger(n) | |
| enddo | |
| ! expected output: 1 1 1 1 1 1 1 1 1 1 | |
| ! 1 2 3 4 4 6 7 7 7 7 | |
| ! 7 7 7 7 7 0 0 0 0 0 | |
| ! 7 7 7 7 7 7 7 7 7 7 | |
| print*, v | |
| enddo | |
| print* | |
| call slogical(.false.) ! expected output: 0 1 0 3 1 1 3 1 | |
| call slogical(.true.) ! expected output: 0 0 2 3 2 3 2 2 | |
| print* | |
| call scharacter('aa') ! expected output: 10 | |
| call scharacter('d') ! expected output: 10 | |
| call scharacter('f') ! expected output: -1 | |
| call scharacter('ff') ! expected output: 20 | |
| call scharacter('fff') ! expected output: 20 | |
| call scharacter('ffff') ! expected output: 20 | |
| call scharacter('fffff') ! expected output: -1 | |
| call scharacter('jj') ! expected output: -1 | |
| call scharacter('m') ! expected output: 30 | |
| call scharacter('q') ! expected output: -1 | |
| call scharacter('qq') ! expected output: 40 | |
| call scharacter('qqq') ! expected output: -1 | |
| call scharacter('vv') ! expected output: -1 | |
| call scharacter('xx') ! expected output: 50 | |
| call scharacter('zz') ! expected output: 50 | |
| print* | |
| call scharacter1('99 ') ! expected output: 4 | |
| call scharacter1('88 ') ! expected output: 4 | |
| call scharacter1('77 ') ! expected output: 4 | |
| call scharacter1('66 ') ! expected output: 4 | |
| call scharacter1('55 ') ! expected output: 4 | |
| call scharacter1('44 ') ! expected output: 4 | |
| call scharacter1('33 ') ! expected output: 3 | |
| call scharacter1('22 ') ! expected output: 2 | |
| call scharacter1('11 ') ! expected output: 1 | |
| call scharacter1('00 ') ! expected output: 0 | |
| call scharacter1('. ') ! expected output: 0 | |
| call scharacter1(' ') ! expected output: 0 | |
| print* | |
| call scharacter2('99 ') ! expected output: 9 -2 | |
| call scharacter2('22 ') ! expected output: 9 -2 | |
| call scharacter2('. ') ! expected output: 9 -2 | |
| call scharacter2(' ') ! expected output: 9 -2 | |
| print* | |
| call sempty(0) ! expected output: 0 i:case default 0; c:case default | |
| call sempty(1) ! expected output: 1 i:case 1; 1 c:case 1 | |
| call sempty(2) ! no output | |
| call sempty(3) ! expected output: 3 i:case default; 3 c:case default | |
| print* | |
| call sgoto ! expected output: 10 20 300 400 5000 6000 70000 80000 | |
| print* | |
| call swhere(1) ! expected output: 42. | |
| call sforall(1) ! expected output: 42. | |
| end |