diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -89,8 +89,9 @@ } } -// 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 &actual, const characteristics::TypeAndShape &dummyType, characteristics::TypeAndShape &actualType, @@ -104,15 +105,19 @@ 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}); + } } } } diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90 --- a/flang/test/Semantics/call03.f90 +++ b/flang/test/Semantics/call03.f90 @@ -121,7 +121,7 @@ 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 @@ 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