Skip to content

Commit f385b28

Browse files
authored
Merge pull request #231 from flang-compiler/jpr-fix-stmt-func-test-2
Fix stmt-func test: do not hard code operand evaluation order
2 parents 65b67cb + 441c02f commit f385b28

File tree

1 file changed

+17
-16
lines changed

1 file changed

+17
-16
lines changed

flang/test/Lower/stmt-function.f90

Lines changed: 17 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
! RUN: bbc -emit-fir %s -o - | FileCheck %s
1+
! RUN: bbc -emit-fir -outline-intrinsics %s -o - | FileCheck %s
22

33
! Test statement function lowering
44

@@ -44,15 +44,15 @@ real function test_stmt_1(x, a)
4444

4545
b = 5
4646

47-
!CHECK: %[[cst_8:.*]] = constant 8.000000e+00
48-
!CHECK: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref<f32>
47+
!CHECK-DAG: %[[cst_8:.*]] = constant 8.000000e+00
48+
!CHECK-DAG: fir.store %[[cst_8]] to %[[tmp1:.*]] : !fir.ref<f32>
4949
!CHECK-DAG: %[[foocall1:.*]] = fir.call @_QPfoo(%[[tmp1]])
5050
!CHECK-DAG: %[[aload1:.*]] = fir.load %arg1
51-
!CHECK-DAG: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]]
51+
!CHECK: %[[add1:.*]] = fir.addf %[[aload1]], %[[foocall1]]
5252
!CHECK: fir.store %[[add1]] to %[[res1]]
5353
res1 = func1(8.)
5454

55-
!CHECK: %[[x:.*]] = fir.load %arg0
55+
!CHECK-DAG: %[[x:.*]] = fir.load %arg0
5656
!CHECK-DAG: fir.store %[[x]] to %[[tmp2:.*]] : !fir.ref<f32>
5757
!CHECK-DAG: %[[foocall2:.*]] = fir.call @_QPfoo(%[[tmp2]])
5858
!CHECK-DAG: %[[aload2:.*]] = fir.load %arg1
@@ -81,16 +81,17 @@ real function test_stmt_no_args(x, y)
8181
end function
8282

8383
! Test statement function with character arguments
84-
integer function test_stmt_character(c, j, n)
84+
integer function test_stmt_character(c, j)
8585
integer :: i, j, func, argj
86-
integer(8) :: n
87-
character(n) :: c, arg
88-
func(arg, argj) = len(arg) + argj
89-
!CHECK: %[[j:.*]] = fir.load %arg1
90-
!CHECK: %[[n:.*]] = fir.load %arg2
91-
!CHECK: %[[n32:.*]] = fir.convert %[[n]] : (i64) -> i32
92-
!CHECK: addi %[[n32]], %[[j]]
86+
character(10) :: c, argc
87+
!CHECK-DAG: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 :
88+
!CHECK-DAG: %[[c10:.*]] = constant 10 :
89+
!CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10]]
90+
91+
func(argc, argj) = len_trim(argc, 4) + argj
92+
!CHECK-DAG: %[[j:.*]] = fir.load %arg1
93+
!CHECK-DAG: %[[c4:.*]] = constant 4 :
94+
!CHECK-DAG: %[[len_trim:.*]] = call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]])
95+
!CHECK: addi %[[len_trim]], %[[j]]
9396
test_stmt_character = func(c, j)
94-
end function
95-
96-
97+
end function

0 commit comments

Comments
 (0)