1! RUN: %flang_fc1 -emit-hlfir -o - %s | FileCheck %s 2 3! Simple tests for structured concurrent loops with loop-control. 4 5pure function bar(n, m) 6 implicit none 7 integer, intent(in) :: n, m 8 integer :: bar 9 bar = n + m 10end function 11 12!CHECK-LABEL: sub1 13subroutine sub1(n) 14 implicit none 15 integer :: n, m, i, j, k 16 integer, dimension(n) :: a 17!CHECK: %[[LB1:.*]] = arith.constant 1 : i32 18!CHECK: %[[LB1_CVT:.*]] = fir.convert %[[LB1]] : (i32) -> index 19!CHECK: %[[UB1:.*]] = fir.load %{{.*}}#0 : !fir.ref<i32> 20!CHECK: %[[UB1_CVT:.*]] = fir.convert %[[UB1]] : (i32) -> index 21 22!CHECK: %[[LB2:.*]] = arith.constant 1 : i32 23!CHECK: %[[LB2_CVT:.*]] = fir.convert %[[LB2]] : (i32) -> index 24!CHECK: %[[UB2:.*]] = fir.call @_QPbar(%{{.*}}, %{{.*}}) proc_attrs<pure> fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> i32 25!CHECK: %[[UB2_CVT:.*]] = fir.convert %[[UB2]] : (i32) -> index 26 27!CHECK: %[[LB3:.*]] = arith.constant 5 : i32 28!CHECK: %[[LB3_CVT:.*]] = fir.convert %[[LB3]] : (i32) -> index 29!CHECK: %[[UB3:.*]] = arith.constant 10 : i32 30!CHECK: %[[UB3_CVT:.*]] = fir.convert %[[UB3]] : (i32) -> index 31 32!CHECK: fir.do_loop %{{.*}} = %[[LB1_CVT]] to %[[UB1_CVT]] step %{{.*}} unordered 33!CHECK: fir.do_loop %{{.*}} = %[[LB2_CVT]] to %[[UB2_CVT]] step %{{.*}} unordered 34!CHECK: fir.do_loop %{{.*}} = %[[LB3_CVT]] to %[[UB3_CVT]] step %{{.*}} unordered 35 36 do concurrent(i=1:n, j=1:bar(n*m, n/m), k=5:10) 37 a(i) = n 38 end do 39end subroutine 40 41!CHECK-LABEL: sub2 42subroutine sub2(n) 43 implicit none 44 integer :: n, m, i, j 45 integer, dimension(n) :: a 46!CHECK: %[[LB1:.*]] = arith.constant 1 : i32 47!CHECK: %[[LB1_CVT:.*]] = fir.convert %[[LB1]] : (i32) -> index 48!CHECK: %[[UB1:.*]] = fir.load %5#0 : !fir.ref<i32> 49!CHECK: %[[UB1_CVT:.*]] = fir.convert %[[UB1]] : (i32) -> index 50!CHECK: fir.do_loop %{{.*}} = %[[LB1_CVT]] to %[[UB1_CVT]] step %{{.*}} unordered 51!CHECK: %[[LB2:.*]] = arith.constant 1 : i32 52!CHECK: %[[LB2_CVT:.*]] = fir.convert %[[LB2]] : (i32) -> index 53!CHECK: %[[UB2:.*]] = fir.call @_QPbar(%{{.*}}, %{{.*}}) proc_attrs<pure> fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> i32 54!CHECK: %[[UB2_CVT:.*]] = fir.convert %[[UB2]] : (i32) -> index 55!CHECK: fir.do_loop %{{.*}} = %[[LB2_CVT]] to %[[UB2_CVT]] step %{{.*}} unordered 56 do concurrent(i=1:n) 57 do concurrent(j=1:bar(n*m, n/m)) 58 a(i) = n 59 end do 60 end do 61end subroutine 62 63 64!CHECK-LABEL: unstructured 65subroutine unstructured(inner_step) 66 integer(4) :: i, j, inner_step 67 68!CHECK-NOT: cf.br 69!CHECK-NOT: cf.cond_br 70!CHECK: %[[LB1:.*]] = arith.constant 1 : i32 71!CHECK: %[[LB1_CVT:.*]] = fir.convert %c1_i32 : (i32) -> i16 72!CHECK: %[[UB1:.*]] = arith.constant 5 : i32 73!CHECK: %[[UB1_CVT:.*]] = fir.convert %c5_i32 : (i32) -> i16 74!CHECK: %[[STP1:.*]] = arith.constant 1 : i16 75 76!CHECK-NOT: cf.br 77!CHECK-NOT: cf.cond_br 78!CHECK: %[[LB2:.*]] = arith.constant 3 : i32 79!CHECK: %[[LB2_CVT:.*]] = fir.convert %[[LB2]] : (i32) -> i16 80!CHECK: %[[UB2:.*]] = arith.constant 9 : i32 81!CHECK: %[[UB2_CVT:.*]] = fir.convert %[[UB2]] : (i32) -> i16 82!CHECK: %[[STP2:.*]] = fir.load %{{.*}}#0 : !fir.ref<i32> 83!CHECK: %[[STP2_CVT:.*]] = fir.convert %[[STP2]] : (i32) -> i16 84!CHECK: fir.store %[[STP2_CVT]] to %{{.*}} : !fir.ref<i16> 85!CHECK: cf.br ^[[I_LOOP_HEADER:.*]] 86 87!CHECK: ^[[I_LOOP_HEADER]]: 88!CHECK-NEXT: %{{.*}} = fir.load %{{.*}} : !fir.ref<i16> 89!CHECK-NEXT: %{{.*}} = arith.constant 0 : i16 90!CHECK-NEXT: %{{.*}} = arith.cmpi sgt, %{{.*}}, %{{.*}}: i16 91!CHECK-NEXT: cf.cond_br %{{.*}}, ^[[J_LOOP_HEADER:.*]], ^{{.*}} 92 93!CHECK: ^[[J_LOOP_HEADER]]: 94!CHECK-NEXT: %[[RANGE:.*]] = arith.subi %[[UB2_CVT]], %[[LB2_CVT]] : i16 95!CHECK-NEXT: %{{.*}} = arith.addi %[[RANGE]], %[[STP2_CVT]] : i16 96!CHECK-NEXT: %{{.*}} = arith.divsi %{{.*}}, %[[STP2_CVT]] : i16 97 do concurrent (integer(2)::i=1:5, j=3:9:inner_step, i.ne.3) 98 goto (7, 7) i+1 99 print*, 'E:', i, j 100 7 continue 101 enddo 102end subroutine unstructured 103