1! Test scheduling of WHERE in lower-hlfir-ordered-assignments pass. 2 3! RUN: bbc -hlfir -o - -pass-pipeline="builtin.module(lower-hlfir-ordered-assignments)" --debug-only=flang-ordered-assignment -flang-dbg-order-assignment-schedule-only %s 2>&1 | FileCheck %s 4! REQUIRES: asserts 5 6subroutine no_conflict(x, y) 7 real :: x(:), y(:) 8 where (y.gt.0) x = y 9end subroutine 10 11subroutine fake_conflict(x, y) 12 ! The conflict here could be avoided because the read and write are 13 ! aligned, so there would not be any read after write at the element 14 ! level, but this will require a bit more work to detect this (like 15 ! comparing the hlfir.designate operations). 16 real :: x(:), y(:) 17 where (x.gt.y) x = y 18end subroutine 19 20subroutine only_once(x, y, z) 21 interface 22 impure function call_me_only_once() 23 logical :: call_me_only_once(10) 24 end function 25 end interface 26 real :: x(:), y(:), z(:) 27 where (call_me_only_once()) 28 x = y 29 z = y 30 end where 31end subroutine 32 33subroutine rhs_lhs_conflict(x, y) 34 real :: x(:, :), y(:, :) 35 where (y.gt.0.) x = transpose(x) 36end subroutine 37 38subroutine where_construct_no_conflict(x, y, z, mask1, mask2) 39 real :: x(:), y(:), z(:) 40 logical :: mask1(:), mask2(:) 41 where (mask1) 42 x = y 43 elsewhere (mask2) 44 z = y 45 end where 46end subroutine 47 48subroutine where_construct_conflict(x, y) 49 real :: x(:, :), y(:, :) 50 where (y.gt.0.) 51 x = y 52 elsewhere (x.gt.0) 53 y = x 54 end where 55end subroutine 56 57subroutine where_construct_conflict_2(x, y) 58 real :: x(:, :), y(:, :) 59 where (x.gt.0.) 60 x = y 61 elsewhere (y.gt.0) 62 y = x 63 end where 64end subroutine 65 66subroutine where_vector_subscript_conflict_1(x, vec1) 67 real :: x(10) 68 integer :: vec1(10) 69 where (x(vec1).lt.0.) x = 42. 70end subroutine 71 72subroutine where_vector_subscript_conflict_2(x, vec1) 73 integer :: x(10) 74 real :: y(10) 75 where (y(x).lt.0.) x = 0 76end subroutine 77 78subroutine where_in_forall_conflict(x) 79 real :: x(:, :) 80 forall (i = 1:10) 81 where (x(i, :).gt.0) x(:, i) = x(i, :) 82 end forall 83end subroutine 84 85subroutine no_need_to_make_lhs_temp(x, y, i, j) 86 integer :: j, i, x(:, :), y(:, :) 87 call internal 88contains 89subroutine internal 90 ! The internal procedure context currently gives a hard time to 91 ! FIR alias analysis that flags the read of i,j and y as conflicting 92 ! with the write to x. But this is not a reason to create a temporary 93 ! storage for the LHS: the address is anyway fully computed in 94 ! a descriptor (fir.box) before assigning any element of x. 95 96 ! Note that the where mask is also saved while there is no real 97 ! need to: it is addressing x elements in the same order as they 98 ! are being assigned. But this will require more work in the 99 ! conflict analysis to prove that the lowered DAG of `x(:, y(i, j))` 100 ! are the same and that the access to this designator is done in the 101 ! same ordered inside the mask and LHS. 102 where (x(:, y(i, j)) == y(i, j)) x(:, y(i, j)) = 42 103end subroutine 104end subroutine 105 106subroutine where_construct_unknown_conflict(x, mask) 107 real :: x(:) 108 logical :: mask(:) 109 interface 110 real function f() 111 end function f 112 end interface 113 where (mask) x = f() 114end subroutine 115 116subroutine elsewhere_construct_unknown_conflict(x, y, mask1, mask2) 117 real :: x(:), y(:) 118 logical :: mask1(:), mask2(:) 119 interface 120 real function f() 121 end function f 122 end interface 123 where (mask1) 124 x = 1.0 125 elsewhere (mask2) 126 y = f() 127 end where 128end subroutine 129 130!CHECK-LABEL: ------------ scheduling where in _QPno_conflict ------------ 131!CHECK-NEXT: run 1 evaluate: where/region_assign1 132!CHECK-LABEL: ------------ scheduling where in _QPfake_conflict ------------ 133!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?xf32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?xf32>>' at index: 0 134!CHECK-NEXT: run 1 save : where/mask 135!CHECK-NEXT: run 2 evaluate: where/region_assign1 136!CHECK-LABEL: ------------ scheduling where in _QPonly_once ------------ 137!CHECK-NEXT: unknown effect: %11 = fir.call @_QPcall_me_only_once() fastmath<contract> : () -> !fir.array<10x!fir.logical<4>> 138!CHECK-NEXT: saving eval because write effect prevents re-evaluation 139!CHECK-NEXT: run 1 save (w): where/mask 140!CHECK-NEXT: run 2 evaluate: where/region_assign1 141!CHECK-NEXT: run 3 evaluate: where/region_assign2 142!CHECK-LABEL: ------------ scheduling where in _QPrhs_lhs_conflict ------------ 143!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 144!CHECK-NEXT: run 1 save : where/region_assign1/rhs 145!CHECK-NEXT: run 2 evaluate: where/region_assign1 146!CHECK-LABEL: ------------ scheduling where in _QPwhere_construct_no_conflict ------------ 147!CHECK-NEXT: run 1 evaluate: where/region_assign1 148!CHECK-NEXT: run 2 evaluate: where/elsewhere1/region_assign1 149!CHECK-LABEL: ------------ scheduling where in _QPwhere_construct_conflict ------------ 150!CHECK-NEXT: run 1 evaluate: where/region_assign1 151!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 1 152!CHECK-NEXT: run 2 save : where/mask 153!CHECK-NEXT: run 3 evaluate: where/elsewhere1/region_assign1 154!CHECK-LABEL: ------------ scheduling where in _QPwhere_construct_conflict_2 ------------ 155!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 156!CHECK-NEXT: run 1 save : where/mask 157!CHECK-NEXT: run 2 evaluate: where/region_assign1 158!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 1 159!CHECK-NEXT: run 3 save : where/elsewhere1/mask 160!CHECK-NEXT: run 4 evaluate: where/elsewhere1/region_assign1 161!CHECK-LABEL: ------------ scheduling where in _QPwhere_vector_subscript_conflict_1 ------------ 162!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.ref<!fir.array<10xf32>>' at index: 0 W:<block argument> of type '!fir.ref<!fir.array<10xf32>>' at index: 0 163!CHECK-NEXT: run 1 save : where/mask 164!CHECK-NEXT: run 2 evaluate: where/region_assign1 165!CHECK-LABEL: ------------ scheduling where in _QPwhere_vector_subscript_conflict_2 ------------ 166!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.ref<!fir.array<10xi32>>' at index: 0 W:<block argument> of type '!fir.ref<!fir.array<10xi32>>' at index: 0 167!CHECK-NEXT: run 1 save : where/mask 168!CHECK-NEXT: run 2 evaluate: where/region_assign1 169!CHECK-LABEL: ------------ scheduling forall in _QPwhere_in_forall_conflict ------------ 170!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 171!CHECK-NEXT: run 1 save : forall/where1/mask 172!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xf32>>' at index: 0 173!CHECK-NEXT: run 1 save : forall/where1/region_assign1/rhs 174!CHECK-NEXT: run 2 evaluate: forall/where1/region_assign1 175!CHECK-LABEL: ------------ scheduling where in _QFno_need_to_make_lhs_tempPinternal ------------ 176!CHECK-NEXT: conflict: R/W: %{{[0-9]+}} = fir.load %{{[0-9]+}} : !fir.llvm_ptr<!fir.ref<i32>> W:%{{[0-9]+}} = fir.load %{{[0-9]+}} : !fir.ref<!fir.box<!fir.array<?x?xi32>>> 177!CHECK-NEXT: run 1 save : where/mask 178!CHECK-NEXT: run 2 evaluate: where/region_assign1 179!CHECK-NEXT: ------------ scheduling where in _QPwhere_construct_unknown_conflict ------------ 180!CHECK-NEXT: unknown effect: %{{.*}} = fir.call @_QPf() fastmath<contract> : () -> f32 181!CHECK-NEXT: conflict: R/W: %{{.*}} = hlfir.declare %{{.*}} {uniq_name = "_QFwhere_construct_unknown_conflictEmask"} : (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>) W:<unknown> 182!CHECK-NEXT: run 1 save : where/mask 183!CHECK-NEXT: unknown effect: %{{.*}} = fir.call @_QPf() fastmath<contract> : () -> f32 184!CHECK-NEXT: saving eval because write effect prevents re-evaluation 185!CHECK-NEXT: run 2 save (w): where/region_assign1/rhs 186!CHECK-NEXT: run 3 evaluate: where/region_assign1 187!CHECK-NEXT: ------------ scheduling where in _QPelsewhere_construct_unknown_conflict ------------ 188!CHECK-NEXT: run 1 evaluate: where/region_assign1 189!CHECK-NEXT: unknown effect: %{{.*}} = fir.call @_QPf() fastmath<contract> : () -> f32 190!CHECK-NEXT: conflict: R/W: %{{.*}} = hlfir.declare %{{.*}} {uniq_name = "_QFelsewhere_construct_unknown_conflictEmask1"} : (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>) W:<unknown> 191!CHECK-NEXT: run 2 save : where/mask 192!CHECK-NEXT: conflict: R/W: %{{.*}} = hlfir.declare %{{.*}} {uniq_name = "_QFelsewhere_construct_unknown_conflictEmask2"} : (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>) W:<unknown> 193!CHECK-NEXT: run 2 save : where/elsewhere1/mask 194!CHECK-NEXT: unknown effect: %{{.*}} = fir.call @_QPf() fastmath<contract> : () -> f32 195!CHECK-NEXT: saving eval because write effect prevents re-evaluation 196!CHECK-NEXT: run 3 save (w): where/elsewhere1/region_assign1/rhs 197!CHECK-NEXT: run 4 evaluate: where/elsewhere1/region_assign1 198