1! Test forall scheduling analysis from lower-hlfir-ordered-assignments pass. 2! The printed output is done via LLVM_DEBUG, hence the "asserts" requirement. 3! This test test that conflicting actions are not scheduled to be evaluated 4! in the same loops (same run id). 5 6! 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 7! REQUIRES: asserts 8 9subroutine no_conflict(x) 10 real :: x(:) 11 forall(i=1:10) x(i) = i 12end subroutine 13!CHECK-LABEL: ------------ scheduling forall in _QPno_conflict ------------ 14!CHECK-NEXT: run 1 evaluate: forall/region_assign1 15 16subroutine rhs_lhs_overlap(x) 17 real :: x(:) 18 forall(i=1:10) x(i) = x(11-i) 19end subroutine 20!CHECK-LABEL: ------------ scheduling forall in _QPrhs_lhs_overlap ------------ 21!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 22!CHECK-NEXT: run 1 save : forall/region_assign1/rhs 23!CHECK-NEXT: run 2 evaluate: forall/region_assign1 24 25subroutine no_rhs_lhs_overlap(x, y) 26 real :: x(:), y(:) 27 forall(i=1:10) x(i) = y(i) 28end subroutine 29!CHECK-LABEL: ------------ scheduling forall in _QPno_rhs_lhs_overlap ------------ 30!CHECK-NEXT: run 1 evaluate: forall/region_assign1 31 32subroutine no_rhs_lhs_overlap_2(x) 33 real :: x(:), y(10) 34 forall(i=1:10) x(i) = y(i) 35end subroutine 36!CHECK-LABEL: ------------ scheduling forall in _QPno_rhs_lhs_overlap_2 ------------ 37!CHECK-NEXT: run 1 evaluate: forall/region_assign1 38 39subroutine no_rhs_lhs_overlap_3() 40 real :: x(10), y(10) 41 forall(i=1:10) x(i) = y(i) 42end subroutine 43!CHECK-LABEL: ------------ scheduling forall in _QPno_rhs_lhs_overlap_3 ------------ 44!CHECK-NEXT: run 1 evaluate: forall/region_assign1 45 46subroutine array_expr_rhs_lhs_overlap(x) 47 real :: x(:, :) 48 forall(i=1:10) x(i, :) = x(:, i)*2 49end subroutine 50!CHECK-LABEL: ------------ scheduling forall in _QParray_expr_rhs_lhs_overlap ------------ 51!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 52!CHECK-NEXT: run 1 save : forall/region_assign1/rhs 53!CHECK-NEXT: run 2 evaluate: forall/region_assign1 54 55subroutine array_expr_no_rhs_lhs_overlap(x, y, z) 56 real :: x(:, :), y(:, :), z(:, :) 57 forall(i=1:10) x(i, :) = y(:, i) + z(i, :) 58end subroutine 59!CHECK-LABEL: ------------ scheduling forall in _QParray_expr_no_rhs_lhs_overlap ------------ 60!CHECK-NEXT: run 1 evaluate: forall/region_assign1 61 62subroutine rhs_lhs_overlap_2(x, y) 63 real, target :: x(:), y(:) 64 forall(i=1:10) x(i) = y(i) 65end subroutine 66!CHECK-LABEL: ------------ scheduling forall in _QPrhs_lhs_overlap_2 ------------ 67!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?xf32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?xf32>>' at index: 0 68!CHECK-NEXT: run 1 save : forall/region_assign1/rhs 69!CHECK-NEXT: run 2 evaluate: forall/region_assign1 70 71subroutine lhs_lhs_overlap(x) 72 integer :: x(10) 73 forall(i=1:10) x(x(i)) = i 74end subroutine 75!CHECK-LABEL: ------------ scheduling forall in _QPlhs_lhs_overlap ------------ 76!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 77!CHECK-NEXT: run 1 save : forall/region_assign1/lhs 78!CHECK-NEXT: run 2 evaluate: forall/region_assign1 79 80subroutine unknown_function_call(x) 81 interface 82 pure real function foo(x, i) 83 integer, intent(in) :: i 84 real, intent(in) :: x(10) 85 end function 86 end interface 87 real :: x(10) 88 forall(i=1:10) x(i) = foo(x, i) 89end subroutine 90!CHECK-LABEL: ------------ scheduling forall in _QPunknown_function_call ------------ 91!CHECK-NEXT: unknown effect: {{.*}} fir.call @_QPfoo 92!CHECK-NEXT: unknown effect: {{.*}} fir.call @_QPfoo 93!CHECK-NEXT: conflict: R/W: <unknown> W:<block argument> of type '!fir.ref<!fir.array<10xf32>>' at index: 0 94!CHECK-NEXT: run 1 save : forall/region_assign1/rhs 95!CHECK-NEXT: run 2 evaluate: forall/region_assign1 96 97subroutine unknown_function_call2(x) 98 interface 99 pure real function foo2(i) 100 integer, value :: i 101 end function 102 end interface 103 ! foo2 may read x since it is a target, even if it is pure, 104 ! if the actual argument of x is a module variable accessible 105 ! to foo via host association. 106 real, target :: x(:) 107 forall(i=1:10) x(i) = foo2(i) 108end subroutine 109!CHECK-LABEL: ------------ scheduling forall in _QPunknown_function_call2 ------------ 110!CHECK-NEXT: unknown effect: {{.*}} fir.call @_QPfoo2( 111!CHECK-NEXT: unknown effect: {{.*}} fir.call @_QPfoo2( 112!CHECK-NEXT: conflict: R/W: <unknown> W:<block argument> of type '!fir.box<!fir.array<?xf32>>' at index: 0 113!CHECK-NEXT: run 1 save : forall/region_assign1/rhs 114!CHECK-NEXT: run 2 evaluate: forall/region_assign1 115 116subroutine forall_mask_conflict(x) 117 integer :: x(:) 118 forall(i=1:10, x(11-i)>0) x(i) = 42 119end subroutine 120!CHECK-LABEL: ------------ scheduling forall in _QPforall_mask_conflict ------------ 121!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?xi32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?xi32>>' at index: 0 122!CHECK-NEXT: run 1 save : forall/forall_mask1/mask 123!CHECK-NEXT: run 2 evaluate: forall/forall_mask1/region_assign1 124 125subroutine forall_ub_conflict(x, y) 126 integer :: x(:, :) 127 forall(i=1:10) 128 forall(j=1:x(i,i)) 129 x(i, j) = 42 130 end forall 131 end forall 132end subroutine 133!CHECK-LABEL: ------------ scheduling forall in _QPforall_ub_conflict ------------ 134!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 135!CHECK-NEXT: run 1 save : forall/forall1/ub 136!CHECK-NEXT: run 2 evaluate: forall/forall1/region_assign1 137 138subroutine sequential_assign(x, y) 139 integer :: x(:), y(:) 140 forall(i=1:10) 141 x(i) = y(i) 142 y(2*i) = x(i) 143 end forall 144end subroutine 145!CHECK-LABEL: ------------ scheduling forall in _QPsequential_assign ------------ 146!CHECK-NEXT: run 1 evaluate: forall/region_assign1 147!CHECK-NEXT: run 2 evaluate: forall/region_assign2 148 149subroutine loads_of_conlficts(x, y) 150 integer, target :: x(:, :), y(:, :) 151 forall(i=1:10) 152 forall (j=1:y(i,i)) x(x(i, j), j) = y(i, j) 153 forall (j=1:x(i,i), y(i,i)>0) y(x(i, j), j) = 0 154 end forall 155end subroutine 156!CHECK-LABEL: ------------ scheduling forall in _QPloads_of_conlficts ------------ 157!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 158!CHECK-NEXT: run 1 save : forall/forall1/ub 159!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 160!CHECK-NEXT: run 1 save : forall/forall1/region_assign1/rhs 161!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 162!CHECK-NEXT: run 1 save : forall/forall1/region_assign1/lhs 163!CHECK-NEXT: run 2 evaluate: forall/forall1/region_assign1 164!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 165!CHECK-NEXT: run 3 save : forall/forall2/ub 166!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 167!CHECK-NEXT: run 3 save : forall/forall2/forall_mask1/mask 168!CHECK-NEXT: conflict: R/W: <block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 0 W:<block argument> of type '!fir.box<!fir.array<?x?xi32>>' at index: 1 169!CHECK-NEXT: run 3 save : forall/forall2/forall_mask1/region_assign1/lhs 170!CHECK-NEXT: run 4 evaluate: forall/forall2/forall_mask1/region_assign1 171