[flang] Refine handling of short character actual arguments

Actual arguments whose lengths are less than the expected length
of their corresponding dummy argument are errors; but this needs
to be refined.  Short actual arguments that are variables remain
errors, but those that are expressions can be (again) extended on
the right with blanks.

Differential Revision: https://reviews.llvm.org/D125115
This commit is contained in:
Peter Klausler 2022-04-30 09:14:07 -07:00
parent 42915e2be2
commit be768164a7
2 changed files with 20 additions and 13 deletions

View File

@ -89,8 +89,9 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
}
}
// When scalar CHARACTER actual arguments are known to be short,
// we extend them on the right with spaces and a warning.
// When a scalar CHARACTER actual argument is known to be short,
// we extend it on the right with spaces and a warning if it is an
// expression, and emit an error if it is a variable.
static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
const characteristics::TypeAndShape &dummyType,
characteristics::TypeAndShape &actualType,
@ -104,15 +105,19 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
auto actualLength{
ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
if (dummyLength && actualLength && *actualLength < *dummyLength) {
messages.Say(
"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
if (evaluate::IsVariable(actual)) {
messages.Say(
"Actual argument variable length '%jd' is less than expected length '%jd'"_err_en_US,
*actualLength, *dummyLength);
} else {
messages.Say(
"Actual argument expression length '%jd' is less than expected length '%jd'"_warn_en_US,
*actualLength, *dummyLength);
auto converted{ConvertToType(dummyType.type(), std::move(actual))};
CHECK(converted);
actual = std::move(*converted);
actualType.set_LEN(SubscriptIntExpr{*dummyLength});
}
}
}
}

View File

@ -121,7 +121,7 @@ module m01
end subroutine
subroutine ch2(x)
character(2), intent(in out) :: x
character(2), intent(in) :: x
end subroutine
subroutine pdtdefault (derivedArg)
!ERROR: Type parameter 'n' lacks a value and has no default
@ -151,8 +151,10 @@ module m01
type(pdtWithDefault(3)) :: defaultVar3
type(pdtWithDefault(4)) :: defaultVar4
character :: ch1
!ERROR: Actual length '1' is less than expected length '2'
!ERROR: Actual argument variable length '1' is less than expected length '2'
call ch2(ch1)
!WARN: Actual argument expression length '0' is less than expected length '2'
call ch2("")
call pdtdefault(vardefault)
call pdtdefault(var3)
call pdtdefault(var4) ! error