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 @_QPtest_char_temp_selector
162  subroutine test_char_temp_selector()
163    ! Test that character selector that are temps are deallocated
164    ! only after they have been used in the select case comparisons.
165    interface
166      function gen_char_temp_selector()
167        character(:), allocatable :: gen_char_temp_selector
168      end function
169    end interface
170    select case (gen_char_temp_selector())
171    case ('case1')
172      call foo1()
173    case ('case2')
174      call foo2()
175    case ('case3')
176      call foo3()
177    case default
178      call foo_default()
179    end select
180    ! CHECK:   %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {bindc_name = ".result"}
181    ! CHECK:   %[[VAL_1:.*]] = fir.call @_QPgen_char_temp_selector() : () -> !fir.box<!fir.heap<!fir.char<1,?>>>
182    ! CHECK:   fir.save_result %[[VAL_1]] to %[[VAL_0]] : !fir.box<!fir.heap<!fir.char<1,?>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
183    ! CHECK:   cond_br %{{.*}}, ^bb2, ^bb1
184    ! CHECK: ^bb1:
185    ! CHECK:   cond_br %{{.*}}, ^bb4, ^bb3
186    ! CHECK: ^bb2:
187    ! CHECK:   fir.call @_QPfoo1() : () -> ()
188    ! CHECK:   br ^bb8
189    ! CHECK: ^bb3:
190    ! CHECK:   cond_br %{{.*}}, ^bb6, ^bb5
191    ! CHECK: ^bb4:
192    ! CHECK:   fir.call @_QPfoo2() : () -> ()
193    ! CHECK:   br ^bb8
194    ! CHECK: ^bb5:
195    ! CHECK:   br ^bb7
196    ! CHECK: ^bb6:
197    ! CHECK:   fir.call @_QPfoo3() : () -> ()
198    ! CHECK:   br ^bb8
199    ! CHECK: ^bb7:
200    ! CHECK:   fir.call @_QPfoo_default() : () -> ()
201    ! CHECK:   br ^bb8
202    ! CHECK: ^bb8:
203    ! CHECK:   %[[VAL_36:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
204    ! CHECK:   %[[VAL_37:.*]] = fir.box_addr %[[VAL_36]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
205    ! CHECK:   %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (!fir.heap<!fir.char<1,?>>) -> i64
206    ! CHECK:   %[[VAL_39:.*]] = arith.constant 0 : i64
207    ! CHECK:   %[[VAL_40:.*]] = arith.cmpi ne, %[[VAL_38]], %[[VAL_39]] : i64
208    ! CHECK:   fir.if %[[VAL_40]] {
209    ! CHECK:     fir.freemem %[[VAL_37]]
210    ! CHECK:   }
211  end subroutine
212