Skip to content

Commit c428620

Browse files
klauslerklausler
committed
[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
1 parent 9df0568 commit c428620

File tree

6 files changed

+90
-152
lines changed

6 files changed

+90
-152
lines changed

‎flang/lib/Semantics/expression.cpp

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2266,6 +2266,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
22662266
msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
22672267
callSite);
22682268
} else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
2269+
// TODO: Also catch assumed PDT type parameters
22692270
msg = Say( // 15.6.2.1(3)
22702271
"Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
22712272
callSite);
@@ -2516,17 +2517,19 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
25162517
DEREF(proc.GetSymbol()).name());
25172518
}
25182519
// Checks for ASSOCIATED() are done in intrinsic table processing
2519-
bool procIsAssociated{false};
2520-
if (const SpecificIntrinsic *
2521-
specificIntrinsic{proc.GetSpecificIntrinsic()}) {
2522-
if (specificIntrinsic->name == "associated") {
2523-
procIsAssociated = true;
2524-
}
2525-
}
2520+
const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
2521+
bool procIsAssociated{
2522+
specificIntrinsic && specificIntrinsic->name == "associated"};
25262523
if (!procIsAssociated) {
2524+
if (chars->functionResult &&
2525+
chars->functionResult->IsAssumedLengthCharacter() &&
2526+
!specificIntrinsic) {
2527+
Say(callSite,
2528+
"Assumed-length character function must be defined with a length to be called"_err_en_US);
2529+
}
25272530
semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
25282531
context_.FindScope(callSite), treatExternalAsImplicit,
2529-
proc.GetSpecificIntrinsic());
2532+
specificIntrinsic);
25302533
const Symbol *procSymbol{proc.GetSymbol()};
25312534
if (procSymbol && !IsPureProcedure(*procSymbol)) {
25322535
if (const semantics::Scope *

‎flang/test/Evaluate/rewrite01.f90

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -105,21 +105,19 @@ subroutine lbound_test(x, n, m)
105105
!CHECK: len_test
106106
subroutine len_test(a,b, c, d, e, n, m)
107107
character(*), intent(in) :: a
108-
character(*) :: b
108+
character(10) :: b
109109
external b
110110
character(10), intent(in) :: c
111-
character(10) :: d
112-
external d
113111
integer, intent(in) :: n, m
114112
character(n), intent(in) :: e
115113

116114
!CHECK: PRINT *, int(a%len,kind=8)
117115
print *, len(a, kind=8)
118116
!CHECK: PRINT *, 5_4
119117
print *, len(a(1:5))
120-
!CHECK: PRINT *, len(b(a))
118+
!CHECK: PRINT *, 10_4
121119
print *, len(b(a))
122-
!CHECK: PRINT *, len(b(a)//a)
120+
!CHECK: PRINT *, int(10_8+int(a%len,kind=8),kind=4)
123121
print *, len(b(a) // a)
124122
!CHECK: PRINT *, 10_4
125123
print *, len(c)
@@ -128,14 +126,14 @@ subroutine len_test(a,b, c, d, e, n, m)
128126
!CHECK: PRINT *, 5_4
129127
print *, len(c(1:5))
130128
!CHECK: PRINT *, 10_4
131-
print *, len(d(c))
129+
print *, len(b(c))
132130
!CHECK: PRINT *, 20_4
133-
print *, len(d(c) // c)
131+
print *, len(b(c) // c)
134132
!CHECK: PRINT *, 0_4
135133
print *, len(a(10:4))
136134
!CHECK: PRINT *, int(max(0_8,int(m,kind=8)-int(n,kind=8)+1_8),kind=4)
137135
print *, len(a(n:m))
138-
!CHECK: PRINT *, len(b(a(int(n,kind=8):int(m,kind=8))))
136+
!CHECK: PRINT *, 10_4
139137
print *, len(b(a(n:m)))
140138
!CHECK: PRINT *, int(max(0_8,max(0_8,int(n,kind=8))-4_8+1_8),kind=4)
141139
print *, len(e(4:))

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

Lines changed: 0 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -143,21 +143,6 @@ subroutine override_incoming_length(bar7)
143143
! Test calling character dummy function
144144
! -----------------------------------------------------------------------------
145145

146-
! CHECK-LABEL: func @_QPcall_assumed_length
147-
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
148-
subroutine call_assumed_length(bar8)
149-
character(*) :: bar8
150-
external :: bar8
151-
! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
152-
! CHECK: %[[WAL_2:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
153-
! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
154-
! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_4]] : i64) {bindc_name = ".result"}
155-
! CHECK: %[[VAL_7:.*]] = fir.convert %[[WAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
156-
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
157-
! CHECK: fir.call %[[VAL_7]](%[[VAL_6]], %[[VAL_8]], %{{.*}}) : (!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1>
158-
call test(bar8(42))
159-
end subroutine
160-
161146
! CHECK-LABEL: func @_QPcall_explicit_length
162147
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
163148
subroutine call_explicit_length(bar9)
@@ -196,34 +181,6 @@ function bar10(n)
196181
call test(bar10(42_8))
197182
end subroutine
198183

199-
200-
! CHECK-LABEL: func @_QPhost(
201-
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64>
202-
subroutine host(f)
203-
character*(*) :: f
204-
external :: f
205-
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1:.*]], %{{.*}} : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
206-
! CHECK: fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
207-
! CHECK: fir.call @_QFhostPintern(%[[VAL_1]])
208-
call intern()
209-
contains
210-
! CHECK-LABEL: func @_QFhostPintern(
211-
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc})
212-
subroutine intern()
213-
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
214-
! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
215-
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
216-
! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
217-
! CHECK: %[[WAL_1:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
218-
! CHECK: %[[VAL_5:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
219-
! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_5]] : i64) {bindc_name = ".result"}
220-
! CHECK: %[[VAL_8:.*]] = fir.convert %[[WAL_1]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
221-
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
222-
! CHECK: fir.call %[[VAL_8]](%[[VAL_7]], %[[VAL_9]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
223-
call test(f())
224-
end subroutine
225-
end subroutine
226-
227184
! CHECK-LABEL: func @_QPhost2(
228185
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc})
229186
subroutine host2(f)

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

Lines changed: 0 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -48,43 +48,3 @@ subroutine subroutine_dummy()
4848
! CHECK: ^bb1:
4949
! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
5050
! CHECK: fir.call %[[VAL_1]]() : () -> ()
51-
52-
subroutine character_dummy()
53-
external :: c
54-
character(*) :: c
55-
entry character_dummy_entry(c)
56-
call takes_char(c())
57-
end subroutine
58-
! CHECK-LABEL: func @_QPcharacter_dummy() {
59-
! CHECK: %[[VAL_0:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
60-
! CHECK: br ^bb1
61-
! CHECK: ^bb1:
62-
! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
63-
! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
64-
! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
65-
! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
66-
! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
67-
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
68-
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
69-
! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
70-
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
71-
! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
72-
! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
73-
! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()
74-
75-
! CHECK-LABEL: func @_QPcharacter_dummy_entry(
76-
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
77-
! CHECK: br ^bb1
78-
! CHECK: ^bb1:
79-
! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
80-
! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
81-
! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
82-
! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
83-
! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
84-
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
85-
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
86-
! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
87-
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
88-
! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
89-
! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
90-
! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()

‎flang/test/Lower/host-associated.f90

Lines changed: 46 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -579,57 +579,50 @@ end subroutine test_proc_dummy_other
579579
! CHECK: %[[VAL_10:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,12>>
580580
! CHECK: %[[VAL_11:.*]] = fir.extract_value %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
581581
! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.boxproc<() -> ()>) -> (() -> ())
582-
! CHECK: %[[VAL_13:.*]] = fir.extract_value %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
583-
! CHECK: %[[VAL_14:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
584-
! CHECK: %[[VAL_15:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_13]] : i64) {bindc_name = ".result"}
585-
! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
586-
! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
587-
! CHECK: %[[VAL_18:.*]] = fir.call %[[VAL_16]](%[[VAL_15]], %[[VAL_17]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
588-
! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_17]], %[[VAL_4]] : index
589-
! CHECK: %[[VAL_20:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_19]] : index) {bindc_name = ".chrtmp"}
590-
! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_4]] : (index) -> i64
591-
! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
592-
! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
593-
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_22]], %[[VAL_23]], %[[VAL_21]], %[[VAL_5]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
594-
! CHECK: br ^bb1(%[[VAL_4]], %[[VAL_17]] : index, index)
595-
! CHECK: ^bb1(%[[VAL_24:.*]]: index, %[[VAL_25:.*]]: index):
596-
! CHECK: %[[VAL_26:.*]] = arith.cmpi sgt, %[[VAL_25]], %[[VAL_8]] : index
597-
! CHECK: cond_br %[[VAL_26]], ^bb2, ^bb3
598-
! CHECK: ^bb2:
599-
! CHECK: %[[VAL_27:.*]] = arith.subi %[[VAL_24]], %[[VAL_4]] : index
600-
! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
601-
! CHECK: %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_28]], %[[VAL_27]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
602-
! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_29]] : !fir.ref<!fir.char<1>>
603-
! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
604-
! CHECK: %[[VAL_32:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_24]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
605-
! CHECK: fir.store %[[VAL_30]] to %[[VAL_32]] : !fir.ref<!fir.char<1>>
606-
! CHECK: %[[VAL_33:.*]] = arith.addi %[[VAL_24]], %[[VAL_6]] : index
607-
! CHECK: %[[VAL_34:.*]] = arith.subi %[[VAL_25]], %[[VAL_6]] : index
608-
! CHECK: br ^bb1(%[[VAL_33]], %[[VAL_34]] : index, index)
609-
! CHECK: ^bb3:
610-
! CHECK: %[[VAL_35:.*]] = arith.cmpi slt, %[[VAL_3]], %[[VAL_19]] : index
611-
! CHECK: %[[VAL_36:.*]] = arith.select %[[VAL_35]], %[[VAL_3]], %[[VAL_19]] : index
612-
! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (index) -> i64
613-
! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
614-
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_38]], %[[VAL_22]], %[[VAL_37]], %[[VAL_5]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
615-
! CHECK: %[[VAL_39:.*]] = fir.undefined !fir.char<1>
616-
! CHECK: %[[VAL_40:.*]] = fir.insert_value %[[VAL_39]], %[[VAL_7]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
617-
! CHECK: %[[VAL_41:.*]] = arith.subi %[[VAL_3]], %[[VAL_36]] : index
618-
! CHECK: br ^bb4(%[[VAL_36]], %[[VAL_41]] : index, index)
619-
! CHECK: ^bb4(%[[VAL_42:.*]]: index, %[[VAL_43:.*]]: index):
620-
! CHECK: %[[VAL_44:.*]] = arith.cmpi sgt, %[[VAL_43]], %[[VAL_8]] : index
621-
! CHECK: cond_br %[[VAL_44]], ^bb5, ^bb6
622-
! CHECK: ^bb5:
623-
! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
624-
! CHECK: %[[VAL_46:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_42]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
625-
! CHECK: fir.store %[[VAL_40]] to %[[VAL_46]] : !fir.ref<!fir.char<1>>
626-
! CHECK: %[[VAL_47:.*]] = arith.addi %[[VAL_42]], %[[VAL_6]] : index
627-
! CHECK: %[[VAL_48:.*]] = arith.subi %[[VAL_43]], %[[VAL_6]] : index
628-
! CHECK: br ^bb4(%[[VAL_47]], %[[VAL_48]] : index, index)
629-
! CHECK: ^bb6:
630-
! CHECK: fir.call @llvm.stackrestore(%[[VAL_14]]) : (!fir.ref<i8>) -> ()
631-
! CHECK: %[[VAL_49:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_3]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
632-
! CHECK: return %[[VAL_49]] : !fir.boxchar<1>
582+
! CHECK: %[[VAL_13:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
583+
! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> ((!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>)
584+
! CHECK: %[[VAL_15:.*]] = fir.call %[[VAL_14]](%0, %c10) : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
585+
! CHECK: %[[VAL_16:.*]] = fir.alloca !fir.char<1,?>(%c22 : index) {bindc_name = ".chrtmp"}
586+
! CHECK: %[[VAL_17:.*]] = fir.convert %c12 : (index) -> i64
587+
! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
588+
! CHECK: %[[VAL_19:.*]] = fir.convert %2 : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
589+
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_18]], %[[VAL_19]], %[[VAL_17]], %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
590+
! CHECK: cf.br ^bb1(%c12, %c10 : index, index)
591+
! CHECK: ^bb1(%[[VAL_20:.*]]: index, %[[VAL_21:.*]]: index): // 2 preds: ^bb0, ^bb2
592+
! CHECK: %[[VAL_22:.*]] = arith.cmpi sgt, %[[VAL_21]], %c0 : index
593+
! CHECK: cf.cond_br %[[VAL_22]], ^bb2, ^bb3
594+
! CHECK: ^bb2: // pred: ^bb1
595+
! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_20]], %c12 : index
596+
! CHECK: %[[VAL_24:.*]] = fir.convert %0 : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>
597+
! CHECK: %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_24]], %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
598+
! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_25]] : !fir.ref<!fir.char<1>>
599+
! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
600+
! CHECK: %[[VAL_28:.*]] = fir.coordinate_of %[[VAL_27]], %[[VAL_20]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
601+
! CHECK: fir.store %[[VAL_26]] to %[[VAL_28]] : !fir.ref<!fir.char<1>>
602+
! CHECK: %[[VAL_29:.*]] = arith.addi %[[VAL_20]], %c1 : index
603+
! CHECK: %[[VAL_30:.*]] = arith.subi %[[VAL_21]], %c1 : index
604+
! CHECK: cf.br ^bb1(%[[VAL_29]], %[[VAL_30]] : index, index)
605+
! CHECK: ^bb3: // pred: ^bb1
606+
! CHECK: %[[VAL_31:.*]] = fir.convert %c22 : (index) -> i64
607+
! CHECK: %[[VAL_32:.*]] = fir.convert %1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
608+
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_32]], %[[VAL_18]], %[[VAL_31]], %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
609+
! CHECK: %[[VAL_33:.*]] = fir.undefined !fir.char<1>
610+
! CHECK: %[[VAL_34:.*]] = fir.insert_value %[[VAL_33]], %c32_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
611+
! CHECK: cf.br ^bb4(%c22, %c18 : index, index)
612+
! CHECK: ^bb4(%[[VAL_35:.*]]: index, %[[VAL_36:.*]]: index): // 2 preds: ^bb3, ^bb5
613+
! CHECK: %[[VAL_37:.*]] = arith.cmpi sgt, %[[VAL_36]], %c0 : index
614+
! CHECK: cf.cond_br %[[VAL_37]], ^bb5, ^bb6
615+
! CHECK: ^bb5: // pred: ^bb4
616+
! CHECK: %[[VAL_38:.*]] = fir.convert %1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
617+
! CHECK: %[[VAL_39:.*]] = fir.coordinate_of %[[VAL_38]], %[[VAL_35]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
618+
! CHECK: fir.store %[[VAL_34]] to %[[VAL_39]] : !fir.ref<!fir.char<1>>
619+
! CHECK: %[[VAL_40:.*]] = arith.addi %[[VAL_35]], %c1 : index
620+
! CHECK: %[[VAL_41:.*]] = arith.subi %[[VAL_36]], %c1 : index
621+
! CHECK: cf.br ^bb4(%[[VAL_40]], %[[VAL_41]] : index, index)
622+
! CHECK: ^bb6: // pred: ^bb4
623+
! CHECK: fir.call @llvm.stackrestore(%[[VAL_13]]) : (!fir.ref<i8>) -> ()
624+
! CHECK: %[[VAL_42:.*]] = fir.emboxchar %1, %c40 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
625+
! CHECK: return %[[VAL_42]] : !fir.boxchar<1>
633626
! CHECK: }
634627

635628
subroutine test_proc_dummy_char
@@ -647,8 +640,8 @@ end subroutine test_proc_dummy_char
647640

648641
function get_message(a)
649642
character(40) :: get_message
650-
character(*) :: a
651-
get_message = "message is: " // a()
643+
character(10) :: a
644+
get_message = "message is: " // a()
652645
end function get_message
653646

654647
! CHECK-LABEL: func @_QPtest_11a() {

‎flang/test/Semantics/call01.f90

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -97,6 +97,7 @@ function f13(n) result(res)
9797
res = ''
9898
else
9999
!ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
100+
!ERROR: Assumed-length character function must be defined with a length to be called
100101
res = f13(n-1) ! 15.6.2.1(3)
101102
end if
102103
end function
@@ -112,6 +113,32 @@ function f14(n) result(res)
112113
contains
113114
character(1) function nested
114115
!ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
116+
!ERROR: Assumed-length character function must be defined with a length to be called
115117
nested = f14(n-1) ! 15.6.2.1(3)
116118
end function nested
117119
end function
120+
121+
subroutine s01(f1, f2, fp1, fp2)
122+
character*(*) :: f1, f3, fp1
123+
external :: f1, f3
124+
pointer :: fp1
125+
procedure(character*(*)), pointer :: fp2
126+
interface
127+
character*(*) function f2()
128+
end function
129+
character*(*) function f4()
130+
end function
131+
end interface
132+
!ERROR: Assumed-length character function must be defined with a length to be called
133+
print *, f1()
134+
!ERROR: Assumed-length character function must be defined with a length to be called
135+
print *, f2()
136+
!ERROR: Assumed-length character function must be defined with a length to be called
137+
print *, f3()
138+
!ERROR: Assumed-length character function must be defined with a length to be called
139+
print *, f4()
140+
!ERROR: Assumed-length character function must be defined with a length to be called
141+
print *, fp1()
142+
!ERROR: Assumed-length character function must be defined with a length to be called
143+
print *, fp2()
144+
end subroutine

0 commit comments

Comments
 (0)