}
}
-// 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,
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});
+ }
}
}
}
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
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