maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Upgrade short actual character arguments to errors 

f18 was emitting a warning about short character actual arguments to
subprograms and statement functions; every other compiler considers this
case to be an error.

Differential Revision: https://reviews.llvm.org/D123731
This commit is contained in:
Peter Klausler 2022-04-11 18:39:02 -07:00
parent 01252b4815
commit 847c39838e
3 changed files with 6 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
flang/lib/Semantics/check-call.cpp
View File

@ -79,7 +79,7 @@ static void CheckImplicitInterfaceArg(
// When scalar CHARACTER actual arguments are known to be short,
// we extend them on the right with spaces and a warning.
static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
const characteristics::TypeAndShape &dummyType,
characteristics::TypeAndShape &actualType,
evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
@ -93,12 +93,14 @@ static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
if (dummyLength && actualLength && *actualLength < *dummyLength) {
messages.Say(
"Actual length '%jd' is less than expected length '%jd'"_warn_en_US,
"Actual length '%jd' is less than expected length '%jd'"_err_en_US,
*actualLength, *dummyLength);
#if 0 // We used to just emit a warning, and padded the actual argument
auto converted{ConvertToType(dummyType.type(), std::move(actual))};
CHECK(converted);
actual = std::move(*converted);
actualType.set_LEN(SubscriptIntExpr{*dummyLength});
#endif
}
}
}
@ -152,7 +154,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// Basic type & rank checking
parser::ContextualMessages &messages{context.messages()};
PadShortCharacterActual(actual, dummy.type, actualType, context, messages);
CheckCharacterActual(actual, dummy.type, actualType, context, messages);
if (allowIntegerConversions) {
ConvertIntegerActual(actual, dummy.type, actualType, messages);
}

28
flang/test/Lower/set-length.f90
View File

@ -1,28 +0,0 @@
! Test evaluate::SetLength lowering (used to set a different length on a
! character storage around calls where the dummy and actual length differ).
! RUN: bbc -emit-fir -o - %s | FileCheck %s
subroutine takes_length_4(c)
character c(3)*4
!do i = 1,3
print *, c(i)
!enddo
end
! CHECK-LABEL: func @_QPfoo(
subroutine foo(c)
character c(4)*3
! evaluate::Expr is: CALL s(%SET_LENGTH(c(1_8),4_8)) after semantics.
call takes_length_4(c(1))
! CHECK: %[[VAL_2:.*]] = arith.constant 4 : i64
! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, i64) -> !fir.ref<!fir.char<1,3>>
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<!fir.char<1,?>>
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
! CHECK: %[[VAL_9:.*]] = fir.emboxchar %[[VAL_7]], %[[VAL_8]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
! CHECK: fir.call @_QPtakes_length_4(%[[VAL_9]]) : (!fir.boxchar<1>) -> ()
end subroutine
character(3) :: c(4) = ["abc", "def", "ghi", "klm"]
call foo(c)
end

3
flang/test/Semantics/call03.f90
View File

@ -151,8 +151,7 @@ module m01
type(pdtWithDefault(3)) :: defaultVar3
type(pdtWithDefault(4)) :: defaultVar4
character :: ch1
! The actual argument is converted to a padded expression.
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
!ERROR: Actual length '1' is less than expected length '2'
call ch2(ch1)
call pdtdefault(vardefault)
call pdtdefault(var3)