1! Test forall lowering 2 3! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 4 5 6! Test a FORALL construct with a nested WHERE construct where the mask 7! contains temporary array expressions. 8 9subroutine test_nested_forall_where_with_temp_in_mask(a,b) 10 interface 11 function temp_foo(i, j) 12 integer :: i, j 13 real, allocatable :: temp_foo(:) 14 end function 15 end interface 16 type t 17 real data(100) 18 end type t 19 type(t) :: a(:,:), b(:,:) 20 forall (i=1:ubound(a,1), j=1:ubound(a,2)) 21 where (b(j,i)%data > temp_foo(i, j)) 22 a(i,j)%data = b(j,i)%data / 3.14 23 elsewhere 24 a(i,j)%data = -b(j,i)%data 25 end where 26 end forall 27end subroutine 28 29! CHECK: func @_QPtest_nested_forall_where_with_temp_in_mask({{.*}}) { 30! CHECK: %[[tempResultBox:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = ".result"} 31 ! Where condition pre-evaluation 32! CHECK: fir.do_loop {{.*}} { 33! CHECK: fir.do_loop {{.*}} { 34 ! Evaluation of mask for iteration (i,j) into ragged array temp 35! CHECK: %[[tempResult:.*]] = fir.call @_QPtemp_foo 36! CHECK: fir.save_result %[[tempResult]] to %[[tempResultBox]] : !fir.box<!fir.heap<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 37! CHECK: fir.if {{.*}} { 38! CHECK: @_FortranARaggedArrayAllocate 39! CHECK: } 40! CHECK: fir.do_loop {{.*}} { 41 ! store into ragged array temp element 42! CHECK: } 43! CHECK: %[[box:.*]] = fir.load %[[tempResultBox]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 44! CHECK: %[[tempAddr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 45 ! local temps that were generated during the evaluation are cleaned-up after the value were stored 46 ! into the ragged array temp. 47! CHECK: fir.freemem %[[tempAddr]] : !fir.heap<!fir.array<?xf32>> 48! CHECK: } 49! CHECK: } 50 ! Where assignment 51! CHECK: fir.do_loop {{.*}} { 52! CHECK: fir.do_loop {{.*}} { 53 ! Array assignment at iteration (i, j) 54! CHECK: fir.do_loop {{.*}} { 55! CHECK: fir.if {{.*}} { 56! CHECK: arith.divf 57! CHECK: } else { 58! CHECK: } 59! CHECK: } 60! CHECK: } 61! CHECK: } 62 ! Elsewhere assignment 63! CHECK: fir.do_loop {{.*}} { 64! CHECK: fir.do_loop {{.*}} { 65 ! Array assignment at iteration (i, j) 66! CHECK: fir.do_loop {{.*}} { 67! CHECK: fir.if {{.*}} { 68! CHECK: } else { 69! CHECK: arith.negf 70! CHECK: } 71! CHECK: } 72! CHECK: } 73! CHECK: } 74 ! Ragged array clean-up 75! CHECK: fir.call @_FortranARaggedArrayDeallocate 76! CHECK: } 77