diff --git a/flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90 b/flang/test/Lower/Intrinsics/ieee_is_finite.f90 rename from flang/test/Lower/intrinsic-procedures/ieee_is_finite.f90 rename to flang/test/Lower/Intrinsics/ieee_is_finite.f90 diff --git a/flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90 b/flang/test/Lower/Intrinsics/ieee_operator_eq.f90 rename from flang/test/Lower/intrinsic-procedures/ieee_operator_eq.f90 rename to flang/test/Lower/Intrinsics/ieee_operator_eq.f90 diff --git a/flang/test/Lower/arithmetic-goto.f90 b/flang/test/Lower/arithmetic-goto.f90 --- a/flang/test/Lower/arithmetic-goto.f90 +++ b/flang/test/Lower/arithmetic-goto.f90 @@ -26,6 +26,9 @@ end ! CHECK-LABEL: func @_QQmain + do i = -2, 2 + print*, kagi(i) + enddo print*, kagf(-2.0) print*, kagf(-1.0) diff --git a/flang/test/Lower/array-character.f90 b/flang/test/Lower/array-character.f90 --- a/flang/test/Lower/array-character.f90 +++ b/flang/test/Lower/array-character.f90 @@ -43,7 +43,9 @@ ! CHECK: %[[VAL_33:.*]] = arith.subi %[[VAL_28]], %[[VAL_7]] : index ! CHECK: cf.br ^bb3(%[[VAL_32]], %[[VAL_33]] : index, index) ! CHECK: ^bb5: - + ! CHECK: %[[VAL_34:.*]] = arith.subi %[[VAL_14]], %[[VAL_7]] : index + ! CHECK: cf.br ^bb1(%[[VAL_16]], %[[VAL_34]] : index, index) + character(4) :: c1(3) character(*) :: c2(3) c1 = c2 @@ -141,7 +143,7 @@ ! CHECK: %[[VAL_40:.*]] = fir.embox %[[VAL_29]](%[[VAL_12]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>> ! CHECK: %[[VAL_41:.*]] = fir.convert %[[VAL_40]] : (!fir.box>>) -> !fir.box ! CHECK: %[[VAL_42:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_28]], %[[VAL_41]]) : (!fir.ref, !fir.box) -> i1 - ! CHECK: fir.freemem %[[VAL_29]] + ! CHECK: fir.freemem %[[VAL_29]] : !fir.heap>> ! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_28]]) : (!fir.ref) -> i32 ! CHECK: %[[VAL_44:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_0]], %[[VAL_9]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref ! CHECK: %[[VAL_45:.*]] = fir.allocmem !fir.array<4x!fir.char<1,3>> @@ -163,7 +165,7 @@ ! CHECK: %[[VAL_56:.*]] = fir.embox %[[VAL_45]](%[[VAL_12]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>> ! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_56]] : (!fir.box>>) -> !fir.box ! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_44]], %[[VAL_57]]) : (!fir.ref, !fir.box) -> i1 - ! CHECK: fir.freemem %[[VAL_45]] + ! CHECK: fir.freemem %[[VAL_45]] : !fir.heap>> ! CHECK: %[[VAL_59:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_44]]) : (!fir.ref) -> i32 print*, ['AA ', 'MM ', 'MM ', 'ZZ '] print*, ['AA ', 'MM ', 'MM ', 'ZZ '] @@ -171,3 +173,12 @@ ! CHECK: return ! CHECK: } end + +! CHECK: fir.global internal @_QQro.4x3xc1.1636b396a657de68ffb870a885ac44b4 constant : !fir.array<4x!fir.char<1,3>> +! CHECK: AA +! CHECK: MM +! CHECK: ZZ +! CHECK-NOT: fir.global internal @_QQro.4x3xc1 +! CHECK-NOT: AA +! CHECK-NOT: MM +! CHECK-NOT: ZZ diff --git a/flang/test/Lower/array-constructor-1.f90 b/flang/test/Lower/array-constructor-1.f90 --- a/flang/test/Lower/array-constructor-1.f90 +++ b/flang/test/Lower/array-constructor-1.f90 @@ -9,10 +9,10 @@ integer :: u integer :: i is_preconnected_unit = .true. - !do i = lbound(preconnected_unit,1), ubound(preconnected_unit,1) + do i = lbound(preconnected_unit,1), ubound(preconnected_unit,1) ! CHECK: fir.coordinate_of [[units_ssa]] if (preconnected_unit(i) == u) return - !end do + end do is_preconnected_unit = .false. end function end module units @@ -20,9 +20,9 @@ ! CHECK-LABEL: _QPcheck_units subroutine check_units use units - !do i=-1,8 + do i=-1,8 if (is_preconnected_unit(i)) print*, i - !enddo + enddo end ! CHECK-LABEL: _QPzero diff --git a/flang/test/Lower/array-constructor-2.f90 b/flang/test/Lower/array-constructor-2.f90 --- a/flang/test/Lower/array-constructor-2.f90 +++ b/flang/test/Lower/array-constructor-2.f90 @@ -47,7 +47,7 @@ ! CHECK-DAG: fir.array_coor %[[tmp:.*]](% ! CHECK-DAG: %[[ai:.*]] = fir.array_coor %[[a]](% ! CHECK: fir.store %{{.*}} to %[[ai]] : !fir.ref - ! CHECK: fir.freemem %[[tmp]] + ! CHECK: fir.freemem %[[tmp]] : !fir.heap> a = [f(b), f(b+1), f(b+2), f(b+5), f(b+11)] end subroutine test2 @@ -113,7 +113,7 @@ ! CHECK: %[[q:.*]] = fir.coordinate_of %arg1, %{{.*}}, %{{.*}} : (!fir.box>, i64, i64) -> !fir.ref ! CHECK: %[[q2:.*]] = fir.load %[[q]] : !fir.ref ! CHECK: fir.store %[[q2]] to %{{.*}} : !fir.ref - ! CHECK: fir.freemem %{{.*}} + ! CHECK: fir.freemem %{{.*}} : !fir.heap> ! CHECK-NEXT: return a = [ ((b(i,j), j=f1(i),f2(n1),f3(m1+i)), i=1,n1,m1) ] end subroutine test4 @@ -137,9 +137,9 @@ ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%{{.*}}, %{{.*}}, %{{.*}}, %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () ! CHECK: = fir.array_coor %{{.*}}(%{{.*}}) %{{.*}} : (!fir.heap>, !fir.shape<1>, index) -> !fir.ref ! CHECK: = fir.array_coor %[[a]] %{{.*}} : (!fir.box>, index) -> !fir.ref - ! CHECK-DAG: fir.freemem %{{.*}} - ! CHECK-DAG: fir.freemem %[[tmp2]] - ! CHECK-DAG: fir.freemem %[[tmp1]] + ! CHECK-DAG: fir.freemem %{{.*}} : !fir.heap> + ! CHECK-DAG: fir.freemem %[[tmp2]] : !fir.heap> + ! CHECK-DAG: fir.freemem %[[tmp1]] : !fir.heap> ! CHECK: return a = [ const_array1, array2 ] end subroutine test5 @@ -157,7 +157,7 @@ ! CHECK: %[[t:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.heap>>, index) -> !fir.ref> ! CHECK: %[[to:.*]] = fir.convert %[[t]] : (!fir.ref>) -> !fir.ref ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%[[to]], %{{.*}}, %{{.*}}, %false) : (!fir.ref, !fir.ref, i64, i1) -> () - ! CHECK: fir.freemem %{{.*}} + ! CHECK: fir.freemem %{{.*}} : !fir.heap>> c = (/ d, e /) end subroutine test6 diff --git a/flang/test/Lower/array-copy-semantics.f90 b/flang/test/Lower/array-copy-semantics.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/array-copy-semantics.f90 @@ -0,0 +1,34 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: _QPsub + +! F77 code for the array computation c = ((a + b) * c) + (b / 2.0). +! (Eventually, test that the temporary arrays are eliminated.) +subroutine sub(a,b,c,i,j,k) + real a(i,j,k), b(i,j,k), c(i,j,k) + real t1(i,j,k), t2(i,j,k) + integer i, j, k + integer r, s, t + + do t = 1, k + do s = 1, j + do r = 1, i + t1(r,s,t) = a(r,s,t) + b(r,s,t) + end do + end do + end do + do t = 1, k + do s = 1, j + do r = 1, i + t2(r,s,t) = t1(r,s,t) * c(r,s,t) + end do + end do + end do + do t = 1, k + do s = 1, j + do r = 1, i + c(r,s,t) = t2(r,s,t) + b(r,s,t) / 2.0 + end do + end do + end do +end subroutine sub diff --git a/flang/test/Lower/array-copy.f90 b/flang/test/Lower/array-copy.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/array-copy.f90 @@ -0,0 +1,144 @@ +! Test array-value-copy + +! RUN: bbc %s -o - | FileCheck %s + +! Copy not needed +! CHECK-LABEL: func @_QPtest1( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: fir.freemem % +! CHECK: return +! CHECK: } +subroutine test1(a) + integer :: a(3) + + a = a + 1 +end subroutine test1 + +! Copy not needed +! CHECK-LABEL: func @_QPtest2( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: fir.freemem % +! CHECK: return +! CHECK: } +subroutine test2(a, b) + integer :: a(3), b(3) + + a = b + 1 +end subroutine test2 + +! Copy not needed +! CHECK-LABEL: func @_QPtest3( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: fir.freemem % +! CHECK: return +! CHECK: } +subroutine test3(a) + integer :: a(3) + + forall (i=1:3) + a(i) = a(i) + 1 + end forall +end subroutine test3 + +! Make a copy. (Crossing dependence) +! CHECK-LABEL: func @_QPtest4( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: fir.freemem %{{.*}} : !fir.heap> +! CHECK: return +! CHECK: } +subroutine test4(a) + integer :: a(3) + + forall (i=1:3) + a(i) = a(4-i) + 1 + end forall +end subroutine test4 + +! Make a copy. (Carried dependence) +! CHECK-LABEL: func @_QPtest5( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: fir.freemem %{{.*}} : !fir.heap> +! CHECK: return +! CHECK: } +subroutine test5(a) + integer :: a(3) + + forall (i=2:3) + a(i) = a(i-1) + 14 + end forall +end subroutine test5 + +! Make a copy. (Carried dependence) +! CHECK-LABEL: func @_QPtest6( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: fir.freemem %{{.*}} : !fir.heap}>>> +! CHECK: return +! CHECK: } +subroutine test6(a) + type t + integer :: m(3) + end type t + type(t) :: a(3) + + forall (i=2:3) + a(i)%m = a(i-1)%m + 14 + end forall +end subroutine test6 + +! Make a copy. (Overlapping partial CHARACTER update.) +! CHECK-LABEL: func @_QPtest7( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: fir.freemem %{{.*}} : !fir.heap>> +! CHECK: return +! CHECK: } +subroutine test7(a) + character(8) :: a(3) + + a(:)(2:5) = a(:)(3:6) +end subroutine test7 + +! Do not make a copy. +! CHECK-LABEL: func @_QPtest8( +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: fir.freemem % +! CHECK: return +! CHECK: } +subroutine test8(a,b) + character(8) :: a(3), b(3) + + a(:)(2:5) = b(:)(3:6) +end subroutine test8 + +! Do make a copy. Assume vector subscripts cause dependences. +! CHECK-LABEL: func @_QPtest9( +! CHECK-SAME: %[[a:[^:]+]]: !fir.ref> +! CHECK: %[[und:.*]] = fir.undefined index +! CHECK: %[[slice:.*]] = fir.slice %[[und]], %[[und]], %[[und]], +! CHECK: %[[heap:.*]] = fir.allocmem !fir.array, %{{.*}}, %{{.*}} +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: = fir.array_coor %[[a]](%{{.*}}) [%[[slice]]] %{{.*}}, %{{.*}} : (!fir.ref>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref +! CHECK: = fir.array_coor %[[heap]](%{{.*}}) [%[[slice]]] %{{.*}}, %{{.*}} : (!fir.heap>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): +! CHECK: fir.freemem %[[heap]] +subroutine test9(a,v1,v2,n) + real :: a(n,n) + integer :: v1(n), v2(n) + a(v1,:) = a(v2,:) +end subroutine test9 diff --git a/flang/test/Lower/array-expression-assumed-size.f90 b/flang/test/Lower/array-expression-assumed-size.f90 --- a/flang/test/Lower/array-expression-assumed-size.f90 +++ b/flang/test/Lower/array-expression-assumed-size.f90 @@ -18,7 +18,7 @@ ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>{{.*}}) { ! CHECK: %[[VAL_1A:.*]] = fir.convert %c10{{.*}} : (i64) -> index ! CHECK: %[[VAL_1B:.*]] = arith.cmpi sgt, %[[VAL_1A]], %c0{{.*}} : index -! CHECK: %[[VAL_1:.*]] = arith.select %[[VAL_1B]], %[[VAL_1A]], %c0{{.*}} : index +! CHECK: %[[VAL_1:.*]] = arith.select %[[VAL_1B]], %[[VAL_1A]], %c0{{.*}} : index ! CHECK: %[[VAL_2:.*]] = fir.undefined index ! CHECK: %[[VAL_3:.*]] = arith.constant 1 : index ! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i64 @@ -81,7 +81,7 @@ ! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} ! CHECK: %[[VAL_2A:.*]] = fir.convert %c10{{.*}} : (i64) -> index ! CHECK: %[[VAL_2B:.*]] = arith.cmpi sgt, %[[VAL_2A]], %c0{{.*}} : index -! CHECK: %[[VAL_2:.*]] = arith.select %[[VAL_2B]], %[[VAL_2A]], %c0{{.*}} : index +! CHECK: %[[VAL_2:.*]] = arith.select %[[VAL_2B]], %[[VAL_2A]], %c0{{.*}} : index ! CHECK: %[[VAL_3:.*]] = fir.undefined index ! CHECK: %[[VAL_4:.*]] = arith.constant 2 : i32 ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index diff --git a/flang/test/Lower/array-expression-slice-2.f90 b/flang/test/Lower/array-expression-slice-2.f90 --- a/flang/test/Lower/array-expression-slice-2.f90 +++ b/flang/test/Lower/array-expression-slice-2.f90 @@ -7,6 +7,19 @@ print *, ctemp(1:10) end subroutine i +! CHECK-LABEL: func @_QPs +subroutine s + integer, parameter :: LONGreal = 8 + real (kind = LONGreal), dimension(-1:11) :: x = (/0,0,0,0,0,0,0,0,0,0,0,0,0/) + real (kind = LONGreal), dimension(0:12) :: g = (/0,0,0,0,0,0,0,0,0,0,0,0,0/) + real (kind = LONGreal) :: gs(13) + x(1) = 4.0 + g(1) = 5.0 + gs = g(0:12:1) + x(11:(-1):(-1)) + print *, gs + !print *, dot_product(g(0:12:1), x(11:(-1):(-1))) +end subroutine s + ! CHECK-LABEL: func @_QPs2 subroutine s2 real :: x(10) diff --git a/flang/test/Lower/array-expression.f90 b/flang/test/Lower/array-expression.f90 --- a/flang/test/Lower/array-expression.f90 +++ b/flang/test/Lower/array-expression.f90 @@ -413,7 +413,7 @@ ! CHECK: fir.array_fetch %[[B]] ! CHECK: fir.array_merge_store %[[A]], %[[LOOP2]] to %arg0 a = b + bar(c + d) - ! CHECK: fir.freemem %[[tmp]] + ! CHECK: fir.freemem %[[tmp]] : !fir.heap> end subroutine test12 ! CHECK-LABEL: func @_QPtest13 @@ -1164,7 +1164,7 @@ ! CHECK: %[[VAL_42:.*]] = fir.embox %[[VAL_18]](%[[VAL_41]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box> ! CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_42]] : (!fir.box>) -> !fir.box ! CHECK: %[[VAL_44:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_13]], %[[VAL_43]]) : (!fir.ref, !fir.box) -> i1 -! CHECK: fir.freemem %[[VAL_18]] +! CHECK: fir.freemem %[[VAL_18]] : !fir.heap> ! CHECK: %[[VAL_45:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_13]]) : (!fir.ref) -> i32 ! CHECK: return ! CHECK: } diff --git a/flang/test/Lower/array-substring.f90 b/flang/test/Lower/array-substring.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/array-substring.f90 @@ -0,0 +1,48 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPtest( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}) -> !fir.array<1x!fir.logical<4>> { +! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 1 : index +! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 0 : index +! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0 : i32 +! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 8 : index +! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 8 : i64 +! CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.array<1x!fir.logical<4>> {bindc_name = "test", uniq_name = "_QFtestEtest"} +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_1]], %[[VAL_1]], %[[VAL_1]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_11:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref>> +! CHECK: br ^bb1(%[[VAL_2]], %[[VAL_1]] : index, index) +! CHECK: ^bb1(%[[VAL_12:.*]]: index, %[[VAL_13:.*]]: index): +! CHECK: %[[VAL_14:.*]] = arith.cmpi sgt, %[[VAL_13]], %[[VAL_2]] : index +! CHECK: cond_br %[[VAL_14]], ^bb2, ^bb3 +! CHECK: ^bb2: +! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_12]], %[[VAL_1]] : index +! CHECK: %[[VAL_16:.*]] = fir.array_coor %[[VAL_7]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] %[[VAL_15]] : (!fir.ref>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_18:.*]] = fir.coordinate_of %[[VAL_17]], %[[VAL_2]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_20:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_9]]) %[[VAL_15]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_4]] : (index) -> i64 +! CHECK: %[[VAL_24:.*]] = fir.call @_FortranACharacterCompareScalar1(%[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_5]]) : (!fir.ref, !fir.ref, i64, i64) -> i32 +! CHECK: %[[VAL_25:.*]] = arith.cmpi eq, %[[VAL_24]], %[[VAL_3]] : i32 +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i1) -> !fir.logical<4> +! CHECK: %[[VAL_27:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_9]]) %[[VAL_15]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> +! CHECK: fir.store %[[VAL_26]] to %[[VAL_27]] : !fir.ref> +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_13]], %[[VAL_1]] : index +! CHECK: br ^bb1(%[[VAL_15]], %[[VAL_28]] : index, index) +! CHECK: ^bb3: +! CHECK: %[[VAL_29:.*]] = fir.load %[[VAL_8]] : !fir.ref>> +! CHECK: return %[[VAL_29]] : !fir.array<1x!fir.logical<4>> +! CHECK: } + + +function test(C) + logical :: test(1) + character*12 C(1) + + test = C(1:1)(1:8) == (/'ABCDabcd'/) +end function test diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/array.f90 @@ -0,0 +1,147 @@ +! RUN: bbc -o - %s | FileCheck %s + +! CHECK-LABEL: fir.global @_QBblock +! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 1.000000e+00 : f32 +! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 2.400000e+00 : f32 +! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_4:.*]] = fir.undefined tuple> +! CHECK: %[[VAL_5:.*]] = fir.undefined !fir.array<5x5xf32> +! CHECK: %[[VAL_6:.*]] = fir.insert_on_range %[[VAL_5]], %[[VAL_1]] from (0, 0) to (1, 0) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_7:.*]] = fir.insert_on_range %[[VAL_6]], %[[VAL_3]] from (2, 0) to (4, 0) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_8:.*]] = fir.insert_on_range %[[VAL_7]], %[[VAL_1]] from (0, 1) to (1, 1) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_3]], [2 : index, 1 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_10:.*]] = fir.insert_value %[[VAL_9]], %[[VAL_2]], [3 : index, 1 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_11:.*]] = fir.insert_value %[[VAL_10]], %[[VAL_3]], [4 : index, 1 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_12:.*]] = fir.insert_on_range %[[VAL_11]], %[[VAL_1]] from (0, 2) to (1, 2) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_13:.*]] = fir.insert_value %[[VAL_12]], %[[VAL_3]], [2 : index, 2 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_14:.*]] = fir.insert_value %[[VAL_13]], %[[VAL_2]], [3 : index, 2 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_15:.*]] = fir.insert_on_range %[[VAL_14]], %[[VAL_3]] from (4, 2) to (2, 3) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_16:.*]] = fir.insert_value %[[VAL_15]], %[[VAL_2]], [3 : index, 3 : index] : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_17:.*]] = fir.insert_on_range %[[VAL_16]], %[[VAL_3]] from (4, 3) to (4, 4) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32> +! CHECK: %[[VAL_18:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_17]], [0 : index] : (tuple>, !fir.array<5x5xf32>) -> tuple> +! CHECK: fir.has_value %[[VAL_18]] : tuple> + +subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) + integer i, j, k, ii, jj, kk + + ! extents are compile-time constant + real a1(10,20) + integer a2(30,*) + real a3(2:40,3:50) + integer a4(4:60, 5:*) + + ! extents computed at run-time + real a5(i:j) + integer a6(6:i,j:*) + real a7(i:70,7:j,k:80) + + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-DAG: fir.load %arg3 : + ! CHECK-DAG: %[[i1:.*]] = arith.subi %{{.*}}, %[[one:c1.*]] : + ! CHECK: fir.load %arg4 : + ! CHECK: %[[j1:.*]] = arith.subi %{{.*}}, %[[one]] : + ! CHECK: fir.coordinate_of %arg6, %[[i1]], %[[j1]] : + ! CHECK-LABEL: EndIoStatement + print *, a1(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: fir.coordinate_of %{{[0-9]+}}, %{{[0-9]+}} : {{.*}} -> !fir.ref + ! CHECK-LABEL: EndIoStatement + print *, a2(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-DAG: fir.load %arg3 : + ! CHECK-DAG: %[[cc2:.*]] = fir.convert %c2{{.*}} : + ! CHECK: %[[i2:.*]] = arith.subi %{{.*}}, %[[cc2]] : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK-DAG: %[[cc3:.*]] = fir.convert %c3{{.*}} : + ! CHECK: %[[j2:.*]] = arith.subi %{{.*}}, %[[cc3]] : + ! CHECK: fir.coordinate_of %arg8, %[[i2]], %[[j2]] : + ! CHECK-LABEL: EndIoStatement + print *, a3(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK-LABEL: EndIoStatement + print *, a4(ii,jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: fir.load %arg5 : + ! CHECK: %[[x5:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK: fir.coordinate_of %arg10, %[[x5]] : + ! CHECK-LABEL: EndIoStatement + print *, a5(kk) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: %[[a6:.*]] = fir.convert %arg11 : {{.*}} -> !fir.ref> + ! CHECK: fir.load %arg3 : + ! CHECK-DAG: %[[x6:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK: %[[y6:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK: %[[z6:.*]] = arith.muli %{{.}}, %[[y6]] : + ! CHECK: %[[w6:.*]] = arith.addi %[[z6]], %[[x6]] : + ! CHECK: fir.coordinate_of %[[a6]], %[[w6]] : + ! CHECK-LABEL: EndIoStatement + print *, a6(ii, jj) + ! CHECK-LABEL: BeginExternalListOutput + ! CHECK: %[[a7:.*]] = fir.convert %arg12 : {{.*}} -> !fir.ref> + ! CHECK: fir.load %arg5 : + ! CHECK-DAG: %[[x7:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK-DAG: fir.load %arg4 : + ! CHECK: %[[y7:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK: %[[z7:.*]] = arith.muli %[[u7:.*]], %[[y7]] : + ! CHECK: %[[w7:.*]] = arith.addi %[[z7]], %[[x7]] : + ! CHECK-DAG: %[[v7:.*]] = arith.muli %[[u7]], %{{.*}} : + ! CHECK-DAG: fir.load %arg3 : + ! CHECK: %[[r7:.*]] = arith.subi %{{.*}}, %{{.*}} : + ! CHECK: %[[s7:.*]] = arith.muli %[[v7]], %[[r7]] : + ! CHECK: %[[t7:.*]] = arith.addi %[[s7]], %[[w7]] : + ! CHECK: fir.coordinate_of %[[a7]], %[[t7]] : + ! CHECK-LABEL: EndIoStatement + print *, a7(kk, jj, ii) + +end subroutine s + +! CHECK-LABEL range +subroutine range() + ! Compile-time initalized arrays + integer, dimension(10) :: a0 + real, dimension(2,3) :: a1 + integer, dimension(3,4) :: a2 + + a0 = (/1, 2, 3, 3, 3, 3, 3, 3, 3, 3/) + a1 = reshape((/3.5, 3.5, 3.5, 3.5, 3.5, 3.5/), shape(a1)) + a2 = reshape((/1, 3, 3, 5, 3, 3, 3, 3, 9, 9, 9, 8/), shape(a2)) +end subroutine range + +! a0 array constructor +! CHECK: fir.global internal @_QQro.10xi4.{{.*}}(dense<[1, 2, 3, 3, 3, 3, 3, 3, 3, 3]> : tensor<10xi32>) constant : !fir.array<10xi32> + +! a1 array constructor +! CHECK: fir.global internal @_QQro.2x3xr4.{{.*}} constant : !fir.array<2x3xf32> { + ! CHECK-DAG: %cst = arith.constant {{.*}} : f32 + ! CHECK: %{{.*}} = fir.insert_on_range %{{[0-9]+}}, %cst from (0, 0) to (1, 2) : + +! a2 array constructor +! CHECK: fir.global internal @_QQro.3x4xi4.{{.*}} constant : !fir.array<3x4xi32> { + ! CHECK-DAG: %[[c1_i32:.*]] = arith.constant 1 : i32 + ! CHECK-DAG: %[[c3_i32:.*]] = arith.constant 3 : i32 + ! CHECK-DAG: %[[c5_i32:.*]] = arith.constant 5 : i32 + ! CHECK-DAG: %[[c8_i32:.*]] = arith.constant 8 : i32 + ! CHECK-DAG: %[[c9_i32:.*]] = arith.constant 9 : i32 + ! CHECK: %[[r1:.*]] = fir.insert_value %{{.*}}, %{{.*}}, [0 : index, 0 : index] : + ! CHECK: %[[r2:.*]] = fir.insert_on_range %[[r1]], %[[c3_i32]] from (1, 0) to (2, 0) : + ! CHECK: %[[r3:.*]] = fir.insert_value %[[r2]], %{{.*}}, [0 : index, 1 : index] : + ! CHECK: %[[r4:.*]] = fir.insert_on_range %[[r3]], %[[c3_i32]] from (1, 1) to (1, 2) : + ! CHECK: %[[r5:.*]] = fir.insert_on_range %[[r4]], %[[c9_i32]] from (2, 2) to (1, 3) : + ! CHECK: %[[r6:.*]] = fir.insert_value %[[r5]], %{{.*}}, [2 : index, 3 : index] : + +! CHECK-LABEL rangeGlobal +subroutine rangeGlobal() +! CHECK: fir.global internal @_QFrangeglobal{{.*}}(dense<[1, 1, 2, 2, 3, 3]> : tensor<6xi32>) : !fir.array<6xi32> + integer, dimension(6) :: a0 = (/ 1, 1, 2, 2, 3, 3 /) + +end subroutine rangeGlobal + +block data + real(selected_real_kind(6)) :: x(5,5) + common /block/ x + data x(1,1), x(2,1), x(3,1) / 1, 1, 0 / + data x(1,2), x(2,2), x(4,2) / 1, 1, 2.4 / + data x(1,3), x(2,3), x(4,3) / 1, 1, 2.4 / + data x(4,4) / 2.4 / +end diff --git a/flang/test/Lower/associate-construct.f90 b/flang/test/Lower/associate-construct.f90 --- a/flang/test/Lower/associate-construct.f90 +++ b/flang/test/Lower/associate-construct.f90 @@ -39,23 +39,25 @@ call nest - associate (x=>i) - ! CHECK: [[IVAL:%[0-9]+]] = fir.load [[I]] : !fir.ref - ! CHECK: [[TWO:%.*]] = arith.constant 2 : i32 - ! CHECK: arith.cmpi eq, [[IVAL]], [[TWO]] : i32 - ! CHECK: ^bb - if (x==2) goto 9 - ! CHECK: [[IVAL:%[0-9]+]] = fir.load [[I]] : !fir.ref - ! CHECK: [[THREE:%.*]] = arith.constant 3 : i32 - ! CHECK: arith.cmpi eq, [[IVAL]], [[THREE]] : i32 - ! CHECK: ^bb - ! CHECK: fir.call @_FortranAStopStatementText - ! CHECK: fir.unreachable - ! CHECK: ^bb - if (x==3) stop 'Halt' - ! CHECK: fir.call @_FortranAioOutputAscii - print*, "ok" + do i=1,4 + associate (x=>i) + ! CHECK: [[IVAL:%[0-9]+]] = fir.load [[I]] : !fir.ref + ! CHECK: [[TWO:%.*]] = arith.constant 2 : i32 + ! CHECK: arith.cmpi eq, [[IVAL]], [[TWO]] : i32 + ! CHECK: ^bb + if (x==2) goto 9 + ! CHECK: [[IVAL:%[0-9]+]] = fir.load [[I]] : !fir.ref + ! CHECK: [[THREE:%.*]] = arith.constant 3 : i32 + ! CHECK: arith.cmpi eq, [[IVAL]], [[THREE]] : i32 + ! CHECK: ^bb + ! CHECK: fir.call @_FortranAStopStatementText + ! CHECK: fir.unreachable + ! CHECK: ^bb + if (x==3) stop 'Halt' + ! CHECK: fir.call @_FortranAioOutputAscii + print*, "ok" 9 end associate + enddo end ! CHECK-LABEL: func @_QPfoo diff --git a/flang/test/Lower/assumed-shape-caller.f90 b/flang/test/Lower/assumed-shape-caller.f90 --- a/flang/test/Lower/assumed-shape-caller.f90 +++ b/flang/test/Lower/assumed-shape-caller.f90 @@ -88,7 +88,7 @@ ! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_9]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_27:.*]] = fir.embox %[[VAL_11]](%[[VAL_26]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box> ! CHECK: fir.call @_QPtakes_box(%[[VAL_27]]) : (!fir.box>) -> () -! CHECK: fir.freemem %[[VAL_11]] +! CHECK: fir.freemem %[[VAL_11]] : !fir.heap> end subroutine ! Test external function declarations diff --git a/flang/test/Lower/bbcnull.f90 b/flang/test/Lower/bbcnull.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/bbcnull.f90 @@ -0,0 +1,4 @@ +! RUN: bbc --version | FileCheck %s +! CHECK: LLVM version + +! This test is intentionally empty. diff --git a/flang/test/Lower/call-copy-in-out.f90 b/flang/test/Lower/call-copy-in-out.f90 --- a/flang/test/Lower/call-copy-in-out.f90 +++ b/flang/test/Lower/call-copy-in-out.f90 @@ -36,7 +36,7 @@ ! CHECK: } ! CHECK: fir.array_merge_store %[[x_load]], %[[copyout:.*]] to %[[x]] : !fir.array, !fir.array, !fir.box> -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> call bar(x) end subroutine @@ -62,7 +62,7 @@ ! CHECK-NOT: fir.call @_QPonly_once() ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x_section]] ! CHECK-NOT: fir.call @_QPonly_once() -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> end subroutine ! Test no copy-in/copy-out is generated for contiguous assumed shapes. @@ -90,7 +90,7 @@ ! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () call bar((x)) ! CHECK-NOT: fir.array_merge_store -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> ! CHECK: return end subroutine @@ -111,7 +111,7 @@ ! CHECK: fir.call @_QPbar_intent_out(%[[cast]]) : (!fir.ref>) -> () call bar_intent_out(x) ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> ! CHECK: return end subroutine @@ -132,7 +132,7 @@ ! CHECK: fir.call @_QPbar_intent_in(%[[cast]]) : (!fir.ref>) -> () call bar_intent_in(x) ! CHECK-NOT: fir.array_merge_store -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> ! CHECK: return end subroutine @@ -153,7 +153,7 @@ ! CHECK: fir.call @_QPbar_intent_inout(%[[cast]]) : (!fir.ref>) -> () call bar_intent_inout(x) ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] -! CHECK: fir.freemem %[[temp]] +! CHECK: fir.freemem %[[temp]] : !fir.heap> ! CHECK: return end subroutine @@ -212,7 +212,7 @@ ! CHECK: fir.result %[[VAL_47]] : !fir.array> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_27]], %[[VAL_48:.*]] to %[[VAL_0]] : !fir.array>, !fir.array>, !fir.box>> - ! CHECK: fir.freemem %[[VAL_4]] + ! CHECK: fir.freemem %[[VAL_4]] : !fir.heap>> character(10) :: x(:) call bar_char(x) diff --git a/flang/test/Lower/call-parenthesized-arg.f90 b/flang/test/Lower/call-parenthesized-arg.f90 --- a/flang/test/Lower/call-parenthesized-arg.f90 +++ b/flang/test/Lower/call-parenthesized-arg.f90 @@ -70,7 +70,7 @@ ! CHECK: fir.array_merge_store %[[VAL_8]], %[[VAL_18:.*]] to %[[VAL_6]] : !fir.array<100xi32>, !fir.array<100xi32>, !fir.heap> ! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_6]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar_num_array(%[[VAL_19]]) : (!fir.ref>) -> () -! CHECK: fir.freemem %[[VAL_6]] +! CHECK: fir.freemem %[[VAL_6]] : !fir.heap> ! CHECK: return ! CHECK: } end subroutine @@ -114,7 +114,7 @@ ! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_11]] : (!fir.heap>>) -> !fir.ref> ! CHECK: %[[VAL_34:.*]] = fir.emboxchar %[[VAL_33]], %[[VAL_32]] : (!fir.ref>, index) -> !fir.boxchar<1> ! CHECK: fir.call @_QPbar_char_array(%[[VAL_34]]) : (!fir.boxchar<1>) -> () - ! CHECK: fir.freemem %[[VAL_11]] + ! CHECK: fir.freemem %[[VAL_11]] : !fir.heap>> character(10) :: x(100) call bar_char_array(x) @@ -151,7 +151,7 @@ ! CHECK: %[[VAL_23:.*]] = fir.embox %[[VAL_9]](%[[VAL_22]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box> ! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.box>) -> !fir.box> ! CHECK: fir.call @_QPbar_num_array_box(%[[VAL_24]]) : (!fir.box>) -> () - ! CHECK: fir.freemem %[[VAL_9]] + ! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> integer :: x(100) interface @@ -175,7 +175,7 @@ ! CHECK: %[[VAL_6A:.*]] = fir.convert %[[VAL_5]] : (i64) -> index ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[CMP:.*]] = arith.cmpi sgt, %[[VAL_6A]], %[[C0]] : index - ! CHECK: %[[VAL_6:.*]] = arith.select %[[CMP]], %[[VAL_6A]], %[[C0]] : index + ! CHECK: %[[VAL_6:.*]] = arith.select %[[CMP]], %[[VAL_6A]], %[[C0]] : index ! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_3]](%[[VAL_7]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box>>) -> !fir.box>> @@ -208,7 +208,7 @@ ! CHECK: %[[VAL_34:.*]] = fir.embox %[[VAL_12]](%[[VAL_33]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>> ! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_34]] : (!fir.box>>) -> !fir.box>> ! CHECK: fir.call @_QPbar_char_array_box(%[[VAL_35]]) : (!fir.box>>) -> () - ! CHECK: fir.freemem %[[VAL_12]] + ! CHECK: fir.freemem %[[VAL_12]] : !fir.heap>> integer :: n character(10) :: x(n) diff --git a/flang/test/Lower/components.f90 b/flang/test/Lower/components.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/components.f90 @@ -0,0 +1,316 @@ +! RUN: bbc %s -o - | FileCheck %s + +module components_test + type t1 + integer :: i(6) + real :: r(5) + end type t1 + + type t2 + type(t1) :: g1(3,3), g2(4,4,4) + integer :: g3(5) + end type t2 + + type t3 + type(t1) :: h1(3) + type(t2) :: h2(4) + end type t3 + + type(t3) :: instance + +contains + + ! CHECK-LABEL: func @_QMcomponents_testPs1( + subroutine s1(i,j) + ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 1 : i32 + ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 6 : i32 + ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 0 : i64 + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 1 : i64 + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 2 : i64 + ! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QMcomponents_testEinstance) : !fir.ref,r:!fir.array<5xf32>}>>,h2:!fir.array<4x!fir.type<_QMcomponents_testTt2{g1:!fir.array<3x3x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>}>> + ! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_7:.*]] : !fir.ref + ! CHECK: %[[VAL_8:.*]] = arith.cmpi sge, %[[VAL_6]], %[[VAL_0]] : i32 + ! CHECK: %[[VAL_9:.*]] = arith.cmpi sle, %[[VAL_6]], %[[VAL_1]] : i32 + ! CHECK: %[[VAL_10:.*]] = arith.andi %[[VAL_8]], %[[VAL_9]] : i1 + ! CHECK: cond_br %[[VAL_10]], ^bb1, ^bb2 + ! CHECK: ^bb1: + ! CHECK: %[[VAL_11:.*]] = fir.field_index h2, !fir.type<_QMcomponents_testTt3{h1:!fir.array<3x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,h2:!fir.array<4x!fir.type<_QMcomponents_testTt2{g1:!fir.array<3x3x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>}> + ! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_11]] : (!fir.ref,r:!fir.array<5xf32>}>>,h2:!fir.array<4x!fir.type<_QMcomponents_testTt2{g1:!fir.array<3x3x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>}>>, !fir.field) -> !fir.ref,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>> + ! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_12]], %[[VAL_3]] : (!fir.ref,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>>, i64) -> !fir.ref,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>> + ! CHECK: %[[VAL_14:.*]] = fir.field_index g2, !fir.type<_QMcomponents_testTt2{g1:!fir.array<3x3x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}> + ! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_13]], %[[VAL_14]] : (!fir.ref,r:!fir.array<5xf32>}>>,g2:!fir.array<4x4x4x!fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}>>,g3:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref,r:!fir.array<5xf32>}>>> + ! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_15]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (!fir.ref,r:!fir.array<5xf32>}>>>, i64, i64, i64) -> !fir.ref,r:!fir.array<5xf32>}>> + ! CHECK: %[[VAL_17:.*]] = fir.field_index i, !fir.type<_QMcomponents_testTt1{i:!fir.array<6xi32>,r:!fir.array<5xf32>}> + ! CHECK: %[[VAL_18:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_17]] : (!fir.ref,r:!fir.array<5xf32>}>>, !fir.field) -> !fir.ref> + ! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_7]] : !fir.ref + ! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i32) -> i64 + ! CHECK: %[[VAL_20_ADJ:.*]] = arith.subi %[[VAL_20]], %[[VAL_3]] : i64 + ! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_18]], %[[VAL_20_ADJ]] : (!fir.ref>, i64) -> !fir.ref + ! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref + ! CHECK: fir.store %[[VAL_22]] to %[[VAL_23:.*]] : !fir.ref + ! CHECK: br ^bb2 + ! CHECK: ^bb2: + ! CHECK: return + if (j >= 1 .and. j <= 6) then + i = instance%h2(2)%g2(1,2,3)%i(j) + end if + end subroutine s1 + +end module components_test + +! CHECK-LABEL: func @_QPsliced_base() { +! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 50 : index +! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 1 : index +! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 42 : i32 +! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.array<100x!fir.type<_QFsliced_baseTt{x:f32,y:i32}>> {bindc_name = "a", uniq_name = "_QFsliced_baseEa"} +! CHECK: %[[VAL_6:.*]] = fir.field_index y, !fir.type<_QFsliced_baseTt{x:f32,y:i32}> +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.slice %[[VAL_1]], %[[VAL_0]], %[[VAL_1]] path %[[VAL_6]] : (index, index, index, !fir.field) -> !fir.slice<1> +! CHECK: br ^bb1(%[[VAL_3]], %[[VAL_0]] : index, index) +! CHECK: ^bb1(%[[VAL_9:.*]]: index, %[[VAL_10:.*]]: index): +! CHECK: %[[VAL_11:.*]] = arith.cmpi sgt, %[[VAL_10]], %[[VAL_3]] : index +! CHECK: cond_br %[[VAL_11]], ^bb2, ^bb3 +! CHECK: ^bb2: +! CHECK: %[[VAL_12:.*]] = arith.addi %[[VAL_9]], %[[VAL_1]] : index +! CHECK: %[[VAL_13:.*]] = fir.array_coor %[[VAL_5]](%[[VAL_7]]) {{\[}}%[[VAL_8]]] %[[VAL_12]] : (!fir.ref>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref +! CHECK: fir.store %[[VAL_2]] to %[[VAL_13]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_10]], %[[VAL_1]] : index +! CHECK: br ^bb1(%[[VAL_12]], %[[VAL_14]] : index, index) +! CHECK: ^bb3: +! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_5]](%[[VAL_7]]) {{\[}}%[[VAL_8]]] : (!fir.ref>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_int_array(%[[VAL_15]]) : (!fir.box>) -> () +! CHECK: return +! CHECK: } + +subroutine sliced_base() + interface + subroutine takes_int_array(i) + integer :: i(:) + end subroutine + end interface + type t + real :: x + integer :: y + end type + type(t) :: a(100) + a(1:50)%y = 42 + call takes_int_array(a(1:50)%y) +end subroutine + +! CHECK-LABEL: issue772 +subroutine issue772(a, x) + ! Verify that sub-expressions inside a component reference are + ! only evaluated once. + type t + real :: b(100) + end type + real :: x(100) + type(t) :: a(100) + ! CHECK: fir.call @_QPifoo() + ! CHECK-NOT: fir.call @_QPifoo() + x = a(ifoo())%b(1:100:1) + ! CHECK: fir.call @_QPibar() + ! CHECK-NOT: fir.call @_QPibar() + print *, a(20)%b(1:ibar():1) + ! CHECK return +end subroutine + +! ----------------------------------------------------------------------------- +! Test array%character array sections +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QPlhs_char_section( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref}>>>{{.*}}) { +subroutine lhs_char_section(a) + ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 5 : index + ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 10 : index + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_6:.*]] = fir.field_index c, !fir.type<_QFlhs_char_sectionTt{c:!fir.char<1,5>}> + ! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_8:.*]] = fir.slice %[[VAL_5]], %[[VAL_3]], %[[VAL_5]] path %[[VAL_6]] : (index, index, index, !fir.field) -> !fir.slice<1> + ! CHECK: %[[VAL_9:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> + ! CHECK: br ^bb1(%[[VAL_4]], %[[VAL_3]] : index, index) + ! CHECK: ^bb1(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index): + ! CHECK: %[[VAL_12:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_4]] : index + ! CHECK: cond_br %[[VAL_12]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_13:.*]] = arith.addi %[[VAL_10]], %[[VAL_5]] : index + ! CHECK: %[[VAL_14:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) {{\[}}%[[VAL_8]]] %[[VAL_13]] : (!fir.ref}>>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref> + ! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_1]] : (index) -> i64 + ! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_9]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]], %[[VAL_2]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_11]], %[[VAL_5]] : index + ! CHECK: br ^bb1(%[[VAL_13]], %[[VAL_18]] : index, index) + + type t + character(5) :: c + end type + type(t) :: a(10) + a%c = "hello" + ! CHECK: return + ! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPrhs_char_section( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref}>>>{{.*}}, %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine rhs_char_section(a, c) + ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 10 : index + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_9:.*]] = fir.field_index c, !fir.type<_QFrhs_char_sectionTt{c:!fir.char<1,10>}> + ! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_5]], %[[VAL_3]], %[[VAL_5]] path %[[VAL_9]] : (index, index, index, !fir.field) -> !fir.slice<1> + ! CHECK: br ^bb1(%[[VAL_4]], %[[VAL_3]] : index, index) + ! CHECK: ^bb1(%[[VAL_11:.*]]: index, %[[VAL_12:.*]]: index): + ! CHECK: %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_12]], %[[VAL_4]] : index + ! CHECK: cond_br %[[VAL_13]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_11]], %[[VAL_5]] : index + ! CHECK: %[[VAL_15:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_8]]) {{\[}}%[[VAL_10]]] %[[VAL_14]] : (!fir.ref}>>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref> + ! CHECK: %[[VAL_16:.*]] = fir.array_coor %[[VAL_7]](%[[VAL_8]]) %[[VAL_14]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> + ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (index) -> i64 + ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_15]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_18]], %[[VAL_19]], %[[VAL_17]], %[[VAL_2]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_20:.*]] = arith.subi %[[VAL_12]], %[[VAL_5]] : index + ! CHECK: br ^bb1(%[[VAL_14]], %[[VAL_20]] : index, index) + + type t + character(10) :: c + end type + type(t) :: a(10) + character(10) :: c(10) + c = a%c + ! CHECK: return + ! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPelemental_char_section( +! CHECK-SAME: %[[A:.*]]: !fir.ref>{{.*}}, %[[I:.*]]: !fir.ref>{{.*}}) { +subroutine elemental_char_section(a, i) + type t + character(10) :: c + end type + type(t) :: a(10) + integer :: i(10) + ! CHECK-DAG: %[[VAL_34:.*]] = arith.constant 5 : index + ! CHECK-DAG: %[[VAL_35:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_36:.*]] = arith.constant 10 : index + ! CHECK-DAG: %[[VAL_37:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_38:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_39:.*]] = fir.shape %[[VAL_36]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_40:.*]] = fir.field_index c, !fir.type<_QFelemental_char_sectionTt{c:!fir.char<1,10>}> + ! CHECK: %[[VAL_41:.*]] = fir.slice %[[VAL_38]], %[[VAL_36]], %[[VAL_38]] path %[[VAL_40]] : (index, index, index, !fir.field) -> !fir.slice<1> + ! CHECK: %[[VAL_42:.*]] = fir.address_of(@{{.*}}) : !fir.ref> + ! CHECK: br ^bb1(%[[VAL_37]], %[[VAL_36]] : index, index) + ! CHECK:^bb1(%[[VAL_43:.*]]: index, %[[VAL_44:.*]]: index): + ! CHECK: %[[VAL_45:.*]] = arith.cmpi sgt, %[[VAL_44]], %[[VAL_37]] : index + ! CHECK: cond_br %[[VAL_45]], ^bb2, ^bb3 + ! CHECK:^bb2: + ! CHECK: %[[VAL_46:.*]] = arith.addi %[[VAL_43]], %[[VAL_38]] : index + ! CHECK: %[[VAL_47:.*]] = fir.array_coor %[[A]](%[[VAL_39]]) {{\[}}%[[VAL_41]]] %[[VAL_46]] : (!fir.ref}>>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref> + ! CHECK: %[[VAL_49:.*]] = fir.convert %[[VAL_47]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_36]] : (index) -> i64 + ! CHECK: %[[VAL_51:.*]] = fir.convert %[[VAL_42]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_52:.*]] = fir.convert %[[VAL_34]] : (index) -> i64 + ! CHECK: %[[VAL_53:.*]] = fir.call @_FortranAScan1(%[[VAL_49]], %[[VAL_50]], %[[VAL_51]], %[[VAL_52]], %[[VAL_35]]) : (!fir.ref, i64, !fir.ref, i64, i1) -> i64 + ! CHECK: %[[VAL_54:.*]] = fir.convert %[[VAL_53]] : (i64) -> i32 + ! CHECK: %[[VAL_55:.*]] = fir.array_coor %[[I]](%[[VAL_39]]) %[[VAL_46]] : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref + ! CHECK: fir.store %[[VAL_54]] to %[[VAL_55]] : !fir.ref + ! CHECK: %[[VAL_57:.*]] = arith.subi %[[VAL_44]], %[[VAL_38]] : index + ! CHECK: br ^bb1(%[[VAL_46]], %[[VAL_57]] : index, index) + i = scan(a%c, "hello") +end subroutine + +! CHECK-LABEL: extended_type_components +subroutine extended_type_components + type t1 + integer :: t1i = 1 + end type t1 + type, extends(t1) :: t2 + integer :: t2i = 2 + end type t2 + type, extends(t2) :: t3 + integer :: t3i = 3 + end type t3 + type, extends(t3) :: t4 + integer :: t4i = 4 + end type t4 + + type u1 + integer :: u1i = 11 + end type u1 + type, extends(u1) :: u2 + integer :: u2i = 22 + type(t3) :: u2t3 + type(t3) :: u2t4 + end type u2 + type, extends(u2) :: u3 + integer :: u3i = 33 + end type u3 + + ! CHECK: %[[u3v:.*]] = fir.alloca !fir.type<_QFextended_type_componentsTu3{u1i:i32,u2i:i32,u2t3:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}> {bindc_name = "u3v", uniq_name = "_QFextended_type_componentsEu3v"} + type(u3) :: u3v + ! CHECK: %[[u3va:.*]] = fir.alloca !fir.array<5x!fir.type<_QFextended_type_componentsTu3{u1i:i32,u2i:i32,u2t3:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>> {bindc_name = "u3va", uniq_name = "_QFextended_type_componentsEu3va"} + type(u3) :: u3va(5) + + ! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_11:.*]] = fir.field_index u2t3, !fir.type<_QFextended_type_componentsTu3{u1i:i32,u2i:i32,u2t3:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}> + ! CHECK: %[[VAL_12:.*]] = fir.field_index t1i, !fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}> + ! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[u3v]], %[[VAL_11]], %[[VAL_12]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>, !fir.field, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref + ! CHECK: %[[VAL_15:.*]] = fir.call @_FortranAioOutputInteger32(%[[VAL_10]], %[[VAL_14]]) : (!fir.ref, i32) -> i1 + print*, u3v%u2t3%t1i + + ! CHECK: %[[VAL_20:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_13]] : !fir.ref + ! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAioOutputInteger32(%[[VAL_20]], %[[VAL_21]]) : (!fir.ref, i32) -> i1 + print*, u3v%u2%u2t3%t2%t1%t1i ! different syntax for the previous value + + ! CHECK: %[[VAL_30:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_31:.*]] = fir.field_index u2t4, !fir.type<_QFextended_type_componentsTu3{u1i:i32,u2i:i32,u2t3:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}> + ! CHECK: %[[VAL_32:.*]] = fir.coordinate_of %[[u3v]], %[[VAL_31]], %[[VAL_12]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>, !fir.field, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_33:.*]] = fir.load %[[VAL_32]] : !fir.ref + ! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAioOutputInteger32(%[[VAL_30]], %[[VAL_33]]) : (!fir.ref, i32) -> i1 + print*, u3v%u2t4%t1i + + ! CHECK: %[[VAL_40:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_41:.*]] = fir.field_index t2i, !fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}> + ! CHECK: %[[VAL_42:.*]] = fir.coordinate_of %[[u3v]], %[[VAL_31]], %[[VAL_41]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>, !fir.field, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_43:.*]] = fir.load %[[VAL_42]] : !fir.ref + ! CHECK: %[[VAL_44:.*]] = fir.call @_FortranAioOutputInteger32(%[[VAL_40]], %[[VAL_43]]) : (!fir.ref, i32) -> i1 + print*, u3v%u2t4%t2i + + ! CHECK: %[[VAL_50:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_51:.*]] = fir.slice %c1{{.*}}, %c5{{.*}}, %c1{{.*}} path %{{.*}}, %{{.*}} : (index, index, index, !fir.field, !fir.field) -> !fir.slice<1> + ! CHECK: %[[VAL_52:.*]] = fir.embox %[[u3va]](%{{.*}}) [%[[VAL_51]]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>>, + ! CHECK: %[[VAL_53:.*]] = fir.convert %[[VAL_52]] : (!fir.box>) -> !fir.box + ! CHECK: %[[VAL_54:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_50]], %[[VAL_53]]) : (!fir.ref, !fir.box) -> i1 + print*, u3va%u2t3%t1i + + ! CHECK: %[[VAL_60:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_61:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_60]], %[[VAL_53]]) : (!fir.ref, !fir.box) -> i1 + print*, u3va%u2%u2t3%t2%t1%t1i ! different syntax for the previous value + + ! CHECK: %[[VAL_70:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_71:.*]] = fir.slice %c1{{.*}}, %c5{{.*}}, %c1{{.*}} path %{{.*}}, %{{.*}} : (index, index, index, !fir.field, !fir.field) -> !fir.slice<1> + ! CHECK: %[[VAL_72:.*]] = fir.embox %[[u3va]](%{{.*}}) [%[[VAL_71]]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> + ! CHECK: %[[VAL_73:.*]] = fir.convert %[[VAL_72]] : (!fir.box>) -> !fir.box + ! CHECK: %[[VAL_74:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_70]], %[[VAL_73]]) : (!fir.ref, !fir.box) -> i1 + print*, u3va%u2t4%t1i + + ! CHECK: %[[VAL_80:.*]] = fir.call @_FortranAioBeginExternalListOutput(%{{.*}}, %{{.*}}, %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_81:.*]] = fir.slice %c1{{.*}}, %c5{{.*}}, %c1{{.*}} path %{{.*}}, %{{.*}} : (index, index, index, !fir.field, !fir.field) -> !fir.slice<1> + ! CHECK: %[[VAL_82:.*]] = fir.embox %[[u3va]](%{{.*}}) [%[[VAL_81]]] : (!fir.ref,u2t4:!fir.type<_QFextended_type_componentsTt3{t1i:i32,t2i:i32,t3i:i32}>,u3i:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> + ! CHECK: %[[VAL_83:.*]] = fir.convert %[[VAL_82]] : (!fir.box>) -> !fir.box + ! CHECK: %[[VAL_84:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_80]], %[[VAL_83]]) : (!fir.ref, !fir.box) -> i1 + print*, u3va%u2t4%t2i + end subroutine extended_type_components diff --git a/flang/test/Lower/derived-pointer-components.f90 b/flang/test/Lower/derived-pointer-components.f90 --- a/flang/test/Lower/derived-pointer-components.f90 +++ b/flang/test/Lower/derived-pointer-components.f90 @@ -118,6 +118,52 @@ call takes_real_scalar(p1_1(5)%p(7)) end subroutine +! CHECK-LABEL: func @_QMpcompPref_array_real_p( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>>}>>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index +! CHECK: %[[VAL_9:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index +! CHECK: %[[VAL_11:.*]] = arith.constant 50 : i64 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index +! CHECK: %[[VAL_13:.*]] = fir.shift %[[VAL_6]]#0 : (index) -> !fir.shift<1> +! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_15:.*]] = fir.rebox %[[VAL_4]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.box>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_real_array(%[[VAL_15]]) : (!fir.box>) -> () +! CHECK: %[[VAL_16:.*]] = arith.constant 5 : i64 +! CHECK: %[[VAL_17:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_17]] : i64 +! CHECK: %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_18]] : (!fir.ref>>}>>>, i64) -> !fir.ref>>}>> +! CHECK: %[[VAL_20:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_20]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref>>> +! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_24:.*]]:3 = fir.box_dims %[[VAL_22]], %[[VAL_23]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_25:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index +! CHECK: %[[VAL_27:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index +! CHECK: %[[VAL_29:.*]] = arith.constant 50 : i64 +! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i64) -> index +! CHECK: %[[VAL_31:.*]] = fir.shift %[[VAL_24]]#0 : (index) -> !fir.shift<1> +! CHECK: %[[VAL_32:.*]] = fir.slice %[[VAL_26]], %[[VAL_30]], %[[VAL_28]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_33:.*]] = fir.rebox %[[VAL_22]](%[[VAL_31]]) {{\[}}%[[VAL_32]]] : (!fir.box>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_real_array(%[[VAL_33]]) : (!fir.box>) -> () +! CHECK: return +! CHECK: } + + +subroutine ref_array_real_p(p1_0, p1_1) + type(real_p1) :: p1_0, p1_1(100) + call takes_real_array(p1_0%p(20:50:2)) + call takes_real_array(p1_1(5)%p(20:50:2)) +end subroutine + ! CHECK-LABEL: func @_QMpcompPassign_scalar_real ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) subroutine assign_scalar_real_p(p0_0, p1_0, p0_1, p1_1) @@ -673,3 +719,67 @@ end subroutine end module + +! ----------------------------------------------------------------------------- +! Test initial data target +! ----------------------------------------------------------------------------- + +module pinit + use pcomp + ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEarp0 + ! CHECK-DAG: %[[undef:.*]] = fir.undefined + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEreal_target) + ! CHECK: %[[box:.*]] = fir.embox %[[target]] : (!fir.ref) -> !fir.box> + ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTreal_p0{p:!fir.box>}>] : + ! CHECK: fir.has_value %[[insert]] + type(real_p0) :: arp0 = real_p0(real_target) + +! CHECK-LABEL: fir.global @_QMpinitEbrp1 : !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> { +! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: %[[VAL_1:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMpcompEreal_array_target) : !fir.ref> +! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i64 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 5 : i64 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = arith.constant 50 : i64 +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index +! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index +! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index +! CHECK: %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index +! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index +! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index +! CHECK: %[[VAL_18:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_2]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_2]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box>> +! CHECK: %[[VAL_22:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_21]], ["p", !fir.type<_QMpcompTreal_p1{p:!fir.box>>}>] : (!fir.type<_QMpcompTreal_p1{p:!fir.box>>}>, !fir.box>>) -> !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: fir.has_value %[[VAL_22]] : !fir.type<_QMpcompTreal_p1{p:!fir.box>>}> +! CHECK: } + type(real_p1) :: brp1 = real_p1(real_array_target(10:50:5)) + + ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEccp0 + ! CHECK-DAG: %[[undef:.*]] = fir.undefined + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEchar_target) + ! CHECK: %[[box:.*]] = fir.embox %[[target]] : (!fir.ref>) -> !fir.box>> + ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTcst_char_p0{p:!fir.box>>}>] : + ! CHECK: fir.has_value %[[insert]] + type(cst_char_p0) :: ccp0 = cst_char_p0(char_target) + + ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEdcp1 + ! CHECK-DAG: %[[undef:.*]] = fir.undefined + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEchar_array_target) + ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[target]] : (!fir.ref>>) -> !fir.ptr>> + ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}} + ! CHECK-DAG: %[[box:.*]] = fir.embox %[[cast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> + ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTdef_char_p1{p:!fir.box>>>}>] : + ! CHECK: fir.has_value %[[insert]] + type(def_char_p1) :: dcp1 = def_char_p1(char_array_target) +end module diff --git a/flang/test/Lower/dummy-argument-optional-2.f90 b/flang/test/Lower/dummy-argument-optional-2.f90 --- a/flang/test/Lower/dummy-argument-optional-2.f90 +++ b/flang/test/Lower/dummy-argument-optional-2.f90 @@ -119,7 +119,7 @@ ! CHECK: %[[VAL_40:.*]] = fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_40]] to %[[VAL_6]] : !fir.array, !fir.array, !fir.box>> -! CHECK: fir.freemem %[[VAL_9]] +! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> ! CHECK: } end subroutine @@ -155,7 +155,7 @@ ! CHECK: %[[VAL_62:.*]] = fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_62]] to %[[VAL_6]] : !fir.array>, !fir.array>, !fir.box>>> -! CHECK: fir.freemem %[[VAL_9]] +! CHECK: fir.freemem %[[VAL_9]] : !fir.heap>> ! CHECK: } ! CHECK: return ! CHECK: } @@ -189,7 +189,7 @@ ! CHECK: fir.if %[[VAL_6]] { ! CHECK: fir.do_loop {{.*}} { ! CHECK: } -! CHECK: fir.freemem %[[VAL_7]] +! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> ! CHECK: } end subroutine @@ -229,7 +229,7 @@ ! CHECK: %[[VAL_36:.*]] = fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_36]] to %[[VAL_6]] : !fir.array, !fir.array, !fir.box> -! CHECK: fir.freemem %[[VAL_27]] +! CHECK: fir.freemem %[[VAL_27]] : !fir.heap> ! CHECK: } end subroutine @@ -261,7 +261,7 @@ ! CHECK: fir.if %[[VAL_1]] { ! CHECK: %[[VAL_59:.*]] = fir.do_loop {{.*}} { ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_59]] to %[[VAL_7]] : !fir.array>, !fir.array>, !fir.box>> -! CHECK: fir.freemem %[[VAL_49]] +! CHECK: fir.freemem %[[VAL_49]] : !fir.heap>> ! CHECK: } end subroutine @@ -392,7 +392,7 @@ ! CHECK: fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) : (!fir.ref>) -> () ! CHECK: fir.if %[[VAL_1]] { ! CHECK-NOT: fir.do_loop -! CHECK: fir.freemem %[[VAL_7]] +! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> ! CHECK: } end subroutine @@ -420,7 +420,7 @@ ! CHECK: fir.if %[[VAL_1]] { ! CHECK: fir.do_loop {{.*}} { ! CHECK: } -! CHECK: fir.freemem %[[VAL_7]] +! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> ! CHECK: } end subroutine end module diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -6,40 +6,40 @@ ! CHECK-LABEL: func @_QPfoo( ! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f32 real function foo(bar) -real :: bar, x -! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"} -x = 42. -! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref) -> f32) -! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) -> f32 -foo = bar(x) + real :: bar, x + ! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"} + x = 42. + ! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref) -> f32) + ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) -> f32 + foo = bar(x) end function ! Test case where dummy procedure is only transiting. ! CHECK-LABEL: func @_QPprefoo( ! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f32 real function prefoo(bar) -external :: bar -! CHECK: fir.call @_QPfoo(%arg0) : (!fir.boxproc<() -> ()>) -> f32 -prefoo = foo(bar) + external :: bar + ! CHECK: fir.call @_QPfoo(%arg0) : (!fir.boxproc<() -> ()>) -> f32 + prefoo = foo(bar) end function ! Function that will be passed as dummy argument ! CHECK-LABEL: func @_QPfunc( ! CHECK-SAME: %{{.*}}: !fir.ref{{.*}}) -> f32 real function func(x) -real :: x -func = x + 0.5 + real :: x + func = x + 0.5 end function ! Test passing functions as dummy procedure arguments ! CHECK-LABEL: func @_QPtest_func real function test_func() -real :: func, prefoo -external :: func -!CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref) -> f32 -!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> -!CHECK: fir.call @_QPprefoo(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> f32 -test_func = prefoo(func) + real :: func, prefoo + external :: func + !CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> + !CHECK: fir.call @_QPprefoo(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> f32 + test_func = prefoo(func) end function ! Repeat test with dummy subroutine @@ -47,47 +47,47 @@ ! CHECK-LABEL: func @_QPfoo_sub( ! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) subroutine foo_sub(bar_sub) -! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"} -x = 42. -! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref) -> ()) -! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) -call bar_sub(x) + ! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"} + x = 42. + ! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref) -> ()) + ! CHECK: fir.call %[[funccast]](%[[x]]) : (!fir.ref) + call bar_sub(x) end subroutine ! Test case where dummy procedure is only transiting. ! CHECK-LABEL: func @_QPprefoo_sub( ! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) subroutine prefoo_sub(bar_sub) -external :: bar_sub -! CHECK: fir.call @_QPfoo_sub(%arg0) : (!fir.boxproc<() -> ()>) -> () -call foo_sub(bar_sub) + external :: bar_sub + ! CHECK: fir.call @_QPfoo_sub(%arg0) : (!fir.boxproc<() -> ()>) -> () + call foo_sub(bar_sub) end subroutine ! Subroutine that will be passed as dummy argument ! CHECK-LABEL: func @_QPsub( ! CHECK-SAME: %{{.*}}: !fir.ref{{.*}}) subroutine sub(x) -real :: x -print *, x + real :: x + print *, x end subroutine ! Test passing functions as dummy procedure arguments ! CHECK-LABEL: func @_QPtest_sub subroutine test_sub() -external :: sub -!CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref) -> () -!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> ()) -> !fir.boxproc<() -> ()> -!CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call prefoo_sub(sub) + external :: sub + !CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref) -> () + !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> ()) -> !fir.boxproc<() -> ()> + !CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call prefoo_sub(sub) end subroutine ! CHECK-LABEL: func @_QPpassing_not_defined_in_file() subroutine passing_not_defined_in_file() -external proc_not_defined_in_file -! CHECK: %[[addr:.*]] = fir.address_of(@_QPproc_not_defined_in_file) : () -> () -! CHECK: %[[ep:.*]] = fir.emboxproc %[[addr]] -! CHECK: fir.call @_QPprefoo_sub(%[[ep]]) : (!fir.boxproc<() -> ()>) -> () -call prefoo_sub(proc_not_defined_in_file) + external proc_not_defined_in_file + ! CHECK: %[[addr:.*]] = fir.address_of(@_QPproc_not_defined_in_file) : () -> () + ! CHECK: %[[ep:.*]] = fir.emboxproc %[[addr]] + ! CHECK: fir.call @_QPprefoo_sub(%[[ep]]) : (!fir.boxproc<() -> ()>) -> () + call prefoo_sub(proc_not_defined_in_file) end subroutine ! Test passing unrestricted intrinsics @@ -95,50 +95,50 @@ ! Intrinsic using runtime ! CHECK-LABEL: func @_QPtest_acos subroutine test_acos(x) -intrinsic :: acos -!CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref) -> f32 -!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> -!CHECK: fir.call @_QPfoo_acos(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call foo_acos(acos) + intrinsic :: acos + !CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> + !CHECK: fir.call @_QPfoo_acos(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call foo_acos(acos) end subroutine ! CHECK-LABEL: func @_QPtest_atan2 subroutine test_atan2() -intrinsic :: atan2 -! CHECK: %[[f:.*]] = fir.address_of(@fir.atan2.f32.ref_f32.ref_f32) : (!fir.ref, !fir.ref) -> f32 -! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref, !fir.ref) -> f32) -> !fir.boxproc<() -> ()> -! CHECK: fir.call @_QPfoo_atan2(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call foo_atan2(atan2) + intrinsic :: atan2 + ! CHECK: %[[f:.*]] = fir.address_of(@fir.atan2.f32.ref_f32.ref_f32) : (!fir.ref, !fir.ref) -> f32 + ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref, !fir.ref) -> f32) -> !fir.boxproc<() -> ()> + ! CHECK: fir.call @_QPfoo_atan2(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call foo_atan2(atan2) end subroutine ! Intrinsic implemented inlined ! CHECK-LABEL: func @_QPtest_aimag subroutine test_aimag() -intrinsic :: aimag -!CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z4) : (!fir.ref>) -> f32 -!CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref>) -> f32) -> !fir.boxproc<() -> ()> -!CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call foo_aimag(aimag) + intrinsic :: aimag + !CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z4) : (!fir.ref>) -> f32 + !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref>) -> f32) -> !fir.boxproc<() -> ()> + !CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call foo_aimag(aimag) end subroutine ! Character Intrinsic implemented inlined ! CHECK-LABEL: func @_QPtest_len subroutine test_len() -intrinsic :: len -! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32 -! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.boxchar<1>) -> i32) -> !fir.boxproc<() -> ()> -!CHECK: fir.call @_QPfoo_len(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call foo_len(len) + intrinsic :: len + ! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32 + ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.boxchar<1>) -> i32) -> !fir.boxproc<() -> ()> + !CHECK: fir.call @_QPfoo_len(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call foo_len(len) end subroutine ! Intrinsic implemented inlined with specific name different from generic ! CHECK-LABEL: func @_QPtest_iabs subroutine test_iabs() -intrinsic :: iabs -! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref) -> i32 -! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> i32) -> !fir.boxproc<() -> ()> -! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () -call foo_iabs(iabs) + intrinsic :: iabs + ! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref) -> i32 + ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref) -> i32) -> !fir.boxproc<() -> ()> + ! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) : (!fir.boxproc<() -> ()>) -> () + call foo_iabs(iabs) end subroutine ! TODO: exhaustive test of unrestricted intrinsic table 16.2 @@ -148,28 +148,28 @@ ! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) ! SHOULD-CHECK: func @_QPtodo3(%arg0: (!fir.ref) -> f32) subroutine todo3(dummy_proc) -intrinsic :: acos -procedure(acos) :: dummy_proc + intrinsic :: acos + procedure(acos) :: dummy_proc end subroutine ! CHECK-LABEL: func private @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 -!CHECK: %[[load:.*]] = fir.load %arg0 -!CHECK: %[[res:.*]] = fir.call @__fs_acos_1(%[[load]]) : (f32) -> f32 -!CHECK: return %[[res]] : f32 + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[res:.*]] = fir.call @__fs_acos_1(%[[load]]) : (f32) -> f32 + !CHECK: return %[[res]] : f32 ! CHECK-LABEL: func private @fir.atan2.f32.ref_f32.ref_f32( ! CHECK-SAME: %[[x:.*]]: !fir.ref, %[[y:.*]]: !fir.ref) -> f32 -! CHECK-DAG: %[[xload:.*]] = fir.load %[[x]] : !fir.ref -! CHECK-DAG: %[[yload:.*]] = fir.load %[[y]] : !fir.ref -! CHECK: %[[atan2:.*]] = fir.call @__fs_atan2_1(%[[xload]], %[[yload]]) : (f32, f32) -> f32 -! CHECK: return %[[atan2]] : f32 + ! CHECK-DAG: %[[xload:.*]] = fir.load %[[x]] : !fir.ref + ! CHECK-DAG: %[[yload:.*]] = fir.load %[[y]] : !fir.ref + ! CHECK: %[[atan2:.*]] = fir.call @__fs_atan2_1(%[[xload]], %[[yload]]) : (f32, f32) -> f32 + ! CHECK: return %[[atan2]] : f32 !CHECK-LABEL: func private @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) -!CHECK: %[[load:.*]] = fir.load %arg0 -!CHECK: %[[imag:.*]] = fir.extract_value %[[load]], [1 : index] : (!fir.complex<4>) -> f32 -!CHECK: return %[[imag]] : f32 + !CHECK: %[[load:.*]] = fir.load %arg0 + !CHECK: %[[imag:.*]] = fir.extract_value %[[load]], [1 : index] : (!fir.complex<4>) -> f32 + !CHECK: return %[[imag]] : f32 !CHECK-LABEL: func private @fir.len.i32.bc1(%arg0: !fir.boxchar<1>) -!CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) -!CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 -!CHECK: return %[[len]] : i32 + !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) + !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32 + !CHECK: return %[[len]] : i32 diff --git a/flang/test/Lower/explicit-interface-results.f90 b/flang/test/Lower/explicit-interface-results.f90 --- a/flang/test/Lower/explicit-interface-results.f90 +++ b/flang/test/Lower/explicit-interface-results.f90 @@ -119,7 +119,7 @@ ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>>) -> !fir.heap> ! CHECK: %[[cmpi:.*]] = arith.cmpi ! CHECK: fir.if %[[cmpi]] - ! CHECK: fir.freemem %[[addr]] + ! CHECK: fir.freemem %[[addr]] : !fir.heap> end subroutine ! CHECK-LABEL: func @_QMcallerPcst_char_alloc() @@ -133,7 +133,7 @@ ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>>>) -> !fir.heap>> ! CHECK: %[[cmpi:.*]] = arith.cmpi ! CHECK: fir.if %[[cmpi]] - ! CHECK: fir.freemem %[[addr]] + ! CHECK: fir.freemem %[[addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMcallerPdef_char_alloc() @@ -147,7 +147,7 @@ ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>>>) -> !fir.heap>> ! CHECK: %[[cmpi:.*]] = arith.cmpi ! CHECK: fir.if %[[cmpi]] - ! CHECK: fir.freemem %[[addr]] + ! CHECK: fir.freemem %[[addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMcallerPpointer_test() @@ -271,7 +271,7 @@ ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>>>) -> !fir.heap>> ! CHECK: %[[cmpi:.*]] = arith.cmpi ! CHECK: fir.if %[[cmpi]] - ! CHECK: fir.freemem %[[addr]] + ! CHECK: fir.freemem %[[addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: @_QMcallerPdyn_char_pointer diff --git a/flang/test/Lower/forall/forall-where-2.f90 b/flang/test/Lower/forall/forall-where-2.f90 --- a/flang/test/Lower/forall/forall-where-2.f90 +++ b/flang/test/Lower/forall/forall-where-2.f90 @@ -44,7 +44,7 @@ ! CHECK: %[[tempAddr:.*]] = fir.box_addr %[[box]] : (!fir.box>>) -> !fir.heap> ! 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]] +! CHECK: fir.freemem %[[tempAddr]] : !fir.heap> ! CHECK: } ! CHECK: } ! Where assignment diff --git a/flang/test/Lower/ifconvert.f90 b/flang/test/Lower/ifconvert.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/ifconvert.f90 @@ -0,0 +1,96 @@ +! RUN: bbc -fdebug-dump-pre-fir %s 2>&1 | FileCheck %s + +! Note: PFT dump output is fairly stable, including node indexes and +! annotations, so all output is CHECKed. + + ! CHECK: 1 Program + ! CHECK: 1 PrintStmt: print* + print* + + ! CHECK: <> -> 8 + ! CHECK: 2 NonLabelDoStmt -> 7: do i = 1, 5 + ! CHECK: <> -> 7 + ! CHECK: 3 ^IfStmt [negate] -> 7: if(i <= 1 .or. i >= 5) cycle + ! CHECK: 6 ^PrintStmt: print*, i + ! CHECK: 5 EndIfStmt + ! CHECK: <> + ! CHECK: 7 EndDoStmt -> 2: end do + ! CHECK: <> + do i = 1, 5 + if (i <= 1 .or. i >= 5) cycle + print*, i + end do + + ! CHECK: 8 PrintStmt: print* + print* + + ! CHECK: <> -> 15 + ! CHECK: 9 NonLabelDoStmt -> 14: do i = 1, 5 + ! CHECK: <> -> 14 + ! CHECK: 10 ^IfStmt [negate] -> 14: if(i <= 1 .or. i >= 5) cycle + ! CHECK: 13 ^PrintStmt: print*, i + ! CHECK: 12 EndIfStmt + ! CHECK: <> + ! CHECK: 14 EndDoStmt -> 9: 2 end do + ! CHECK: <> + do i = 1, 5 + if (i <= 1 .or. i >= 5) cycle + print*, i +2 end do + + ! CHECK: 15 PrintStmt: print* + print* + + ! CHECK:<> -> 30 + ! CHECK: 16 NonLabelDoStmt -> 29: outer: do i = 1, 3 + ! CHECK: <> -> 29 + ! CHECK: 17 ^NonLabelDoStmt -> 28: inner: do j = 1, 5 + ! CHECK: <> -> 28 + ! CHECK: 18 ^IfStmt [negate] -> 28: if(j <= 1 .or. j >= 5) cycle inner + ! CHECK: <> -> 28 + ! CHECK: 21 ^IfStmt [negate] -> 28: if(j == 3) goto 3 + ! CHECK: <> -> 27 + ! CHECK: 24 ^IfStmt -> 27: if(j == 4) cycle outer + ! CHECK: 25 ^CycleStmt! -> 29: cycle outer + ! CHECK: 26 EndIfStmt + ! CHECK: <> + ! CHECK: 27 ^PrintStmt: print*, j + ! CHECK: 23 EndIfStmt + ! CHECK: <> + ! CHECK: 20 EndIfStmt + ! CHECK: <> + ! CHECK: 28 ^EndDoStmt -> 17: 3 end do inner + ! CHECK: <> + ! CHECK: 29 ^EndDoStmt -> 16: end do outer + ! CHECK:<> + outer: do i = 1, 3 + inner: do j = 1, 5 + if (j <= 1 .or. j >= 5) cycle inner + if (j == 3) goto 3 + if (j == 4) cycle outer + print*, j + 3 end do inner + end do outer + + ! CHECK: 30 ^PrintStmt: print* + print* + + ! CHECK:<> -> 40 + ! CHECK: 31 NonLabelDoStmt -> 39: do i = 1, 5 + ! CHECK: <> -> 39 + ! CHECK: 32 ^IfStmt [negate] -> 39: if(i == 3) goto 4 + ! CHECK: <> -> 39 + ! CHECK: 35 ^IfStmt [negate] -> 39: if(i <= 1 .or. i >= 5) cycle + ! CHECK: 38 ^PrintStmt: print*, i + ! CHECK: 37 EndIfStmt + ! CHECK: <> + ! CHECK: 34 EndIfStmt + ! CHECK: <> + ! CHECK: 39 EndDoStmt -> 31: 4 end do + ! CHECK:<> + do i = 1, 5 + if (i == 3) goto 4 + if (i <= 1 .or. i >= 5) cycle + print*, i +4 end do +end diff --git a/flang/test/Lower/intrinsic-procedure-wrappers.f90 b/flang/test/Lower/intrinsic-procedure-wrappers.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/intrinsic-procedure-wrappers.f90 @@ -0,0 +1,10 @@ +! RUN: bbc -outline-intrinsics %s -o - | tco --disable-llvm --mlir-print-ir-after=fir-to-llvm-ir 2>&1 | FileCheck %s + +! Test properties of intrinsic function wrappers + +! Test that intrinsic wrappers have internal linkage +function foo(x) + foo = acos(x) +end function + +! CHECK: llvm.func internal @fir.acos.f32.f32 diff --git a/flang/test/Lower/irreducible.f90 b/flang/test/Lower/irreducible.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/irreducible.f90 @@ -0,0 +1,24 @@ +! RUN: bbc %s -o "-" | FileCheck %s + + ! CHECK-LABEL: irreducible + subroutine irreducible(k) + ! CHECK: cond_br %{{[0-9]+}}, ^bb1, ^bb2 + if (k < 5) goto 20 + ! CHECK: ^bb1: // 2 preds: ^bb0, ^bb2 +10 print*, k ! scc entry #1: (k < 5) is false + k = k + 1 + ! CHECK: ^bb2: // 2 preds: ^bb0, ^bb1 + ! CHECK: cond_br %{{[0-9]+}}, ^bb1, ^bb3 +20 if (k < 3) goto 10 ! scc entry #2: (k < 5) is true + ! CHECK: ^bb3: // pred: ^bb2 + end + + ! CHECK-LABEL: main + program p + do i = 0, 6 + n = i + print* + print*, 1000 + n + call irreducible(n) + enddo + end diff --git a/flang/test/Lower/loops2.f90 b/flang/test/Lower/loops2.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/loops2.f90 @@ -0,0 +1,146 @@ +! Test loop variables increment +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +module test_loop_var + implicit none + integer, pointer:: i_pointer + integer, allocatable :: i_allocatable + real, pointer :: x_pointer + real, allocatable :: x_allocatable +contains +! CHECK-LABEL: func @_QMtest_loop_varPtest_pointer + subroutine test_pointer() + do i_pointer=1,10 + enddo +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMtest_loop_varEi_pointer) : !fir.ref>> +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>) -> !fir.ptr +! CHECK: fir.do_loop %[[VAL_9:.*]] = +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (index) -> i32 +! CHECK: fir.store %[[VAL_10]] to %[[VAL_2]] : !fir.ptr +! CHECK: } +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_13:.*]] : (index) -> i32 +! CHECK: fir.store %[[VAL_12]] to %[[VAL_2]] : !fir.ptr + end subroutine + +! CHECK-LABEL: func @_QMtest_loop_varPtest_allocatable + subroutine test_allocatable() + do i_allocatable=1,10 + enddo +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMtest_loop_varEi_allocatable) : !fir.ref>> +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>) -> !fir.heap +! CHECK: fir.do_loop %[[VAL_9:.*]] = +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (index) -> i32 +! CHECK: fir.store %[[VAL_10]] to %[[VAL_2]] : !fir.heap +! CHECK: } +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_13:.*]] : (index) -> i32 +! CHECK: fir.store %[[VAL_12]] to %[[VAL_2]] : !fir.heap + end subroutine + +! CHECK-LABEL: func @_QMtest_loop_varPtest_real_pointer + subroutine test_real_pointer() + do x_pointer=1,10 + enddo +! CHECK: %[[VAL_0:.*]] = fir.alloca index +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMtest_loop_varEx_pointer) : !fir.ref>> +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> f32 +! CHECK: %[[VAL_8:.*]] = arith.constant 1.000000e+00 : f32 + +! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.ptr +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: cond_br %{{.*}}, ^bb2, ^bb3 +! CHECK: ^bb2: +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_3]] : !fir.ptr +! CHECK: %[[VAL_20:.*]] = arith.addf %[[VAL_19]], %[[VAL_8]] : f32 +! CHECK: fir.store %[[VAL_20]] to %[[VAL_3]] : !fir.ptr +! CHECK: br ^bb1 +! CHECK: ^bb3: +! CHECK: return + end subroutine + +! CHECK-LABEL: func @_QMtest_loop_varPtest_real_allocatable + subroutine test_real_allocatable() + do x_allocatable=1,10 + enddo +! CHECK: %[[VAL_0:.*]] = fir.alloca index +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMtest_loop_varEx_allocatable) : !fir.ref>> +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> f32 +! CHECK: %[[VAL_8:.*]] = arith.constant 1.000000e+00 : f32 + +! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.heap +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: cond_br %{{.*}}, ^bb2, ^bb3 +! CHECK: ^bb2: +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_3]] : !fir.heap +! CHECK: %[[VAL_20:.*]] = arith.addf %[[VAL_19]], %[[VAL_8]] : f32 +! CHECK: fir.store %[[VAL_20]] to %[[VAL_3]] : !fir.heap +! CHECK: br ^bb1 +! CHECK: ^bb3: +! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QMtest_loop_varPtest_pointer_unstructured_loop() + subroutine test_pointer_unstructured_loop() + do i_pointer=1,10 + if (i_pointer .gt. 5) exit + enddo +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMtest_loop_varEi_pointer) : !fir.ref>> +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i32 +! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ptr +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: cond_br %{{.*}}, ^bb2, ^bb5 +! CHECK: ^bb2: +! CHECK: cond_br %{{.*}}, ^bb3, ^bb4 +! CHECK: ^bb3: +! CHECK: br ^bb5 +! CHECK: ^bb4: +! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_3]] : !fir.ptr +! CHECK: %[[VAL_22:.*]] = arith.addi %[[VAL_21]], %[[VAL_6]] : i32 +! CHECK: fir.store %[[VAL_22]] to %[[VAL_3]] : !fir.ptr +! CHECK: br ^bb1 +! CHECK: ^bb5: +! CHECK: return +! CHECK: } + end subroutine + +end module + + use test_loop_var + implicit none + integer, target :: i_target = -1 + real, target :: x_target = -1. + i_pointer => i_target + allocate(i_allocatable) + i_allocatable = -1 + x_pointer => x_target + allocate(x_allocatable) + x_allocatable = -1. + + call test_pointer() + call test_allocatable() + call test_real_pointer() + call test_real_allocatable() + ! Expect 11 everywhere + print *, i_target + print *, i_allocatable + print *, x_target + print *, x_allocatable + + call test_pointer_unstructured_loop() + call test_allocatable_unstructured_loop() + ! Expect 6 everywhere + print *, i_target +end diff --git a/flang/test/Lower/non-standard-extensions.f90 b/flang/test/Lower/non-standard-extensions.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/non-standard-extensions.f90 @@ -0,0 +1,16 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test lowering of non standard features. + +! Test mismatch on result type between callee/caller +! CHECK-LABEL: func @_QPexpect_i32 +subroutine expect_i32() + external :: returns_i32 + real(4) :: returns_i32 + ! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QPreturns_i32) : () -> i32 + ! CHECK: %[[funcCast:.*]] = fir.convert %[[funcAddr]] : (() -> i32) -> (() -> f32) + ! CHECK: fir.call %[[funcCast]]() : () -> f32 + print *, returns_i32() +end subroutine +integer(4) function returns_i32() +end function diff --git a/flang/test/Lower/stop-statement.f90 b/flang/test/Lower/stop-statement.f90 --- a/flang/test/Lower/stop-statement.f90 +++ b/flang/test/Lower/stop-statement.f90 @@ -7,17 +7,6 @@ ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) ! CHECK-NEXT: fir.unreachable stop -end subroutine - - -! CHECK-LABEL: stop_error -subroutine stop_error() - error stop - ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 - ! CHECK-DAG: %[[true:.*]] = arith.constant true - ! CHECK-DAG: %[[false:.*]] = arith.constant false - ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) - ! CHECK-NEXT: fir.unreachable end subroutine ! CHECK-LABEL: stop_code @@ -29,13 +18,13 @@ ! CHECK-NEXT: fir.unreachable end subroutine -! CHECK-LABEL: stop_quiet_constant -subroutine stop_quiet_constant() - stop, quiet = .true. +! CHECK-LABEL: stop_error +subroutine stop_error() + error stop + ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 ! CHECK-DAG: %[[true:.*]] = arith.constant true ! CHECK-DAG: %[[false:.*]] = arith.constant false - ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 - ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[true]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) ! CHECK-NEXT: fir.unreachable end subroutine @@ -52,6 +41,28 @@ ! CHECK-NEXT: fir.unreachable end subroutine +! CHECK-LABEL: stop_quiet_constant +subroutine stop_quiet_constant() + stop, quiet = .true. + ! CHECK-DAG: %[[true:.*]] = arith.constant true + ! CHECK-DAG: %[[false:.*]] = arith.constant false + ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[true]]) + ! CHECK-NEXT: fir.unreachable +end subroutine + +! CHECK-LABEL: stop_error_code_quiet +subroutine stop_error_code_quiet(b) + logical :: b + error stop 66, quiet = b + ! CHECK-DAG: %[[c66:.*]] = arith.constant 66 : i32 + ! CHECK-DAG: %[[true:.*]] = arith.constant true + ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) + ! CHECK-NEXT: fir.unreachable +end subroutine + ! CHECK-LABEL: stop_char_lit subroutine stop_char_lit ! CHECK-DAG: %[[false:.*]] = arith.constant false @@ -63,3 +74,6 @@ ! CHECK-NEXT: fir.unreachable stop 'crash' end subroutine stop_char_lit + +! CHECK-DAG: func private @_Fortran{{.*}}StopStatement(i32, i1, i1) -> none +! CHECK-DAG: func private @_Fortran{{.*}}StopStatementText(!fir.ref, i64, i1, i1) -> none diff --git a/flang/test/Lower/transformational-intrinsics.f90 b/flang/test/Lower/transformational-intrinsics.f90 --- a/flang/test/Lower/transformational-intrinsics.f90 +++ b/flang/test/Lower/transformational-intrinsics.f90 @@ -33,7 +33,7 @@ ! CHECK: %[[io_embox_cast:.*]] = fir.convert %[[io_embox]] : (!fir.box>>) -> !fir.box ! CHECK: fir.call @_Fortran{{.*}}ioOutputDescriptor({{.*}}, %[[io_embox_cast]]) : (!fir.ref, !fir.box) -> i1 print *, all(x, 1) - ! CHECK: fir.freemem %[[res_addr]] + ! CHECK: fir.freemem %[[res_addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMtest2Pin_call( @@ -52,7 +52,7 @@ ! CHECK: %[[call_embox:.*]] = fir.embox %[[res_addr]](%[[res_shape]]) : (!fir.heap>>, !fir.shapeshift<1>) -> !fir.box>> ! CHECK: fir.call @_QPtakes_array_desc(%[[call_embox]]) : (!fir.box>>) -> () call takes_array_desc(all(x, 1)) - ! CHECK: fir.freemem %[[res_addr]] + ! CHECK: fir.freemem %[[res_addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMtest2Pin_implicit_call( @@ -66,7 +66,7 @@ ! CHECK: %[[res_addr_cast:.*]] = fir.convert %[[res_addr]] : (!fir.heap>>) -> !fir.ref>> ! CHECK: fir.call @_QPtakes_implicit_array(%[[res_addr_cast]]) : (!fir.ref>>) -> () call takes_implicit_array(all(x, 1)) - ! CHECK: fir.freemem %[[res_addr]] + ! CHECK: fir.freemem %[[res_addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMtest2Pin_assignment( @@ -89,7 +89,7 @@ ! CHECK: } ! CHECK: fir.array_merge_store %[[y_load]], %[[assign]] to %[[arg1]] : !fir.array>, !fir.array>, !fir.box>> y = all(x, 1) - ! CHECK: fir.freemem %[[res_addr]] + ! CHECK: fir.freemem %[[res_addr]] : !fir.heap>> end subroutine ! CHECK-LABEL: func @_QMtest2Pin_elem_expr( @@ -118,7 +118,7 @@ ! CHECK: } ! CHECK: fir.array_merge_store %[[z_load]], %[[elem_expr]] to %[[arg2]] : !fir.array>, !fir.array>, !fir.box>> z = y .neqv. all(x, 1) - ! CHECK: fir.freemem %[[res_addr]] + ! CHECK: fir.freemem %[[res_addr]] : !fir.heap>> end subroutine ! CSHIFT @@ -179,7 +179,7 @@ ! CHECK: fir.result %[[VAL_53:.*]] : !fir.array<3x3xi32> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_16]], %[[VAL_54:.*]] to %[[VAL_8]] : !fir.array<3x3xi32>, !fir.array<3x3xi32>, !fir.ref> - ! CHECK: fir.freemem %[[VAL_38]] + ! CHECK: fir.freemem %[[VAL_38]] : !fir.heap> ! CHECK: %[[VAL_55:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_56:.*]] = fir.array_load %[[VAL_14]](%[[VAL_55]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<6xi32> ! CHECK: %[[VAL_57:.*]] = arith.constant 3 : i32 @@ -214,7 +214,7 @@ ! CHECK: fir.result %[[VAL_85]] : !fir.array<6xi32> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_56]], %[[VAL_86:.*]] to %[[VAL_14]] : !fir.array<6xi32>, !fir.array<6xi32>, !fir.ref> - ! CHECK: fir.freemem %[[VAL_75]] + ! CHECK: fir.freemem %[[VAL_75]] : !fir.heap> ! CHECK: return ! CHECK: } @@ -263,7 +263,7 @@ ! CHECK: fir.call @_FortranAUnpack(%[[a19]], %[[a20]], %[[a21]], %[[a22]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none ! CHECK-NEXT: %[[a22:.*]] = fir.load %{{.*}} : !fir.ref>>> ! CHECK: %[[a25:.*]] = fir.box_addr %[[a22]] : (!fir.box>>) -> !fir.heap> - ! CHECK: fir.freemem %[[a25]] + ! CHECK: fir.freemem %[[a25]] : !fir.heap> ! CHECK: %[[a36:.*]] = fir.shape %{{.*}}, %{{.*}} : (index, index) -> !fir.shape<2> ! CHECK: %[[a38:.*]] = fir.shape %{{.*}} : (index) -> !fir.shape<1> ! CHECK-NEXT: %[[a39:.*]] = fir.embox %[[a6]](%[[a38]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> @@ -282,7 +282,7 @@ ! CHECK: fir.call @_FortranAUnpack(%[[a47]], %[[a48]], %[[a49]], %[[a50]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none ! CHECK: %[[a53:.*]] = fir.load %[[a0]] : !fir.ref>>> ! CHECK: %[[a56:.*]] = fir.box_addr %[[a53]] : (!fir.box>>) -> !fir.heap> - ! CHECK: fir.freemem %[[a56]] + ! CHECK: fir.freemem %[[a56]] : !fir.heap> ! CHECK-NEXT: return end subroutine unpack_test diff --git a/flang/test/Lower/vector-subscript-io.f90 b/flang/test/Lower/vector-subscript-io.f90 --- a/flang/test/Lower/vector-subscript-io.f90 +++ b/flang/test/Lower/vector-subscript-io.f90 @@ -89,7 +89,7 @@ ! CHECK: %[[VAL_58:.*]] = arith.cmpi ne, %[[VAL_57]], %[[VAL_28]] : i64 ! CHECK: cf.cond_br %[[VAL_58]], ^bb4, ^bb5 ! CHECK: ^bb4: -! CHECK: fir.freemem %[[VAL_56]] +! CHECK: fir.freemem %[[VAL_56]] : !fir.heap> ! CHECK: cf.br ^bb5 ! CHECK: ^bb5: ! CHECK: %[[VAL_59:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_34]]) : (!fir.ref) -> i32 diff --git a/flang/test/Lower/where.f90 b/flang/test/Lower/where.f90 --- a/flang/test/Lower/where.f90 +++ b/flang/test/Lower/where.f90 @@ -48,7 +48,7 @@ ! CHECK: fir.result %[[VAL_43:.*]] : !fir.array<10xf32> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_25]], %[[VAL_44:.*]] to %[[VAL_2]] : !fir.array<10xf32>, !fir.array<10xf32>, !fir.ref> - ! CHECK: fir.freemem %[[VAL_9]] + ! CHECK: fir.freemem %[[VAL_9]] : !fir.heap>> ! CHECK: %[[VAL_46:.*]] = arith.constant 10 : index ! CHECK: %[[VAL_47:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_48:.*]] = fir.array_load %[[VAL_0]](%[[VAL_47]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> @@ -217,8 +217,8 @@ ! CHECK: fir.result %[[VAL_192:.*]] : !fir.array<10xf32> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_166]], %[[VAL_193:.*]] to %[[VAL_0]] : !fir.array<10xf32>, !fir.array<10xf32>, !fir.ref> - ! CHECK: fir.freemem %[[VAL_92]] - ! CHECK: fir.freemem %[[VAL_50]] + ! CHECK: fir.freemem %[[VAL_92]] : !fir.heap>> + ! CHECK: fir.freemem %[[VAL_50]] : !fir.heap>> ! CHECK: return ! CHECK: }