diff --git a/flang/test/Driver/dump-pft.f90 b/flang/test/Driver/dump-pft.f90 index 6d98fc9f10b89..5e940c769449f 100644 --- a/flang/test/Driver/dump-pft.f90 +++ b/flang/test/Driver/dump-pft.f90 @@ -4,8 +4,8 @@ ! PFT: 1 Subroutine test_routine: subroutine test_routine(a, b, n) ! PFT-NEXT: 1 EndSubroutineStmt: end subroutine -! PRF-NEXT: End Subroutine test_routine -! PFT-NO: Program -> ProgramUnit -> SubroutineSubprogram +! PFT-NEXT: End Subroutine test_routine +! PFT-NOT: Program -> ProgramUnit -> SubroutineSubprogram ! PARSE_TREE: Program -> ProgramUnit -> SubroutineSubprogram ! PARSE_TREE-NEXT: | SubroutineStmt @@ -17,7 +17,7 @@ ! PARSE_TREE-NEXT: | | ImplicitPart -> ! PARSE_TREE-NEXT: | ExecutionPart -> Block ! PARSE_TREE-NEXT: | EndSubroutineStmt -> -! PARSE_TREE-NO: Subroutine test_routine: subroutine test_routine(a, b, n) +! PARSE_TREE-NOT: Subroutine test_routine: subroutine test_routine(a, b, n) subroutine test_routine(a, b, n) end subroutine diff --git a/flang/test/Driver/func-attr-fast-math.f90 b/flang/test/Driver/func-attr-fast-math.f90 index 05824a6078a09..c21f385fe690f 100644 --- a/flang/test/Driver/func-attr-fast-math.f90 +++ b/flang/test/Driver/func-attr-fast-math.f90 @@ -7,7 +7,7 @@ end subroutine func ! CHECK-NOFASTMATH-LABEL: define void @func_() local_unnamed_addr ! CHECK-NOFASTMATH-SAME: #[[ATTRS:[0-9]+]] -! CHECK-NOT fp-math"= +! CHECK-NOT: fp-math"= ! CHECK-OFAST-LABEL: define void @func_() local_unnamed_addr ! CHECK-OFAST-SAME: #[[ATTRS:[0-9]+]] diff --git a/flang/test/Driver/omp-cse-region-boundary.f90 b/flang/test/Driver/omp-cse-region-boundary.f90 deleted file mode 100644 index 726ac4899ba70..0000000000000 --- a/flang/test/Driver/omp-cse-region-boundary.f90 +++ /dev/null @@ -1,28 +0,0 @@ -!This test checks that when compiling an OpenMP program for the target device -!CSE is not done across target op region boundaries. It also checks that when -!compiling for the host CSE is done. -!RUN: %flang_fc1 -fopenmp-is-target-device -emit-mlir -fopenmp %s -o - | fir-opt -cse | FileCheck %s -check-prefix=CHECK-DEVICE -!RUN: %flang_fc1 -emit-mlir -fopenmp %s -o - | fir-opt -cse | FileCheck %s -check-prefix=CHECK-HOST -!RUN: bbc -fopenmp-is-target-device -emit-fir -fopenmp %s -o - | fir-opt -cse | FileCheck %s -check-prefix=CHECK-DEVICE -!RUN: bbc -emit-fir -fopenmp %s -o - | fir-opt -cse | FileCheck %s -check-prefix=CHECK-HOST - -!Constant should be present inside target region. -!CHECK-DEVICE: omp.target -!CHECK-DEVICE: arith.constant 10 -!CHECK-DEVICE: omp.terminator - -!Constant should not be present inside target region. -!CHECK-HOST: omp.target -!CHECK-NOT-HOST: arith.constant 10 -!CHECK-HOST: omp.terminator - -subroutine writeIndex(sum) - integer :: sum - integer :: myconst1 - integer :: myconst2 - myconst1 = 10 -!$omp target map(from:myconst2) - myconst2 = 10 -!$omp end target - sum = myconst2 + myconst2 -end subroutine writeIndex diff --git a/flang/test/Driver/omp-driver-offload.f90 b/flang/test/Driver/omp-driver-offload.f90 index 7c51656f0001a..a6e3b87a605d5 100644 --- a/flang/test/Driver/omp-driver-offload.f90 +++ b/flang/test/Driver/omp-driver-offload.f90 @@ -130,13 +130,13 @@ ! RUN: %flang -### %s -o %t 2>&1 \ ! RUN: -fopenmp --offload-arch=gfx90a \ ! RUN: -fopenmp-targets=amdgcn-amd-amdhsa \ -! RUN: -fopenmp-target-debug -nogpulib\ -! RUN: | FileCheck %s --check-prefixes=CHECK-TARGET-DEBUG +! RUN: -fopenmp-target-debug=111 -nogpulib\ +! RUN: | FileCheck %s --check-prefixes=CHECK-TARGET-DEBUG-EQ ! RUN: %flang -### %s -o %t 2>&1 \ ! RUN: -fopenmp --offload-arch=sm_70 \ ! RUN: -fopenmp-targets=nvptx64-nvidia-cuda \ -! RUN: -fopenmp-target-debug \ -! RUN: | FileCheck %s --check-prefixes=CHECK-TARGET-DEBUG +! RUN: -fopenmp-target-debug=111 \ +! RUN: | FileCheck %s --check-prefixes=CHECK-TARGET-DEBUG-EQ ! CHECK-TARGET-DEBUG-EQ: "{{[^"]*}}flang" "-fc1" {{.*}} "-fopenmp" {{.*}} "-fopenmp-is-target-device" "-fopenmp-target-debug=111" {{.*}}.f90" ! RUN: %flang -S -### %s -o %t 2>&1 \ diff --git a/flang/test/Evaluate/errors01.f90 b/flang/test/Evaluate/errors01.f90 index 33bda3babf900..283c246393dcd 100644 --- a/flang/test/Evaluate/errors01.f90 +++ b/flang/test/Evaluate/errors01.f90 @@ -145,9 +145,9 @@ subroutine s11 subroutine s12(x,y) class(t), intent(in) :: x class(*), intent(in) :: y - !CHERK: error: Must be a constant value + !CHECK: error: Must be a constant value integer, parameter :: bad1 = storage_size(x) - !CHERK: error: Must be a constant value + !CHECK: error: Must be a constant value integer, parameter :: bad2 = storage_size(y) end subroutine subroutine s13 diff --git a/flang/test/Fir/arrexp.fir b/flang/test/Fir/arrexp.fir index 5da27612ea228..69fc77deb57e3 100644 --- a/flang/test/Fir/arrexp.fir +++ b/flang/test/Fir/arrexp.fir @@ -1,6 +1,6 @@ // RUN: tco %s | FileCheck %s -// CHECK-LINE: define void @f1 +// CHECK-LABEL: define void @f1 // CHECK: (ptr captures(none) %[[A:[^,]*]], {{.*}}, float %[[F:.*]]) func.func @f1(%a : !fir.ref>, %n : index, %m : index, %o : index, %p : index, %f : f32) { %c1 = arith.constant 1 : index @@ -22,7 +22,7 @@ func.func @f1(%a : !fir.ref>, %n : index, %m : index, %o : i return } -// CHECK-LINE: define void @f2 +// CHECK-LABEL: define void @f2 // CHECK: (ptr captures(none) %[[A:[^,]*]], {{.*}}, float %[[F:.*]]) func.func @f2(%a : !fir.ref>, %b : !fir.ref>, %n : index, %m : index, %o : index, %p : index, %f : f32) { %c1 = arith.constant 1 : index @@ -46,7 +46,7 @@ func.func @f2(%a : !fir.ref>, %b : !fir.ref>, %b : !fir.ref>, %n : index, %m : index, %o : index, %p : index, %f : f32) { %c1 = arith.constant 1 : index @@ -71,7 +71,7 @@ func.func @f3(%a : !fir.ref>, %b : !fir.ref>, %b : !fir.ref>, %n : index, %m : index, %o : index, %p : index, %f : f32) { %c1 = arith.constant 1 : index @@ -101,7 +101,7 @@ func.func @f4(%a : !fir.ref>, %b : !fir.ref>, %arg1: !fir.box>, %arg2: f32) { %c0 = arith.constant 0 : index @@ -134,7 +134,7 @@ func.func @f5(%arg0: !fir.box>, %arg1: !fir.box>, %arg1: f32) { %c0 = arith.constant 0 : index diff --git a/flang/test/Fir/pdt.fir b/flang/test/Fir/pdt.fir index 4464b897414a1..ce1fb7a379b8b 100644 --- a/flang/test/Fir/pdt.fir +++ b/flang/test/Fir/pdt.fir @@ -1,6 +1,6 @@ // RUN: tco %s | FileCheck %s -// CHECK-LINE: define i64 @_QTtP.mem.size(i32 %0, i16 %1) +// CHECK-LABEL: define i64 @_QTtP.mem.size(i32 %0, i16 %1) func.func @_QTtP.mem.size(%0 : i32, %1 : i16) -> index { %2 = call @_QTtP.f1.size(%0, %1) : (i32, i16) -> index %3 = call @_QTtP.f2.size(%0, %1) : (i32, i16) -> index @@ -8,25 +8,25 @@ func.func @_QTtP.mem.size(%0 : i32, %1 : i16) -> index { // CHECK: ret i64 8 return %4 : index } -// CHECK-LINE: define i64 @_QTtP.f1.size(i32 %0, i16 %1) +// CHECK-LABEL: define i64 @_QTtP.f1.size(i32 %0, i16 %1) func.func @_QTtP.f1.size(%0 : i32, %1 : i16) -> index { %2 = arith.constant 4 : index // CHECK: ret i64 4 return %2 : index } -// CHECK-LINE: define i64 @_QTtP.f2.size(i32 %0, i16 %1) +// CHECK-LABEL: define i64 @_QTtP.f2.size(i32 %0, i16 %1) func.func @_QTtP.f2.size(%0 : i32, %1 : i16) -> index { %2 = arith.constant 4 : index // CHECK: ret i64 4 return %2 : index } -// CHECK-LINE: define i32 @_QTtP.f1.offset(i32 %0, i16 %1) +// CHECK-LABEL: define i32 @_QTtP.f1.offset(i32 %0, i16 %1) func.func @_QTtP.f1.offset(%0 : i32, %1 : i16) -> i32 { %2 = arith.constant 0 : i32 // CHECK: ret i32 0 return %2 : i32 } -// CHECK-LINE: define i32 @_QTtP.f2.offset(i32 %0, i16 %1) +// CHECK-LABEL: define i32 @_QTtP.f2.offset(i32 %0, i16 %1) func.func @_QTtP.f2.offset(%0 : i32, %1 : i16) -> i32 { %2 = arith.constant 4 : i32 // CHECK: ret i32 4 @@ -44,7 +44,7 @@ func.func @_QTtP.f2.offset(%0 : i32, %1 : i16) -> i32 { // var%f1 = 4 // end program p -// CHECK-LINE: define void @_QQmain(i32 %0, i16 %1) +// CHECK-LABEL: define void @_QQmain(i32 %0, i16 %1) func.func @_QQmain(%arg0 : i32, %arg1 : i16) { // CHECK: %[[size:.*]] = call i64 @_QTtP.mem.size(i32 %0, i16 %1) // CHECK: %[[alloc:.*]] = alloca i8, i64 %[[size]] @@ -56,7 +56,7 @@ func.func @_QQmain(%arg0 : i32, %arg1 : i16) { return } -// CHECK-LINE: define i64 @_QTt1P.mem.size(i32 %0, i32 %1) +// CHECK-LABEL: define i64 @_QTt1P.mem.size(i32 %0, i32 %1) func.func @_QTt1P.mem.size(%0 : i32, %1 : i32) -> index { // CHECK: call i64 @_QTt1P.f1.size %2 = call @_QTt1P.f1.size(%0, %1) : (i32, i32) -> index @@ -65,22 +65,22 @@ func.func @_QTt1P.mem.size(%0 : i32, %1 : i32) -> index { %4 = arith.addi %2, %3 : index return %4 : index } -// CHECK-LINE: define i64 @_QTt1P.f1.size(i32 %0, i32 %1) +// CHECK-LABEL: define i64 @_QTt1P.f1.size(i32 %0, i32 %1) func.func @_QTt1P.f1.size(%0 : i32, %1 : i32) -> index { %2 = fir.convert %0 : (i32) -> index return %2 : index } -// CHECK-LINE: define i64 @_QTt1P.f2.size(i32 %0, i32 %1) +// CHECK-LABEL: define i64 @_QTt1P.f2.size(i32 %0, i32 %1) func.func @_QTt1P.f2.size(%0 : i32, %1 : i32) -> index { %2 = fir.convert %1 : (i32) -> index return %2 : index } -// CHECK-LINE: define i32 @_QTt1P.f1.offset(i32 %0, i32 %1) +// CHECK-LABEL: define i32 @_QTt1P.f1.offset(i32 %0, i32 %1) func.func @_QTt1P.f1.offset(%0 : i32, %1 : i32) -> i32 { %2 = arith.constant 0 : i32 return %2 : i32 } -// CHECK-LINE: define i32 @_QTt1P.f2.offset(i32 %0, i32 %1) +// CHECK-LABEL: define i32 @_QTt1P.f2.offset(i32 %0, i32 %1) func.func @_QTt1P.f2.offset(%0 : i32, %1 : i32) -> i32 { return %0 : i32 } @@ -97,7 +97,7 @@ func.func @_QTt1P.f2.offset(%0 : i32, %1 : i32) -> i32 { func.func private @bar(!fir.ref>) -// CHECK-LINE: define i8* @_QPfoo(i32 %0, i32 %1) +// CHECK-LABEL: define void @_QPfoo(i32 %0, i32 %1) func.func @_QPfoo(%arg0 : i32, %arg1 : i32) { // CHECK: %[[size:.*]] = call i64 @_QTt1P.mem.size(i32 %0, i32 %1) // CHECK: %[[alloc:.*]] = alloca i8, i64 %[[size]] diff --git a/flang/test/Fir/simplify-region-lite-after-inliner.fir b/flang/test/Fir/simplify-region-lite-after-inliner.fir index c09612b5dabed..1a41c8d38ce19 100644 --- a/flang/test/Fir/simplify-region-lite-after-inliner.fir +++ b/flang/test/Fir/simplify-region-lite-after-inliner.fir @@ -33,4 +33,4 @@ func.func private @foo() -> none // CHECK: define void @repro(i8 %0, i8 %1) -// CHECK-NEXT ret void +// CHECK-NEXT: ret void diff --git a/flang/test/Fir/target.fir b/flang/test/Fir/target.fir index 5d825f6965fd8..62ce488a3ca2f 100644 --- a/flang/test/Fir/target.fir +++ b/flang/test/Fir/target.fir @@ -39,9 +39,9 @@ func.func @gen8() -> complex { %c1 = arith.constant 1 : i32 %5 = fir.insert_value %4, %2, [1 : index] : (complex, f64) -> complex // I32: store { double, double } { double -4.000000e+00, double 1.000000e+00 } - // I64: store { double, double } { double -4.000000e+00, double 1.000000e+00 } - // I64: %[[load:.*]] = load { double, double } - // I64: ret { double, double } %[[load]] + // X64: store { double, double } { double -4.000000e+00, double 1.000000e+00 } + // X64: %[[load:.*]] = load { double, double } + // X64: ret { double, double } %[[load]] // AARCH64: ret { double, double } // PPC: ret { double, double } return %5 : complex diff --git a/flang/test/Lower/CUDA/cuda-allocatable.cuf b/flang/test/Lower/CUDA/cuda-allocatable.cuf index ed78bec1b8f08..4aa86165252a7 100644 --- a/flang/test/Lower/CUDA/cuda-allocatable.cuf +++ b/flang/test/Lower/CUDA/cuda-allocatable.cuf @@ -81,7 +81,7 @@ end subroutine ! CHECK: %[[BOX_DECL:.*]]:2 = hlfir.declare %[[BOX]] {data_attr = #cuf.cuda, fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub3Ea"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) ! CHECK: %[[PLOG:.*]] = fir.alloca !fir.logical<4> {bindc_name = "plog", uniq_name = "_QFsub3Eplog"} ! CHECK: %[[PLOG_DECL:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFsub3Eplog"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) -! CHECK-2: fir.call @_FortranAAllocatableSetBounds +! CHECK-COUNT-2: fir.call @_FortranAAllocatableSetBounds ! CHECK: %{{.*}} = cuf.allocate %[[BOX_DECL]]#1 : !fir.ref>>> pinned(%[[PLOG_DECL]]#1 : !fir.ref>) {data_attr = #cuf.cuda} -> i32 ! CHECK: fir.if %{{.*}} { ! CHECK: %{{.*}} = cuf.deallocate %[[BOX_DECL]]#1 : !fir.ref>>> {data_attr = #cuf.cuda} -> i32 diff --git a/flang/test/Lower/HLFIR/calls-f77.f90 b/flang/test/Lower/HLFIR/calls-f77.f90 index fad32d5fd0278..b312d16c091ba 100644 --- a/flang/test/Lower/HLFIR/calls-f77.f90 +++ b/flang/test/Lower/HLFIR/calls-f77.f90 @@ -191,11 +191,11 @@ subroutine alternate_return_call(n1, n2, k) ! Test calls to user procedures with intrinsic interfaces ! ----------------------------------------------------------------------------- -! CHECK-NAME: func.func @_QPintrinsic_iface() +! CHECK-LABEL: func.func @_QPintrinsic_iface() subroutine intrinsic_iface() intrinsic acos real :: x procedure(acos) :: proc x = proc(1.0) end subroutine -! CHECK" fir.call @_QPproc(%{{.*}}) {{.*}}: (!fir.ref) -> f32 +! CHECK: fir.call @_QPproc(%{{.*}}) {{.*}}: (!fir.ref) -> f32 diff --git a/flang/test/Lower/HLFIR/maxloc.f90 b/flang/test/Lower/HLFIR/maxloc.f90 index 539affad2d7df..1d13f2fc6305b 100644 --- a/flang/test/Lower/HLFIR/maxloc.f90 +++ b/flang/test/Lower/HLFIR/maxloc.f90 @@ -86,7 +86,7 @@ subroutine maxloc5(s) ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> ! CHECK-NEXT: return -! CHECK-nEXT: } +! CHECK-NEXT: } ! back argument as .true. subroutine maxloc_back(a, s) diff --git a/flang/test/Lower/HLFIR/maxval.f90 b/flang/test/Lower/HLFIR/maxval.f90 index 32e1a80417a27..adc9ea8191beb 100644 --- a/flang/test/Lower/HLFIR/maxval.f90 +++ b/flang/test/Lower/HLFIR/maxval.f90 @@ -83,7 +83,7 @@ subroutine maxval5(s) ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> ! CHECK-NEXT: return -! CHECK-nEXT: } +! CHECK-NEXT: } subroutine maxval6(a, s, d) integer, pointer :: d diff --git a/flang/test/Lower/HLFIR/minloc.f90 b/flang/test/Lower/HLFIR/minloc.f90 index ce149ffcfb54f..3d33a9328238b 100644 --- a/flang/test/Lower/HLFIR/minloc.f90 +++ b/flang/test/Lower/HLFIR/minloc.f90 @@ -86,7 +86,7 @@ subroutine minloc5(s) ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> ! CHECK-NEXT: return -! CHECK-nEXT: } +! CHECK-NEXT: } ! back argument as .true. subroutine minloc_back(a, s) diff --git a/flang/test/Lower/HLFIR/minval.f90 b/flang/test/Lower/HLFIR/minval.f90 index 2ac9aba850b6f..d7e603ece0610 100644 --- a/flang/test/Lower/HLFIR/minval.f90 +++ b/flang/test/Lower/HLFIR/minval.f90 @@ -83,7 +83,7 @@ subroutine minval5(s) ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> ! CHECK-NEXT: return -! CHECK-nEXT: } +! CHECK-NEXT: } subroutine minval6(a, s, d) integer, pointer :: d diff --git a/flang/test/Lower/HLFIR/sum.f90 b/flang/test/Lower/HLFIR/sum.f90 index 339582088b032..aed567f73b6b1 100644 --- a/flang/test/Lower/HLFIR/sum.f90 +++ b/flang/test/Lower/HLFIR/sum.f90 @@ -83,7 +83,7 @@ subroutine sum5(s) ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[OUT]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] : !hlfir.expr<2xi32> ! CHECK-NEXT: return -! CHECK-nEXT: } +! CHECK-NEXT: } subroutine sum6(a, s, d) integer, pointer :: d diff --git a/flang/test/Lower/Intrinsics/adjustl.f90 b/flang/test/Lower/Intrinsics/adjustl.f90 index 56c93996015f4..a742f58db5c48 100644 --- a/flang/test/Lower/Intrinsics/adjustl.f90 +++ b/flang/test/Lower/Intrinsics/adjustl.f90 @@ -1,6 +1,6 @@ ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s -! CHECK-LABLE: adjustl_test +! CHECK-LABEL: adjustl_test subroutine adjustl_test character(len=12) :: adjust_str = ' 0123456789' ! CHECK: %[[strBox:.*]] = fir.alloca !fir.box>> diff --git a/flang/test/Lower/Intrinsics/adjustr.f90 b/flang/test/Lower/Intrinsics/adjustr.f90 index 17c2a1647bb8d..a929ab17ab9ff 100644 --- a/flang/test/Lower/Intrinsics/adjustr.f90 +++ b/flang/test/Lower/Intrinsics/adjustr.f90 @@ -1,6 +1,6 @@ ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s -! CHECK-LABLE: adjustr_test +! CHECK-LABEL: adjustr_test subroutine adjustr_test character(len=12) :: adjust_str = '0123456789 ' ! CHECK: %[[strBox:.*]] = fir.alloca !fir.box>> diff --git a/flang/test/Lower/Intrinsics/any.f90 b/flang/test/Lower/Intrinsics/any.f90 index e4dc20e3de2f3..2c0b92fcc1d74 100644 --- a/flang/test/Lower/Intrinsics/any.f90 +++ b/flang/test/Lower/Intrinsics/any.f90 @@ -27,5 +27,5 @@ subroutine any_test2(mask, d, rslt) ! CHECK: fir.call @_FortranAAnyDim(%[[a6:.*]], %[[a7:.*]], %[[a1:.*]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> () ! CHECK-DAG: %[[a10:.*]] = fir.load %[[a0:.*]] : !fir.ref>>>> ! CHECK-DAG: %[[a12:.*]] = fir.box_addr %[[a10:.*]] : (!fir.box>>>) -> !fir.heap>> -! CHECK-DAG fir.freemem %[[a12:.*]] +! CHECK-DAG: fir.freemem %[[a12:.*]] end subroutine diff --git a/flang/test/Lower/Intrinsics/parity.f90 b/flang/test/Lower/Intrinsics/parity.f90 index 91b168ee5662d..d8ff01b7be975 100644 --- a/flang/test/Lower/Intrinsics/parity.f90 +++ b/flang/test/Lower/Intrinsics/parity.f90 @@ -28,5 +28,5 @@ subroutine parity_test2(mask, d, rslt) ! CHECK: fir.call @_FortranAParityDim(%[[a6:.*]], %[[a7:.*]], %[[a1:.*]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> () ! CHECK-DAG: %[[a10:.*]] = fir.load %[[a0:.*]] : !fir.ref>>>> ! CHECK-DAG: %[[a12:.*]] = fir.box_addr %[[a10:.*]] : (!fir.box>>>) -> !fir.heap>> - ! CHECK-DAG fir.freemem %[[a12:.*]] + ! CHECK-DAG: fir.freemem %[[a12:.*]] end subroutine parity_test2 diff --git a/flang/test/Lower/Intrinsics/storage_size-2.f90 b/flang/test/Lower/Intrinsics/storage_size-2.f90 index d6fb68df70ea9..208070e04e6e6 100644 --- a/flang/test/Lower/Intrinsics/storage_size-2.f90 +++ b/flang/test/Lower/Intrinsics/storage_size-2.f90 @@ -1,7 +1,7 @@ ! Test storage_size with characters ! RUN: bbc -emit-hlfir %s -o - | FileCheck %s -! check-label: func.func @_QPtest_storage_size +! CHECK-LABEL: func.func @_QPtest_storage_size subroutine test_storage_size(n) interface function return_char(l) diff --git a/flang/test/Lower/OpenACC/acc-set.f90 b/flang/test/Lower/OpenACC/acc-set.f90 index 31c1912a87f57..b249a53533e6e 100644 --- a/flang/test/Lower/OpenACC/acc-set.f90 +++ b/flang/test/Lower/OpenACC/acc-set.f90 @@ -25,7 +25,6 @@ program test_acc_set ! CHECK: acc.set default_async(%[[C1]] : i32) ! CHECK: %[[C1:.*]] = arith.constant 1 : i32 -! FIR: %[[LOAD_L:.*]] = fir.load %[[L]] : !fir.ref> ! HLFIR: %[[LOAD_L:.*]] = fir.load %[[DECLL]]#0 : !fir.ref> ! CHECK: %[[CONV_L:.*]] = fir.convert %[[LOAD_L]] : (!fir.logical<4>) -> i1 ! CHECK: acc.set default_async(%[[C1]] : i32) if(%[[CONV_L]]) diff --git a/flang/test/Lower/OpenMP/unstructured.f90 b/flang/test/Lower/OpenMP/unstructured.f90 index a0955c8440c1c..bb29968dcb640 100644 --- a/flang/test/Lower/OpenMP/unstructured.f90 +++ b/flang/test/Lower/OpenMP/unstructured.f90 @@ -337,7 +337,7 @@ subroutine ss8() ! EXIT inside OpenMP parallel do ! CHECK: omp.terminator ! CHECK-NEXT: } ! CHECK: omp.terminator -! CHECK-NEXT } +! CHECK-NEXT: } ! CHECK: } subroutine ss9() ! EXIT inside OpenMP parallel (inside parallel) integer :: x diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 index ea5df5a836972..7a946118a524d 100644 --- a/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 +++ b/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 @@ -34,7 +34,7 @@ program reduce ! CHECK: fir.store %[[VAL_7]] to %[[ALLOC]] : !fir.ref>> ! CHECK: omp.yield(%[[ALLOC]] : !fir.ref>>) -! CHECK-LABEL } combiner { +! CHECK-LABEL: } combiner { ! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref>>, %[[VAL_1:.*]]: !fir.ref>>): ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref>> ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref>> @@ -65,7 +65,7 @@ program reduce ! CHECK: omp.yield ! CHECK: } -! CHECK-LABEL func.func @_QQmain() attributes {fir.bindc_name = "reduce"} { +! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "reduce"} { ! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFEi) : !fir.ref ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) ! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFEr) : !fir.ref> diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90 index ec65a3c4071ec..710175739b3a8 100644 --- a/flang/test/Lower/array.f90 +++ b/flang/test/Lower/array.f90 @@ -96,7 +96,7 @@ subroutine s(i,j,k,ii,jj,kk,a1,a2,a3,a4,a5,a6,a7) end subroutine s -! CHECK-LABEL range +! CHECK-LABEL: range subroutine range() ! Compile-time initalized arrays integer, dimension(10) :: a0 @@ -114,6 +114,29 @@ subroutine range() data c1/6 * (0.0, 0.0)/ end subroutine range +! CHECK-LABEL: rangeglobal +subroutine rangeGlobal() + integer, dimension(6) :: a0 = (/ 1, 1, 2, 2, 3, 3 /) + +end subroutine rangeGlobal + +! CHECK-LABEL: hugeglobal +subroutine hugeGlobal() + integer, parameter :: D = 500 + integer, dimension(D, D) :: a + + a = reshape((/(i, i = 1, D * D)/), shape(a)) +end subroutine hugeGlobal + +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 + ! c1 data ! CHECK: fir.global internal @_QFrangeEc1(dense<(0.000000e+00,0.000000e+00)> : tensor<3x2xcomplex>) : !fir.array<2x3xcomplex> @@ -132,27 +155,6 @@ end subroutine range ! c0 array constructor ! CHECK: fir.global internal @_QQro.2x3xz4.{{.*}}(dense<{{\[}}[(1.000000e+00,1.500000e+00), (2.000000e+00,2.500000e+00)], [(3.000000e+00,3.500000e+00), (4.000000e+00,4.500000e+00)], [(5.000000e+00,5.500000e+00), (6.000000e+00,6.500000e+00)]]> : tensor<3x2xcomplex>) constant : !fir.array<2x3xcomplex> -! 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 - -! CHECK-LABEL hugeGlobal -subroutine hugeGlobal() - integer, parameter :: D = 500 - integer, dimension(D, D) :: a ! CHECK: fir.global internal @_QQro.500x500xi4.{{.*}}(dense<{{.*}}> : tensor<500x500xi32>) constant : !fir.array<500x500xi32> - a = reshape((/(i, i = 1, D * D)/), shape(a)) -end subroutine hugeGlobal - -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/components.f90 b/flang/test/Lower/components.f90 index 28e836c5d1045..f9297fcfed4ff 100644 --- a/flang/test/Lower/components.f90 +++ b/flang/test/Lower/components.f90 @@ -115,7 +115,7 @@ subroutine issue772(a, x) ! CHECK: fir.call @_QPibar() ! CHECK-NOT: fir.call @_QPibar() print *, a(20)%b(1:ibar():1) - ! CHECK return + ! CHECK: return end subroutine ! ----------------------------------------------------------------------------- diff --git a/flang/test/Lower/control-flow.f90 b/flang/test/Lower/control-flow.f90 index d605aaf0a9d94..ef66c9e22c8d1 100644 --- a/flang/test/Lower/control-flow.f90 +++ b/flang/test/Lower/control-flow.f90 @@ -3,7 +3,7 @@ ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s ! check the lowering of a RETURN in the body of a SUBROUTINE -! CHECK-LABEL one +! CHECK-LABEL: one subroutine one(a,b,c) d = 1.0 if (a .ne. b) then diff --git a/flang/test/Lower/derived-assignments.f90 b/flang/test/Lower/derived-assignments.f90 index 1048e6199451a..90c360978fd2a 100644 --- a/flang/test/Lower/derived-assignments.f90 +++ b/flang/test/Lower/derived-assignments.f90 @@ -220,17 +220,17 @@ subroutine test_alloc_comp(t1, t2) ! end type !contains -! ! cHECK-LABEL: func @_QMcomponent_with_user_def_assignPtest( -! ! cHECK-SAME: %[[t1:.*]]: !fir.ref,i:i32}>>{{.*}}, %[[t2:.*]]: !fir.ref,i:i32}>>{{.*}}) { +! COM: CHECK-LABEL: func @_QMcomponent_with_user_def_assignPtest( +! COM: CHECK-SAME: %[[t1:.*]]: !fir.ref,i:i32}>>{{.*}}, %[[t2:.*]]: !fir.ref,i:i32}>>{{.*}}) { ! subroutine test(t1, t2) ! type(t) :: t1, t2 -! ! cHECK: %[[tmpBox:.*]] = fir.alloca !fir.box> -! ! cHECK: %[[t1Box:.*]] = fir.embox %[[t1]] : (!fir.ref>) -> !fir.box> -! ! cHECK: %[[t2Box:.*]] = fir.embox %[[t2]] : (!fir.ref>) -> !fir.box> -! ! cHECK: fir.store %[[t1Box]] to %[[tmpBox]] : !fir.ref>> -! ! cHECK: %[[lhs:.*]] = fir.convert %[[tmpBox]] : (!fir.ref>>) -> !fir.ref> -! ! cHECK: %[[rhs:.*]] = fir.convert %[[t2Box]] : (!fir.box>) -> !fir.box -! ! cHECK: fir.call @_FortranAAssign(%[[lhs]], %[[rhs]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, !fir.box, !fir.ref, i32) -> () +! COM: CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box> +! COM: CHECK: %[[t1Box:.*]] = fir.embox %[[t1]] : (!fir.ref>) -> !fir.box> +! COM: CHECK: %[[t2Box:.*]] = fir.embox %[[t2]] : (!fir.ref>) -> !fir.box> +! COM: CHECK: fir.store %[[t1Box]] to %[[tmpBox]] : !fir.ref>> +! COM: CHECK: %[[lhs:.*]] = fir.convert %[[tmpBox]] : (!fir.ref>>) -> !fir.ref> +! COM: CHECK: %[[rhs:.*]] = fir.convert %[[t2Box]] : (!fir.box>) -> !fir.box +! COM: CHECK: fir.call @_FortranAAssign(%[[lhs]], %[[rhs]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, !fir.box, !fir.ref, i32) -> () ! t1 = t2 ! end subroutine !end module diff --git a/flang/test/Lower/equivalence-static-init.f90 b/flang/test/Lower/equivalence-static-init.f90 index 4c52a4a7d8448..1a0f53a4d893d 100644 --- a/flang/test/Lower/equivalence-static-init.f90 +++ b/flang/test/Lower/equivalence-static-init.f90 @@ -10,7 +10,7 @@ module module_without_init ! CHECK-LABEL: fir.global @_QMmodule_without_initEi : !fir.array<8xi8> { ! CHECK: %0 = fir.zero_bits !fir.array<8xi8> ! CHECK: fir.has_value %0 : !fir.array<8xi8> -! CHECK} +! CHECK: } subroutine test_eqv_init diff --git a/flang/test/Lower/forall/array-subscripts.f90 b/flang/test/Lower/forall/array-subscripts.f90 index a0ae0500b5fdc..60bac87c7ae54 100644 --- a/flang/test/Lower/forall/array-subscripts.f90 +++ b/flang/test/Lower/forall/array-subscripts.f90 @@ -18,4 +18,4 @@ ! CHECK: = fir.array_fetch %[[a2]], %{{.*}}, %{{.*}} : (!fir.array<4x4xi32>, index, index) -> i32 ! CHECK: = fir.array_fetch %[[a3]], %{{.*}}, %{{.*}} : (!fir.array<4x4xi32>, index, index) -> i32 ! CHECK: = fir.array_update %{{.*}}, %{{.*}}, %{{.*}} : (!fir.array<4x4xi32>, i32, index, index) -> !fir.array<4x4xi32> -! CHECK : fir.array_merge_store %[[a1]], %[[av]] to %[[a]] : !fir.array<4x4xi32>, !fir.array<4x4xi32>, !fir.ref> +! CHECK: fir.array_merge_store %[[a1]], %[[av]] to %[[a]] : !fir.array<4x4xi32>, !fir.array<4x4xi32>, !fir.ref> diff --git a/flang/test/Lower/module_use.f90 b/flang/test/Lower/module_use.f90 index f7c610c9ad22e..92acbfbee0b9e 100644 --- a/flang/test/Lower/module_use.f90 +++ b/flang/test/Lower/module_use.f90 @@ -19,15 +19,15 @@ real function m1use() end function ! TODO: test equivalences once front-end fix in module file is pushed. -!! CHECK-LABEL func @_QPmodeq1use() +! COM: CHECK-LABEL: func @_QPmodeq1use() !real function modEq1use() ! use modEq1 -! ! CHECK-DAG fir.address_of(@_QMmodeq1Ex1) : !fir.ref, !fir.array<40xi8>>> -! ! CHECK-DAG fir.address_of(@_QMmodeq1Ey1) : !fir.ref, !fir.array<24xi8>>> +! COM: CHECK-DAG: fir.address_of(@_QMmodeq1Ex1) : !fir.ref, !fir.array<40xi8>>> +! COM: CHECK-DAG: fir.address_of(@_QMmodeq1Ey1) : !fir.ref, !fir.array<24xi8>>> ! modEq1use = x2(1) + y1 !end function -! CHECK-DAG fir.global @_QMmodeq1Ex1 : tuple, !fir.array<40xi8>> -! CHECK-DAG fir.global @_QMmodeq1Ey1 : tuple, !fir.array<24xi8>> +! COM: CHECK-DAG: fir.global @_QMmodeq1Ex1 : tuple, !fir.array<40xi8>> +! COM: CHECK-DAG: fir.global @_QMmodeq1Ey1 : tuple, !fir.array<24xi8>> ! CHECK-LABEL: func @_QPmodcommon1use() real function modCommon1Use() diff --git a/flang/test/Lower/pause-statement.f90 b/flang/test/Lower/pause-statement.f90 index e4cba98dc8a79..f4c8f6fbc4385 100644 --- a/flang/test/Lower/pause-statement.f90 +++ b/flang/test/Lower/pause-statement.f90 @@ -1,6 +1,6 @@ ! RUN: bbc %s -emit-fir --canonicalize -o - | FileCheck %s -! CHECK-LABEL pause_test +! CHECK-LABEL: pause_test subroutine pause_test() ! CHECK: fir.call @_Fortran{{.*}}PauseStatement() ! CHECK-NEXT: return diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 index 73603d7ee7bee..a1872e225359f 100644 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -151,7 +151,7 @@ subroutine call_fct() ! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_fct_ret_class() -> !fir.class>> ! CHECK: return %{{.*}} : !fir.class>> -! CHECK-lABEL: func.func @_QMpolymorphic_testPcall_fct() +! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_fct() ! CHECK: %[[RESULT:.*]] = fir.alloca !fir.class>> {bindc_name = ".result"} ! CHECK: %[[CALL_RES:.*]] = fir.call @_QMpolymorphic_testPtest_fct_ret_class() {{.*}}: () -> !fir.class>> ! CHECK: fir.save_result %[[CALL_RES]] to %[[RESULT]] : !fir.class>>, !fir.ref>>> diff --git a/flang/test/Parser/OpenMP/in-reduction-clause.f90 b/flang/test/Parser/OpenMP/in-reduction-clause.f90 index 8a0bede62f03f..bb3fadbc5088e 100644 --- a/flang/test/Parser/OpenMP/in-reduction-clause.f90 +++ b/flang/test/Parser/OpenMP/in-reduction-clause.f90 @@ -75,5 +75,5 @@ end subroutine omp_in_reduction_parallel !PARSE-TREE-NEXT: OmpLoopDirective -> llvm::omp::Directive = taskloop simd !PARSE-TREE-NEXT: OmpClauseList -> OmpClause -> InReduction -> OmpInReductionClause !PARSE-TREE-NEXT: OmpReductionIdentifier -> DefinedOperator -> IntrinsicOperator = Add -!PASRE-TREE-NEXT: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'z' +!PARSE-TREE-NEXT: OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'z' diff --git a/flang/test/Transforms/loop-versioning.fir b/flang/test/Transforms/loop-versioning.fir index 2f7c439ed3f4e..cf601fc49b998 100644 --- a/flang/test/Transforms/loop-versioning.fir +++ b/flang/test/Transforms/loop-versioning.fir @@ -63,14 +63,14 @@ module attributes {dlti.dl_spec = #dlti.dl_spec<#dlti.dl_entry : // CHECK: %{{.*}} = fir.load %[[COORD]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 +// CHECK: fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 // CHECK: } else { // CHECK: %[[LOOP_RES2:.*]]:2 = fir.do_loop {{.*}} // CHECK: %[[COORD2:.*]] = fir.coordinate_of %[[REBOX]], %{{.*}} : (!fir.box>, i64) -> !fir.ref // CHECK: %{{.*}}= fir.load %[[COORD2]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 +// CHECK: fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 // CHECK: } // CHECK: fir.store %[[IF_RES]]#1 to %{{.*}} // CHECK: return @@ -378,14 +378,14 @@ func.func @sum1dfixed(%arg0: !fir.ref> {fir.bindc_name = "a"}, // CHECK: %{{.*}} = fir.load %[[COORD]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 +// CHECK: fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 // CHECK: } else { // CHECK: %[[LOOP_RES2:.*]]:2 = fir.do_loop {{.*}} // CHECK: %[[COORD2:.*]] = fir.coordinate_of %[[ARG0]], %{{.*}} : (!fir.box>, i64, i64) -> !fir.ref // CHECK: %{{.*}}= fir.load %[[COORD2]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 +// CHECK: fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 // CHECK: } // CHECK: fir.store %[[IF_RES]]#1 to %{{.*}} // CHECK: return @@ -510,14 +510,14 @@ func.func @sum1dfixed(%arg0: !fir.ref> {fir.bindc_name = "a"}, // CHECK: %{{.*}} = fir.load %[[COORD]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 +// CHECK: fir.result %[[LOOP_RES]]#0, %[[LOOP_RES]]#1 // CHECK: } else { // CHECK: %[[LOOP_RES2:.*]]:2 = fir.do_loop {{.*}} // CHECK: %[[COORD2:.*]] = fir.coordinate_of %[[ARG0]], %{{.*}} : (!fir.box>, i64, i64, i64) -> !fir.ref // CHECK: %{{.*}}= fir.load %[[COORD2]] : !fir.ref // CHECK: fir.result %{{.*}}, %{{.*}} // CHECK: } -// CHECK fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 +// CHECK: fir.result %[[LOOP_RES2]]#0, %[[LOOP_RES2]]#1 // CHECK: } // CHECK: fir.store %[[IF_RES]]#1 to %{{.*}} // CHECK: return diff --git a/flang/test/Transforms/simplifyintrinsics.fir b/flang/test/Transforms/simplifyintrinsics.fir index b2af152e5a913..9a95748c17258 100644 --- a/flang/test/Transforms/simplifyintrinsics.fir +++ b/flang/test/Transforms/simplifyintrinsics.fir @@ -428,7 +428,7 @@ module attributes {fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.targ } // Just check that SOMETHING is being output. -// CHECK-LABEL @sum_dim() { +// CHECK-LABEL: @sum_dim() { // CHECK: return @@ -459,7 +459,7 @@ module attributes {fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.targ } // Just check that SOMETHING is being output. -// CHECK-LABEL @sum_1d_unknown() { +// CHECK-LABEL: @sum_1d_unknown( // CHECK: return // ----- @@ -1260,9 +1260,9 @@ func.func private @_FortranACountDim(!fir.ref>, !fir.box, i // CHECK-LABEL: func.func @_QMtestPcount_generate_mask( // CHECK-SAME: %[[A:.*]]: !fir.ref>> {fir.bindc_name = "mask"}) -> !fir.array<10xi32> { -// CHECK-NOT fir.call @_FortranACountDimLogical4_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranACountDimLogical4_simplified({{.*}}) // CHECK: fir.call @_FortranACountDim({{.*}}) fastmath : (!fir.ref>, !fir.box, i32, i32, !fir.ref, i32) -> () -// CHECK-NOT fir.call @_FortranACountDimLogical4_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranACountDimLogical4_simplified({{.*}}) // ----- // Ensure count isn't simplified for unknown dimension arrays @@ -1285,9 +1285,9 @@ func.func private @_FortranACount(!fir.box, !fir.ref, i32, i32) -> i64 // CHECK-LABEL: func.func @_QPmc( // CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "m"}) -> i32 { -// CHECK-NOT fir.call @_FortranACountLogical4_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranACountLogical4_simplified({{.*}}) // CHECK: %[[RES:.*]] = fir.call @_FortranACount({{.*}}) fastmath : (!fir.box, !fir.ref, i32, i32) -> i64 -// CHECK-NOT fir.call @_FortranACountLogical4_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranACountLogical4_simplified({{.*}}) // ----- // Ensure Any is simplified in correct usage @@ -1443,9 +1443,9 @@ func.func private @_FortranAAnyDim(!fir.ref>, !fir.box, i32 // CHECK-LABEL: func.func @_QPtestAny_DimArg( // CHECK-SAME: %[[ARR:.*]]: !fir.ref>> {fir.bindc_name = "a"}) -> !fir.array<10x!fir.logical<4>> { -// CHECK-NOT fir.call @_FortranAAnyDimLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAnyDimLogical4x1_simplified({{.*}}) // CHECK: fir.call @_FortranAAnyDim({{.*}}) fastmath : (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> () -// CHECK-NOT fir.call @_FortranAAnyDimLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAnyDimLogical4x1_simplified({{.*}}) // ----- // Ensure Any is not simplified for unknown dimension arrays @@ -1468,9 +1468,9 @@ func.func private @_FortranAAny(!fir.box, !fir.ref, i32, i32) -> i1 at // CHECK-LABEL: func.func @_QPtestAny_UnknownDim( // CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "a"}) -> !fir.logical<4> { -// CHECK-NOT fir.call @_FortranAAnyLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAnyLogical4x1_simplified({{.*}}) // CHECK: fir.call @_FortranAAny({{.*}}) fastmath : (!fir.box, !fir.ref, i32, i32) -> i1 -// CHECK-NOT fir.call @_FortranAAnyLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAnyLogical4x1_simplified({{.*}}) // ----- // Check that multi-rank Any cases are properly simplified @@ -1682,9 +1682,9 @@ func.func private @_FortranAAllDim(!fir.ref>, !fir.box, i32 // CHECK-LABEL: func.func @_QPtestAll_DimArg( // CHECK-SAME: %[[ARR:.*]]: !fir.ref>> {fir.bindc_name = "a"}) -> !fir.array<10x!fir.logical<4>> { -// CHECK-NOT fir.call @_FortranAAllDimLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAllDimLogical4x1_simplified({{.*}}) // CHECK: fir.call @_FortranAAllDim({{.*}}) fastmath : (!fir.ref>, !fir.box, i32, !fir.ref, i32) -> () -// CHECK-NOT fir.call @_FortranAAllDimLogical4x1_simplified({{.*}}) +// CHECK-NOT: fir.call @_FortranAAllDimLogical4x1_simplified({{.*}}) // ----- // Check Minloc simplifies correctly for 1D case with 1D mask, I32 input