Skip to content

Commit

Permalink
[flang] Catch calls to assumed-length character functions
Browse files Browse the repository at this point in the history 
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 and now get caught.

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.

Differential Revision: https://reviews.llvm.org/D126148
  • Loading branch information
@klausler
klausler committed May 24, 2022
1 parent 9df0568 commit c428620
Show file tree
Hide file tree
Showing 6 changed files with 90 additions and 152 deletions.
19 changes: 11 additions & 8 deletions flang/lib/Semantics/expression.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2266,6 +2266,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
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);
Expand Down Expand Up @@ -2516,17 +2517,19 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
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 *
Expand Down
14 changes: 6 additions & 8 deletions flang/test/Evaluate/rewrite01.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,21 +105,19 @@ subroutine lbound_test(x, n, m)
!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)
Expand All @@ -128,14 +126,14 @@ subroutine len_test(a,b, c, d, e, n, m)
!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:))
Expand Down
43 changes: 0 additions & 43 deletions flang/test/Lower/dummy-procedure-character.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,21 +143,6 @@ subroutine override_incoming_length(bar7)
! 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)
Expand Down Expand Up @@ -196,34 +181,6 @@ function bar10(n)
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)
Expand Down
40 changes: 0 additions & 40 deletions flang/test/Lower/dummy-procedure-in-entry.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,43 +48,3 @@ subroutine subroutine_dummy()
! 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>) -> ()
99 changes: 46 additions & 53 deletions flang/test/Lower/host-associated.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -579,57 +579,50 @@ end subroutine test_proc_dummy_other
! 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
Expand All @@ -647,8 +640,8 @@ 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() {
Expand Down
27 changes: 27 additions & 0 deletions flang/test/Semantics/call01.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,7 @@ function f13(n) result(res)
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
Expand All @@ -112,6 +113,32 @@ function f14(n) result(res)
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

0 comments on commit c428620

Please sign in to comment.