[flang] Catch calls to assumed-length character functions

[klausler]

Summary

Semantics was allowing calls to CHARACTER(*) functions, which are odd
things -- they can be declared, and passed around, but can never actually
be called as such. They must be redeclared with an explicit length that
ends up being passed as a hidden argument. So check for these calls
and diagnose them, add tests, and clean up some existing tests that
were in error.

Possible TODO for lowering: there were some test cases that used
bad calls to assumed-length CHARACTER*(*) functions and validated
their implementations. I've removed some, and adjusted another,
but the code that somehow implemented these calls may need to be
removed and replaced with an assert about bad semantics.

[klausler]

Delete part of a new test that showed up during review and testing.

flang/lib/Semantics/expression.cpp

void ExpressionAnalyzer::CheckForBadRecursion(
     parser::CharBlock callSite, const semantics::Symbol &proc) {
   if (const auto *scope{proc.scope()}) {
     if (scope->sourceRange().Contains(callSite)) {
       parser::Message *msg{nullptr};
       if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
         msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
             callSite);
       } else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
+        // TODO: Also catch assumed PDT type parameters
         msg = Say( // 15.6.2.1(3)
             "Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
             callSite);
       }
       AttachDeclaration(msg, proc);
     }
   }
 }
std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
   if (chars) {
     bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
     if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
       Say(callSite,
           "References to the procedure '%s' require an explicit interface"_err_en_US,
           DEREF(proc.GetSymbol()).name());
     }
     // Checks for ASSOCIATED() are done in intrinsic table processing
