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

[Peter Klausler via llvm-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/180557

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.

>From d98fc245b2137b396484f8ebf1219fb42e58ebc1 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 9 Feb 2026 08:46:07 -0800
Subject: [PATCH] [flang][runtime] Improve handling of short
 DATE_AND_TIME(VALUES=)

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.
---
 flang-rt/lib/runtime/time-intrinsic.cpp | 23 ++++++++++++++---------
 flang/lib/Semantics/check-call.cpp      | 20 ++++++++++++++++++++
 flang/test/Semantics/bug2203.f90        |  5 +++++
 3 files changed, 39 insertions(+), 9 deletions(-)
 create mode 100644 flang/test/Semantics/bug2203.f90

diff --git a/flang-rt/lib/runtime/time-intrinsic.cpp b/flang-rt/lib/runtime/time-intrinsic.cpp
index 3daec45ecda86..08f6f9b0cf681 100644
--- a/flang-rt/lib/runtime/time-intrinsic.cpp
+++ b/flang-rt/lib/runtime/time-intrinsic.cpp
@@ -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);
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index f0837e1f2ec61..0e32b56f40e64 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -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") {
diff --git a/flang/test/Semantics/bug2203.f90 b/flang/test/Semantics/bug2203.f90
new file mode 100644
index 0000000000000..ef63e409f4720
--- /dev/null
+++ b/flang/test/Semantics/bug2203.f90
@@ -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