shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang][runtime] Improve handling of short DATE_AND_TIME(VALUES=) (#180557)

Browse Source 
When the actual argument associated with the VALUES= dummy argument of
the intrinsic subroutine DATE_AND_TIME has fewer than eight elements, we
crash with an internal error in the runtime.

With this patch, the compiler now checks the size of the vector at
compilation time, when it is known, and gracefully copes with a short
vector at execution time otherwise, without crashing.
This commit is contained in:
Peter Klausler 2026-02-10 09:21:31 -08:00 committed by GitHub
parent 0d64801bc3
commit 7e1fff4d50
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 39 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
flang-rt/lib/runtime/time-intrinsic.cpp
View File

@ -285,14 +285,17 @@ static void DateAndTimeUnavailable(Fortran::runtime::Terminator &terminator,
if (values) {
auto typeCode{values->type().GetCategoryAndKind()};
RUNTIME_CHECK(terminator,
values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
typeCode &&
values->rank() == 1 && typeCode &&
typeCode->first == Fortran::common::TypeCategory::Integer);
// DATE_AND_TIME values argument must have decimal range > 4. Do not accept
// KIND 1 here.
int kind{typeCode->second};
RUNTIME_CHECK(terminator, kind != 1);
for (std::size_t i = 0; i < 8; ++i) {
auto extent{static_cast<std::size_t>(values->GetDimension(0).Extent())};
if (extent > 8u) {
extent = 8;
}
for (std::size_t i{0}; i < extent; ++i) {
Fortran::runtime::ApplyIntegerKind<StoreNegativeHugeAt, void>(
kind, terminator, *values, i);
}
@ -442,17 +445,19 @@ static void GetDateAndTime(Fortran::runtime::Terminator &terminator, char *date,
if (values) {
auto typeCode{values->type().GetCategoryAndKind()};
RUNTIME_CHECK(terminator,
values->rank() == 1 && values->GetDimension(0).Extent() >= 8 &&
typeCode &&
values->rank() == 1 && typeCode &&
typeCode->first == Fortran::common::TypeCategory::Integer);
// DATE_AND_TIME values argument must have decimal range > 4. Do not accept
// KIND 1 here.
int kind{typeCode->second};
RUNTIME_CHECK(terminator, kind != 1);
auto storeIntegerAt = [&](std::size_t atIndex, std::int64_t value) {
Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,
void>(kind, terminator, *values, atIndex, value);
};
auto extent{static_cast<std::size_t>(values->GetDimension(0).Extent())};
auto storeIntegerAt{[&](std::size_t atIndex, std::int64_t value) {
if (atIndex < extent) {
Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt,
void>(kind, terminator, *values, atIndex, value);
}
}};
storeIntegerAt(0, localTime.tm_year + 1900);
storeIntegerAt(1, localTime.tm_mon + 1);
storeIntegerAt(2, localTime.tm_mday);

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

@ -1890,6 +1890,24 @@ static void CheckCoReduce(
}
}
// DATE_AND_TIME (F'2023 16.9.69)
static void CheckDate_And_Time(evaluate::ActualArguments &arguments,
evaluate::FoldingContext &foldingContext) {
if (arguments.size() >= 4 && arguments[3]) {
if (const auto valuesShape{
evaluate::GetShape(arguments[3]->UnwrapExpr())}) {
if (auto extents{
evaluate::AsConstantExtents(foldingContext, *valuesShape)}) {
if (!extents->empty() && extents->at(0) < 8) {
auto &messages{foldingContext.messages()};
messages.Say(arguments[3]->sourceLocation().value_or(messages.at()),
"VALUES= argument to DATE_AND_TIME must have at least 8 elements"_err_en_US);
}
}
}
}
}
// EVENT_QUERY (F'2023 16.9.82)
static void CheckEvent_Query(evaluate::ActualArguments &arguments,
evaluate::FoldingContext &foldingContext) {
@ -2264,6 +2282,8 @@ static void CheckSpecificIntrinsic(const characteristics::Procedure &proc,
CheckAssociated(arguments, context, scope);
} else if (intrinsic.name == "co_reduce") {
CheckCoReduce(arguments, context.foldingContext());
} else if (intrinsic.name == "date_and_time") {
CheckDate_And_Time(arguments, context.foldingContext());
} else if (intrinsic.name == "event_query") {
CheckEvent_Query(arguments, context.foldingContext());
} else if (intrinsic.name == "image_index") {

5
flang/test/Semantics/bug2203.f90 Normal file
View File

@ -0,0 +1,5 @@
!RUN: %python %S/test_errors.py %s %flang_fc1
integer values(7)
!ERROR: VALUES= argument to DATE_AND_TIME must have at least 8 elements
call date_and_time(values=values)
end