[flang] fix ignore_tkr(tk) with character dummy

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;
 

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);
     }

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

flang/test/Lower/call-suspect.f90

@@ -2,25 +2,18 @@
 ! 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
   call s3(r)
 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)

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)