77 lines · plain
1! Test forall lowering2 3! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s4 5 6! Test a FORALL construct with a nested WHERE construct where the mask7! contains temporary array expressions.8 9subroutine test_nested_forall_where_with_temp_in_mask(a,b)10 interface11 function temp_foo(i, j)12 integer :: i, j13 real, allocatable :: temp_foo(:)14 end function15 end interface16 type t17 real data(100)18 end type t19 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.1423 elsewhere24 a(i,j)%data = -b(j,i)%data25 end where26 end forall27end subroutine28 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-evaluation32! CHECK: fir.do_loop {{.*}} {33! CHECK: fir.do_loop {{.*}} {34 ! Evaluation of mask for iteration (i,j) into ragged array temp35! CHECK: %[[tempResult:.*]] = fir.call @_QPtemp_foo36! 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: @_FortranARaggedArrayAllocate39! CHECK: }40! CHECK: fir.do_loop {{.*}} {41 ! store into ragged array temp element42! 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 stored46 ! into the ragged array temp.47! CHECK: fir.freemem %[[tempAddr]] : !fir.heap<!fir.array<?xf32>>48! CHECK: }49! CHECK: }50 ! Where assignment51! 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.divf57! CHECK: } else {58! CHECK: }59! CHECK: }60! CHECK: }61! CHECK: }62 ! Elsewhere assignment63! 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.negf70! CHECK: }71! CHECK: }72! CHECK: }73! CHECK: }74 ! Ragged array clean-up75! CHECK: fir.call @_FortranARaggedArrayDeallocate76! CHECK: }77