From 7e1fff4d5040ed93372975d506cdecd889d70f6a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Tue, 10 Feb 2026 09:21:31 -0800
Subject: [PATCH] [flang][runtime] Improve handling of short
 DATE_AND_TIME(VALUES=) (#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.
---
 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 3daec45ecda8..08f6f9b0cf68 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 f0837e1f2ec6..0e32b56f40e6 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 000000000000..ef63e409f472
--- /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