[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

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

           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 *

flang/test/Evaluate/rewrite01.f90

 !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
 

   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 *, 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:))

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

 !     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)

   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)

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

 ! 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:         %[[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

 
 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() {

flang/test/Semantics/call01.f90

     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

  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