flang/test/Lower/forall/forall-where-2.f90

   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
   9 subroutine 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
  27 end 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:  }