[flang-commits] [flang] [flang] fix ignore_tkr(tk) with character dummy (PR #108168)
via flang-commits
flang-commits at lists.llvm.org
Wed Sep 11 01:33:02 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/108168
The test code with ignore_tkr(tk) on character dummy passed by fir.boxchar<> was crashing the compiler in [an assert](https://github.com/llvm/llvm-project/blob/2afe678f0a246387977a8ca694d4489e2c868991/flang/lib/Optimizer/Dialect/FIRType.cpp#L632) in `changeElementType`.
It makes little sense to call changeElementType on a fir.boxchar since this type is lossy (the shape is not part of it). Just skip it in the code dealing with ignore(tk) when hitting this case
>From 0bbe2f5286c86cda91b06501941f502d1f5c1697 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 11 Sep 2024 01:08:03 -0700
Subject: [PATCH] [flang] fix ignore_tkr(tk) with character dummy
---
flang/lib/Lower/ConvertCall.cpp | 24 ++++++++++---
flang/lib/Optimizer/Builder/FIRBuilder.cpp | 4 ++-
.../Lower/HLFIR/ignore-type-f77-character.f90 | 35 +++++++++++++++++++
flang/test/Lower/call-suspect.f90 | 13 ++-----
flang/test/Lower/implicit-call-mismatch.f90 | 3 +-
5 files changed, 62 insertions(+), 17 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/ignore-type-f77-character.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index f445a21e560bc9..3dc8d4842e15b6 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1206,10 +1206,26 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
// is set (descriptors must be created with the actual type in this case, and
// copy-in/copy-out should be driven by the contiguity with regard to the
// actual type).
- if (ignoreTKRtype)
- dummyTypeWithActualRank = fir::changeElementType(
- dummyTypeWithActualRank, actual.getFortranElementType(),
- actual.isPolymorphic());
+ if (ignoreTKRtype) {
+ if (auto boxCharType =
+ mlir::dyn_cast<fir::BoxCharType>(dummyTypeWithActualRank)) {
+ auto maybeActualCharType =
+ mlir::dyn_cast<fir::CharacterType>(actual.getFortranElementType());
+ if (!maybeActualCharType ||
+ maybeActualCharType.getFKind() != boxCharType.getKind()) {
+ // When passing to a fir.boxchar with ignore(tk), prepare the argument
+ // as if only the raw address must be passed.
+ dummyTypeWithActualRank =
+ fir::ReferenceType::get(actual.getElementOrSequenceType());
+ }
+ // Otherwise, the actual is already a character with the same kind as the
+ // dummy and can be passed normally.
+ } else {
+ dummyTypeWithActualRank = fir::changeElementType(
+ dummyTypeWithActualRank, actual.getFortranElementType(),
+ actual.isPolymorphic());
+ }
+ }
PreparedDummyArgument preparedDummy;
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index c5a135a189e8dc..94b945e9669f8b 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -432,7 +432,9 @@ mlir::Value fir::FirOpBuilder::convertWithSemantics(
// argument in characters and use it as the length of the string
auto refType = getRefType(boxType.getEleTy());
mlir::Value charBase = createConvert(loc, refType, val);
- mlir::Value unknownLen = create<fir::UndefOp>(loc, getIndexType());
+ // Do not use fir.undef since llvm optimizer is too harsh when it
+ // sees such values (may just delete code).
+ mlir::Value unknownLen = createIntegerConstant(loc, getIndexType(), 0);
fir::factory::CharacterExprHelper charHelper{*this, loc};
return charHelper.createEmboxChar(charBase, unknownLen);
}
diff --git a/flang/test/Lower/HLFIR/ignore-type-f77-character.f90 b/flang/test/Lower/HLFIR/ignore-type-f77-character.f90
new file mode 100644
index 00000000000000..41dbf82d5789d6
--- /dev/null
+++ b/flang/test/Lower/HLFIR/ignore-type-f77-character.f90
@@ -0,0 +1,35 @@
+! Test ignore_tkr(tk) with character dummies
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+module test_char_tk
+ interface
+ subroutine foo(c)
+ character(1)::c(*)
+ !dir$ ignore_tkr(tkrdm) c
+ end subroutine
+ end interface
+contains
+ subroutine test_normal()
+ character(1) :: c(10)
+ call foo(c)
+ end subroutine
+!CHECK-LABEL: func.func @_QMtest_char_tkPtest_normal(
+!CHECK: %[[VAL_6:.*]] = fir.emboxchar %{{.*}}, %c1{{.*}}: (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPfoo(%[[VAL_6]]) fastmath<contract> : (!fir.boxchar<1>) -> ()
+ subroutine test_normal2()
+ character(10) :: c(10)
+ call foo(c)
+ end subroutine
+!CHECK-LABEL: func.func @_QMtest_char_tkPtest_normal2(
+!CHECK: %[[VAL_4:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.array<10x!fir.char<1,10>>>) -> !fir.ref<!fir.char<1,10>>
+!CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %c10{{.*}}: (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPfoo(%[[VAL_5]]) fastmath<contract> : (!fir.boxchar<1>) -> ()
+ subroutine test_weird()
+ real :: c(10)
+ call foo(c)
+ end subroutine
+!CHECK-LABEL: func.func @_QMtest_char_tkPtest_weird(
+!CHECK: %[[VAL_5:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.array<10xf32>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[VAL_6:.*]] = fir.emboxchar %[[VAL_5]], %c0{{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPfoo(%[[VAL_6]]) fastmath<contract> : (!fir.boxchar<1>) -> ()
+end module
diff --git a/flang/test/Lower/call-suspect.f90 b/flang/test/Lower/call-suspect.f90
index 6a3bca83daa05d..4ac58bf2d464c9 100644
--- a/flang/test/Lower/call-suspect.f90
+++ b/flang/test/Lower/call-suspect.f90
@@ -2,13 +2,10 @@
! are accepted regardless to maintain backwards compatibility with
! other Fortran implementations.
-! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
! CHECK-LABEL: func @_QPs1() {
-! CHECK: %[[cast:.*]] = fir.convert %{{.*}} : (!fir.ref<f32>) -> !fir.ref<!fir.char<1,?>>
-! CHECK: %[[undef:.*]] = fir.undefined index
-! CHECK: %[[box:.*]] = fir.emboxchar %[[cast]], %[[undef]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK: fir.call @_QPs3(%[[box]]) {{.*}}: (!fir.boxchar<1>) -> ()
+! CHECK: fir.convert %{{.*}} : ((!fir.boxchar<1>) -> ()) -> ((!fir.ref<f32>) -> ())
! Pass a REAL by reference to a subroutine expecting a CHARACTER
subroutine s1
@@ -16,11 +13,7 @@ subroutine s1
end subroutine s1
! CHECK-LABEL: func @_QPs2(
-! CHECK: %[[ptr:.*]] = fir.box_addr %{{.*}} : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
-! CHECK: %[[cast:.*]] = fir.convert %[[ptr]] : (!fir.ptr<f32>) -> !fir.ref<!fir.char<1,?>>
-! CHECK: %[[undef:.*]] = fir.undefined index
-! CHECK: %[[box:.*]] = fir.emboxchar %[[cast]], %[[undef]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK: fir.call @_QPs3(%[[box]]) {{.*}}: (!fir.boxchar<1>) -> ()
+! CHECK: fir.convert %{{.*}} : ((!fir.boxchar<1>) -> ()) -> ((!fir.ref<f32>) -> ())
! Pass a REAL, POINTER data reference to a subroutine expecting a CHARACTER
subroutine s2(p)
diff --git a/flang/test/Lower/implicit-call-mismatch.f90 b/flang/test/Lower/implicit-call-mismatch.f90
index afe6ad85d8e2e7..ca605d65f922b7 100644
--- a/flang/test/Lower/implicit-call-mismatch.f90
+++ b/flang/test/Lower/implicit-call-mismatch.f90
@@ -135,8 +135,7 @@ subroutine test_conversion_from_proc
! CHECK: %[[proc:.*]] = fir.address_of(@_QPproc) : () -> ()
! CHECK: %[[convert:.*]] = fir.convert %[[proc]] : (() -> ()) -> !fir.ref<!fir.char<1,?>>
- ! CHECK: %[[len:.*]] = fir.undefined index
- ! CHECK: %[[box:.*]] = fir.emboxchar %[[convert]], %[[len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: %[[box:.*]] = fir.emboxchar %[[convert]], %c0{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
! CHECK: fir.call @_QPpass_char_to_proc(%[[box]])
call pass_char_to_proc(proc)
More information about the flang-commits
mailing list