xref: /llvm-project/flang/test/Transforms/stack-arrays-hlfir.f90 (revision 698b42ccff69fde6509c6ad0baf262c257c039bb)
1! Similar to stack-arrays.f90; i.e. both test the stack-arrays pass for different
2! kinds of supported inputs. This one differs in that it takes the hlfir lowering
3! path in flag rather than the fir one. For example, temp arrays are lowered
4! differently in hlfir vs. fir and the IR that reaches the stack arrays pass looks
5! quite different.
6
7
8! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - \
9! RUN: | fir-opt --lower-hlfir-ordered-assignments \
10! RUN:           --bufferize-hlfir \
11! RUN:           --convert-hlfir-to-fir \
12! RUN:           --array-value-copy \
13! RUN:           --stack-arrays \
14! RUN: | FileCheck %s
15
16subroutine temp_array
17  implicit none
18  integer (8) :: lV
19  integer (8), dimension (2) :: iaVS
20
21  lV = 202
22
23  iaVS = [lV, lV]
24end subroutine temp_array
25! CHECK-LABEL: func.func @_QPtemp_array{{.*}} {
26! CHECK-NOT:     fir.allocmem
27! CHECK-NOT:     fir.freemem
28! CHECK:         fir.alloca !fir.array<2xi64>
29! CHECK-NOT:     fir.allocmem
30! CHECK-NOT:     fir.freemem
31! CHECK:         return
32! CHECK-NEXT:  }
33
34subroutine omp_temp_array
35  implicit none
36  integer (8) :: lV
37  integer (8), dimension (2) :: iaVS
38
39  lV = 202
40
41  !$omp target
42    iaVS = [lV, lV]
43  !$omp end target
44end subroutine omp_temp_array
45! CHECK-LABEL: func.func @_QPomp_temp_array{{.*}} {
46! CHECK:         omp.target {{.*}} {
47! CHECK-NOT:       fir.allocmem
48! CHECK-NOT:       fir.freemem
49! CHECK:           fir.alloca !fir.array<2xi64>
50! CHECK-NOT:       fir.allocmem
51! CHECK-NOT:       fir.freemem
52! CHECK:           omp.terminator
53! CHECK-NEXT:    }
54! CHECK:         return
55! CHECK-NEXT:  }
56
57subroutine omp_target_wsloop
58  implicit none
59  integer (8) :: lV, i
60  integer (8), dimension (2) :: iaVS
61
62  lV = 202
63
64  !$omp target teams distribute
65  do i = 1, 10
66    iaVS = [lV, lV]
67  end do
68  !$omp end target teams distribute
69end subroutine omp_target_wsloop
70! CHECK-LABEL: func.func @_QPomp_target_wsloop{{.*}} {
71! CHECK:         omp.target {{.*}} {
72! CHECK-NOT:       fir.allocmem
73! CHECK-NOT:       fir.freemem
74! CHECK:           fir.alloca !fir.array<2xi64>
75! CHECK:         omp.teams {
76! CHECK:         omp.distribute {
77! CHECK:         omp.loop_nest {{.*}} {
78! CHECK-NOT:       fir.allocmem
79! CHECK-NOT:       fir.freemem
80! CHECK:           omp.yield
81! CHECK-NEXT:    }
82! CHECK:         return
83! CHECK-NEXT:  }
84