76 lines
2.7 KiB
Fortran
76 lines
2.7 KiB
Fortran
! Test forall lowering
|
|
|
|
! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
|
|
|
|
|
|
! Test a FORALL construct with a nested WHERE construct where the mask
|
|
! contains temporary array expressions.
|
|
|
|
subroutine test_nested_forall_where_with_temp_in_mask(a,b)
|
|
interface
|
|
function temp_foo(i, j)
|
|
integer :: i, j
|
|
real, allocatable :: temp_foo(:)
|
|
end function
|
|
end interface
|
|
type t
|
|
real data(100)
|
|
end type t
|
|
type(t) :: a(:,:), b(:,:)
|
|
forall (i=1:ubound(a,1), j=1:ubound(a,2))
|
|
where (b(j,i)%data > temp_foo(i, j))
|
|
a(i,j)%data = b(j,i)%data / 3.14
|
|
elsewhere
|
|
a(i,j)%data = -b(j,i)%data
|
|
end where
|
|
end forall
|
|
end subroutine
|
|
|
|
! CHECK: func @_QPtest_nested_forall_where_with_temp_in_mask({{.*}}) {
|
|
! CHECK: %[[tempResultBox:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = ".result"}
|
|
! Where condition pre-evaluation
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! Evaluation of mask for iteration (i,j) into ragged array temp
|
|
! CHECK: %[[tempResult:.*]] = fir.call @_QPtemp_foo
|
|
! CHECK: fir.save_result %[[tempResult]] to %[[tempResultBox]] : !fir.box<!fir.heap<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
|
|
! CHECK: fir.if {{.*}} {
|
|
! CHECK: @_FortranARaggedArrayAllocate
|
|
! CHECK: }
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! store into ragged array temp element
|
|
! CHECK: }
|
|
! CHECK: %[[box:.*]] = fir.load %[[tempResultBox]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
|
|
! CHECK: %[[tempAddr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
|
|
! local temps that were generated during the evaluation are cleaned-up after the value were stored
|
|
! into the ragged array temp.
|
|
! CHECK: fir.freemem %[[tempAddr]] : !fir.heap<!fir.array<?xf32>>
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! Where assignment
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! Array assignment at iteration (i, j)
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! CHECK: fir.if {{.*}} {
|
|
! CHECK: arith.divf
|
|
! CHECK: } else {
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! Elsewhere assignment
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! Array assignment at iteration (i, j)
|
|
! CHECK: fir.do_loop {{.*}} {
|
|
! CHECK: fir.if {{.*}} {
|
|
! CHECK: } else {
|
|
! CHECK: arith.negf
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! CHECK: }
|
|
! Ragged array clean-up
|
|
! CHECK: fir.call @_FortranARaggedArrayDeallocate
|
|
! CHECK: }
|