-    bool procIsAssociated{false};
-    if (const SpecificIntrinsic *
-        specificIntrinsic{proc.GetSpecificIntrinsic()}) {
-      if (specificIntrinsic->name == "associated") {
-        procIsAssociated = true;
-      }
-    }
+    const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
+    bool procIsAssociated{
+        specificIntrinsic && specificIntrinsic->name == "associated"};
     if (!procIsAssociated) {
+      if (chars->functionResult &&
+          chars->functionResult->IsAssumedLengthCharacter() &&
+          !specificIntrinsic) {
+        Say(callSite,
+            "Assumed-length character function must be defined with a length to be called"_err_en_US);
+      }
       semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
           context_.FindScope(callSite), treatExternalAsImplicit,
-          proc.GetSpecificIntrinsic());
+          specificIntrinsic);
       const Symbol *procSymbol{proc.GetSymbol()};
       if (procSymbol && !IsPureProcedure(*procSymbol)) {
         if (const semantics::Scope *
             pure{semantics::FindPureProcedureContaining(
                 context_.FindScope(callSite))}) {
           Say(callSite,
               "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
               procSymbol->name(), DEREF(pure->symbol()).name());

flang/test/Evaluate/rewrite01.f90

subroutine lbound_test(x, n, m)
   print *, lbound(y, 1)
   !CHECK: PRINT *, lbound(a(1_8)%p,dim=1,kind=8)
   print *, lbound(a(1)%p, 1, kind=8)
 end subroutine
 
 !CHECK: len_test
 subroutine len_test(a,b, c, d, e, n, m)
   character(*), intent(in) :: a
-  character(*) :: b
+  character(10) :: b
   external b
   character(10), intent(in) :: c
-  character(10) :: d
-  external d
   integer, intent(in) :: n, m
   character(n), intent(in) :: e
 
   !CHECK: PRINT *, int(a%len,kind=8)
   print *, len(a, kind=8)
   !CHECK: PRINT *, 5_4
   print *, len(a(1:5))
-  !CHECK: PRINT *, len(b(a))
+  !CHECK: PRINT *, 10_4
   print *, len(b(a))
-  !CHECK: PRINT *, len(b(a)//a)
+  !CHECK: PRINT *, int(10_8+int(a%len,kind=8),kind=4)
   print *, len(b(a) // a)
   !CHECK: PRINT *, 10_4
   print *, len(c)
   !CHECK: PRINT *, len(c(int(i,kind=8):int(j,kind=8)))
   print *, len(c(i:j))
   !CHECK: PRINT *, 5_4
   print *, len(c(1:5))
   !CHECK: PRINT *, 10_4
-  print *, len(d(c))
+  print *, len(b(c))
   !CHECK: PRINT *, 20_4
-  print *, len(d(c) // c)
+  print *, len(b(c) // c)
   !CHECK: PRINT *, 0_4
   print *, len(a(10:4))
   !CHECK: PRINT *, int(max(0_8,int(m,kind=8)-int(n,kind=8)+1_8),kind=4)
   print *, len(a(n:m))
-  !CHECK: PRINT *, len(b(a(int(n,kind=8):int(m,kind=8))))
+  !CHECK: PRINT *, 10_4
   print *, len(b(a(n:m)))
   !CHECK: PRINT *, int(max(0_8,max(0_8,int(n,kind=8))-4_8+1_8),kind=4)
   print *, len(e(4:))
 end subroutine len_test
 
 end module

flang/test/Lower/dummy-procedure-character.f90

 ! CHECK:  fir.call @_QPfoo7(%[[VAL_5]]) : (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
   call foo7(bar7)
 end subroutine
 
 ! -----------------------------------------------------------------------------
 !     Test calling character dummy function
 ! -----------------------------------------------------------------------------
 
-! CHECK-LABEL: func @_QPcall_assumed_length
-! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
-subroutine call_assumed_length(bar8)
-  character(*) :: bar8
-  external :: bar8
-! CHECK:  %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK:  %[[WAL_2:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK:  %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_4]] : i64) {bindc_name = ".result"}
-! CHECK:  %[[VAL_7:.*]] = fir.convert %[[WAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
-! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
-! CHECK:  fir.call %[[VAL_7]](%[[VAL_6]], %[[VAL_8]], %{{.*}}) : (!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1>
-  call test(bar8(42))
-end subroutine
-
 ! CHECK-LABEL: func @_QPcall_explicit_length
 ! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
 subroutine call_explicit_length(bar9)
   character(7) :: bar9
   external :: bar9
 ! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1,7> {bindc_name = ".result"}
 ! CHECK:  %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 ! CHECK:  %[[WAL_1:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())

 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
 ! CHECK:  %[[VAL_6:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
 ! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_5]] : index) {bindc_name = ".result"}
 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[WAL_1]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index, !fir.ref<i64>) -> !fir.boxchar<1>)
 ! CHECK:  fir.call %[[VAL_8]](%[[VAL_7]], %[[VAL_5]], %[[VAL_1]]) : (!fir.ref<!fir.char<1,?>>, index, !fir.ref<i64>) -> !fir.boxchar<1>
   call test(bar10(42_8))
 end subroutine
 
-
-! CHECK-LABEL: func @_QPhost(
-! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64>
-subroutine host(f)
-  character*(*) :: f
-  external :: f
-  ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1:.*]], %{{.*}} : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
-  ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
-  ! CHECK: fir.call @_QFhostPintern(%[[VAL_1]])
-  call intern()
-contains
-! CHECK-LABEL: func @_QFhostPintern(
-! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc})
-  subroutine intern()
-! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
-! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
-! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
-! CHECK:  %[[VAL_4:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK:  %[[WAL_1:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK:  %[[VAL_5:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_5]] : i64) {bindc_name = ".result"}
-! CHECK:  %[[VAL_8:.*]] = fir.convert %[[WAL_1]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
-! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
-! CHECK:  fir.call %[[VAL_8]](%[[VAL_7]], %[[VAL_9]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-    call test(f())
-  end subroutine
-end subroutine
-
 ! CHECK-LABEL: func @_QPhost2(
 ! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc})
 subroutine host2(f)
   ! Test that dummy length is overridden by local length even when used
   ! in the internal procedure. 
   character*(42) :: f
   external :: f
   ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1:.*]], %{{.*}} : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>

flang/test/Lower/dummy-procedure-in-entry.f90

 ! CHECK:  fir.call %[[VAL_1]]() : () -> ()
 
 ! CHECK-LABEL: func @_QPsubroutine_dummy_entry(
 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
 ! CHECK:  br ^bb1
 ! CHECK:  ^bb1:
 ! CHECK:  %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 ! CHECK:  fir.call %[[VAL_1]]() : () -> ()
-
-subroutine character_dummy()
-  external :: c
-  character(*) :: c
-  entry character_dummy_entry(c)
-  call takes_char(c())
-end subroutine
-! CHECK-LABEL: func @_QPcharacter_dummy() {
-! CHECK:  %[[VAL_0:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK:  br ^bb1
-! CHECK:  ^bb1:
-! CHECK:  %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK:  %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK:  %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
-! CHECK:  %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
-! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
-! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
-! CHECK:  %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
-! CHECK:  %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:  fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
-! CHECK:  fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()
-
-! CHECK-LABEL: func @_QPcharacter_dummy_entry(
-! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
-! CHECK:  br ^bb1
-! CHECK:  ^bb1:
-! CHECK:  %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK:  %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK:  %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
-! CHECK:  %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
-! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
-! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
-! CHECK:  %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
-! CHECK:  %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:  fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
-! CHECK:  fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()

flang/test/Lower/host-associated.f90

 ! CHECK-DAG:     %[[VAL_5:.*]] = arith.constant false
 ! CHECK-DAG:     %[[VAL_6:.*]] = arith.constant 1 : index
 ! CHECK-DAG:     %[[VAL_7:.*]] = arith.constant 32 : i8
 ! CHECK-DAG:     %[[VAL_8:.*]] = arith.constant 0 : index
 ! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<!fir.char<1,?>>
 ! CHECK:         %[[VAL_10:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,12>>
 ! CHECK:         %[[VAL_11:.*]] = fir.extract_value %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 ! CHECK:         %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK:         %[[VAL_13:.*]] = fir.extract_value %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK:         %[[VAL_14:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
-! CHECK:         %[[VAL_15:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_13]] : i64) {bindc_name = ".result"}
-! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
-! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
-! CHECK:         %[[VAL_18:.*]] = fir.call %[[VAL_16]](%[[VAL_15]], %[[VAL_17]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:         %[[VAL_19:.*]] = arith.addi %[[VAL_17]], %[[VAL_4]] : index
-! CHECK:         %[[VAL_20:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_19]] : index) {bindc_name = ".chrtmp"}
-! CHECK:         %[[VAL_21:.*]] = fir.convert %[[VAL_4]] : (index) -> i64
-! CHECK:         %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
-! CHECK:         %[[VAL_23:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
-! CHECK:         fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_22]], %[[VAL_23]], %[[VAL_21]], %[[VAL_5]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
-! CHECK:         br ^bb1(%[[VAL_4]], %[[VAL_17]] : index, index)
-! CHECK:       ^bb1(%[[VAL_24:.*]]: index, %[[VAL_25:.*]]: index):
-! CHECK:         %[[VAL_26:.*]] = arith.cmpi sgt, %[[VAL_25]], %[[VAL_8]] : index
-! CHECK:         cond_br %[[VAL_26]], ^bb2, ^bb3
-! CHECK:       ^bb2:
-! CHECK:         %[[VAL_27:.*]] = arith.subi %[[VAL_24]], %[[VAL_4]] : index
-! CHECK:         %[[VAL_28:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
-! CHECK:         %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_28]], %[[VAL_27]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
-! CHECK:         %[[VAL_30:.*]] = fir.load %[[VAL_29]] : !fir.ref<!fir.char<1>>
-! CHECK:         %[[VAL_31:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
-! CHECK:         %[[VAL_32:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_24]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
-! CHECK:         fir.store %[[VAL_30]] to %[[VAL_32]] : !fir.ref<!fir.char<1>>
-! CHECK:         %[[VAL_33:.*]] = arith.addi %[[VAL_24]], %[[VAL_6]] : index
-! CHECK:         %[[VAL_34:.*]] = arith.subi %[[VAL_25]], %[[VAL_6]] : index
-! CHECK:         br ^bb1(%[[VAL_33]], %[[VAL_34]] : index, index)
-! CHECK:       ^bb3:
-! CHECK:         %[[VAL_35:.*]] = arith.cmpi slt, %[[VAL_3]], %[[VAL_19]] : index
-! CHECK:         %[[VAL_36:.*]] = arith.select %[[VAL_35]], %[[VAL_3]], %[[VAL_19]] : index
-! CHECK:         %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (index) -> i64
-! CHECK:         %[[VAL_38:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
-! CHECK:         fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_38]], %[[VAL_22]], %[[VAL_37]], %[[VAL_5]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
-! CHECK:         %[[VAL_39:.*]] = fir.undefined !fir.char<1>
-! CHECK:         %[[VAL_40:.*]] = fir.insert_value %[[VAL_39]], %[[VAL_7]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
-! CHECK:         %[[VAL_41:.*]] = arith.subi %[[VAL_3]], %[[VAL_36]] : index
-! CHECK:         br ^bb4(%[[VAL_36]], %[[VAL_41]] : index, index)
-! CHECK:       ^bb4(%[[VAL_42:.*]]: index, %[[VAL_43:.*]]: index):
-! CHECK:         %[[VAL_44:.*]] = arith.cmpi sgt, %[[VAL_43]], %[[VAL_8]] : index
-! CHECK:         cond_br %[[VAL_44]], ^bb5, ^bb6
-! CHECK:       ^bb5:
-! CHECK:         %[[VAL_45:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
-! CHECK:         %[[VAL_46:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_42]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
-! CHECK:         fir.store %[[VAL_40]] to %[[VAL_46]] : !fir.ref<!fir.char<1>>
-! CHECK:         %[[VAL_47:.*]] = arith.addi %[[VAL_42]], %[[VAL_6]] : index
-! CHECK:         %[[VAL_48:.*]] = arith.subi %[[VAL_43]], %[[VAL_6]] : index
-! CHECK:         br ^bb4(%[[VAL_47]], %[[VAL_48]] : index, index)
-! CHECK:       ^bb6:
-! CHECK:         fir.call @llvm.stackrestore(%[[VAL_14]]) : (!fir.ref<i8>) -> ()
-! CHECK:         %[[VAL_49:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_3]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:         return %[[VAL_49]] : !fir.boxchar<1>
+! CHECK:         %[[VAL_13:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> ((!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>)
+! CHECK:         %[[VAL_15:.*]] = fir.call %[[VAL_14]](%0, %c10) : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+! CHECK:         %[[VAL_16:.*]] = fir.alloca !fir.char<1,?>(%c22 : index) {bindc_name = ".chrtmp"}
+! CHECK:         %[[VAL_17:.*]] = fir.convert %c12 : (index) -> i64
+! CHECK:         %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK:         %[[VAL_19:.*]] = fir.convert %2 : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
+! CHECK:         fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_18]], %[[VAL_19]], %[[VAL_17]], %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK:         cf.br ^bb1(%c12, %c10 : index, index)
+! CHECK:       ^bb1(%[[VAL_20:.*]]: index, %[[VAL_21:.*]]: index):  // 2 preds: ^bb0, ^bb2
+! CHECK:         %[[VAL_22:.*]] = arith.cmpi sgt, %[[VAL_21]], %c0 : index
+! CHECK:         cf.cond_br %[[VAL_22]], ^bb2, ^bb3
+! CHECK:       ^bb2:  // pred: ^bb1
+! CHECK:         %[[VAL_23:.*]] = arith.subi %[[VAL_20]], %c12 : index
+! CHECK:         %[[VAL_24:.*]] = fir.convert %0 : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>
+! CHECK:         %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_24]], %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+! CHECK:         %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref<!fir.char<1>>
+! CHECK:         %[[VAL_27:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+! CHECK:         %[[VAL_28:.*]] = fir.coordinate_of %[[VAL_27]], %[[VAL_20]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+! CHECK:         fir.store %[[VAL_26]] to %[[VAL_28]] : !fir.ref<!fir.char<1>>
+! CHECK:         %[[VAL_29:.*]] = arith.addi %[[VAL_20]], %c1 : index
+! CHECK:         %[[VAL_30:.*]] = arith.subi %[[VAL_21]], %c1 : index
+! CHECK:         cf.br ^bb1(%[[VAL_29]], %[[VAL_30]] : index, index)
+! CHECK:       ^bb3:  // pred: ^bb1
+! CHECK:         %[[VAL_31:.*]] = fir.convert %c22 : (index) -> i64
+! CHECK:         %[[VAL_32:.*]] = fir.convert %1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK:         fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_32]], %[[VAL_18]], %[[VAL_31]], %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK:         %[[VAL_33:.*]] = fir.undefined !fir.char<1>
+! CHECK:         %[[VAL_34:.*]] = fir.insert_value %[[VAL_33]], %c32_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+! CHECK:         cf.br ^bb4(%c22, %c18 : index, index)
+! CHECK:       ^bb4(%[[VAL_35:.*]]: index, %[[VAL_36:.*]]: index):  // 2 preds: ^bb3, ^bb5
+! CHECK:         %[[VAL_37:.*]] = arith.cmpi sgt, %[[VAL_36]], %c0 : index
+! CHECK:         cf.cond_br %[[VAL_37]], ^bb5, ^bb6
+! CHECK:       ^bb5:  // pred: ^bb4
+! CHECK:         %[[VAL_38:.*]] = fir.convert %1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+! CHECK:         %[[VAL_39:.*]] = fir.coordinate_of %[[VAL_38]], %[[VAL_35]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+! CHECK:         fir.store %[[VAL_34]] to %[[VAL_39]] : !fir.ref<!fir.char<1>>
+! CHECK:         %[[VAL_40:.*]] = arith.addi %[[VAL_35]], %c1 : index
+! CHECK:         %[[VAL_41:.*]] = arith.subi %[[VAL_36]], %c1 : index
+! CHECK:         cf.br ^bb4(%[[VAL_40]], %[[VAL_41]] : index, index)
+! CHECK:       ^bb6:  // pred: ^bb4
+! CHECK:         fir.call @llvm.stackrestore(%[[VAL_13]]) : (!fir.ref<i8>) -> ()
+! CHECK:         %[[VAL_42:.*]] = fir.emboxchar %1, %c40 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         return %[[VAL_42]] : !fir.boxchar<1>
 ! CHECK:       }
 
 subroutine test_proc_dummy_char
   character(40) get_message
   external get_message
   character(10) message
   message = "Hi there!"
   print *, get_message(gen_message)
 contains
   function gen_message
     character(10) :: gen_message
     gen_message = message
   end function gen_message
 end subroutine test_proc_dummy_char
 
 function get_message(a)
   character(40) :: get_message
-  character(*) :: a
-  get_message = "message is: " // a() 
+  character(10) :: a
+  get_message = "message is: " // a()
 end function get_message
 
 ! CHECK-LABEL: func @_QPtest_11a() {
 ! CHECK: %[[a:.*]] = fir.address_of(@_QPtest_11b) : () -> ()
 ! CHECK: %[[b:.*]] = fir.emboxproc %[[a]] : (() -> ()) -> !fir.boxproc<() -> ()>
 ! CHECK: fir.call @_QPtest_11c(%[[b]], %{{.*}}) : (!fir.boxproc<() -> ()>, !fir.ref<i32>) -> ()
 ! CHECK: func private @_QPtest_11c(!fir.boxproc<() -> ()>, !fir.ref<i32>)
 
 subroutine test_11a
   external test_11b
   call test_11c(test_11b, 3)
 end subroutine test_11a

flang/test/Semantics/call01.f90

 
 function f13(n) result(res)
   integer, value :: n
   character(*) :: res
   if (n <= 0) then
     res = ''
   else
     !ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
+    !ERROR: Assumed-length character function must be defined with a length to be called
     res = f13(n-1) ! 15.6.2.1(3)
   end if
 end function
 
 function f14(n) result(res)
   integer, value :: n
   character(*) :: res
   if (n <= 0) then
     res = ''
   else
     res = nested()
   end if
  contains
   character(1) function nested
     !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
+    !ERROR: Assumed-length character function must be defined with a length to be called
     nested = f14(n-1) ! 15.6.2.1(3)
   end function nested
 end function
+
+subroutine s01(f1, f2, fp1, fp2)
+  character*(*) :: f1, f3, fp1
+  external :: f1, f3
+  pointer :: fp1
+  procedure(character*(*)), pointer :: fp2
+  interface
+    character*(*) function f2()
+    end function
+    character*(*) function f4()
+    end function
+  end interface
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, f1()
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, f2()
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, f3()
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, f4()
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, fp1()
+  !ERROR: Assumed-length character function must be defined with a length to be called
+  print *, fp2()
+end subroutine