[flang-commits] [flang] c428620 - [flang] Catch calls to assumed-length character functions
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue May 24 12:54:35 PDT 2022
Author: Peter Klausler
Date: 2022-05-24T12:53:32-07:00
New Revision: c428620913ba318a7d6d2a2164b56ff116f90c56
URL: https://github.com/llvm/llvm-project/commit/c428620913ba318a7d6d2a2164b56ff116f90c56
DIFF: https://github.com/llvm/llvm-project/commit/c428620913ba318a7d6d2a2164b56ff116f90c56.diff
LOG: [flang] Catch calls to assumed-length character functions
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
Added:
Modified:
flang/lib/Semantics/expression.cpp
flang/test/Evaluate/rewrite01.f90
flang/test/Lower/dummy-procedure-character.f90
flang/test/Lower/dummy-procedure-in-entry.f90
flang/test/Lower/host-associated.f90
flang/test/Semantics/call01.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index da45ef4f163dc..c1417b6537201 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -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);
@@ -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 *
diff --git a/flang/test/Evaluate/rewrite01.f90 b/flang/test/Evaluate/rewrite01.f90
index 94c43d95ab27a..b95c1b2de8548 100644
--- a/flang/test/Evaluate/rewrite01.f90
+++ b/flang/test/Evaluate/rewrite01.f90
@@ -105,11 +105,9 @@ 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
@@ -117,9 +115,9 @@ subroutine len_test(a,b, c, d, e, n, m)
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)
@@ -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:))
diff --git a/flang/test/Lower/dummy-procedure-character.f90 b/flang/test/Lower/dummy-procedure-character.f90
index 8eabf6df418bc..e2874cb018b81 100644
--- a/flang/test/Lower/dummy-procedure-character.f90
+++ b/flang/test/Lower/dummy-procedure-character.f90
@@ -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)
@@ -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)
diff --git a/flang/test/Lower/dummy-procedure-in-entry.f90 b/flang/test/Lower/dummy-procedure-in-entry.f90
index 7e9cacc522863..07051d56e06b7 100644
--- a/flang/test/Lower/dummy-procedure-in-entry.f90
+++ b/flang/test/Lower/dummy-procedure-in-entry.f90
@@ -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>) -> ()
diff --git a/flang/test/Lower/host-associated.f90 b/flang/test/Lower/host-associated.f90
index a2c7ef10ed58a..9654ddbb49a8a 100644
--- a/flang/test/Lower/host-associated.f90
+++ b/flang/test/Lower/host-associated.f90
@@ -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
@@ -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() {
diff --git a/flang/test/Semantics/call01.f90 b/flang/test/Semantics/call01.f90
index d75b72a4e32ab..f25fe45736bca 100644
--- a/flang/test/Semantics/call01.f90
+++ b/flang/test/Semantics/call01.f90
@@ -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
@@ -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
More information about the flang-commits
mailing list