DATE_AND_TIME TIME and ZONE args lowering

Author: jeanPerier

flang/include/flang/Lower/Runtime.h

@@ -70,7 +70,9 @@ void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &);
 void genPauseStatement(AbstractConverter &, const parser::PauseStmt &);
 
 void genDateAndTime(FirOpBuilder &, mlir::Location,
-                    llvm::Optional<fir::CharBoxValue> date);
+                    llvm::Optional<fir::CharBoxValue> date,
+                    llvm::Optional<fir::CharBoxValue> time,
+                    llvm::Optional<fir::CharBoxValue> zone);
 
 } // namespace lower
 } // namespace Fortran

flang/lib/Lower/IntrinsicCall.cpp

@@ -1167,15 +1167,17 @@ mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
 // DATE_AND_TIME
 void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 4 && "date_and_time has 4 args");
-  llvm::Optional<fir::CharBoxValue> date;
-  if (auto *charBox = args[0].getCharBox())
-    date = *charBox;
-  for (auto i = 1; i < 4; ++i)
-    if (fir::getBase(args[i]))
-      llvm::errs() << "TODO: lowering of DATE_AND_TIME arguments other than "
-                      "DATE not yet implemented\n";
-
-  Fortran::lower::genDateAndTime(builder, loc, date);
+  llvm::SmallVector<llvm::Optional<fir::CharBoxValue>, 3> charArgs(3);
+  for (auto i = 0; i < 3; ++i)
+    if (auto *charBox = args[i].getCharBox())
+      charArgs[i] = *charBox;
+  // TODO: build descriptor for VALUES (also update runtime)
+  if (fir::getBase(args[3]))
+    mlir::emitError(loc, "TODO: lowering of DATE_AND_TIME VALUES argument not "
+                         "yet implemented\n");
+
+  Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
+                                 charArgs[2]);
 }
 
 // DIM

flang/lib/Lower/Runtime.cpp

@@ -183,20 +183,36 @@ void Fortran::lower::genPauseStatement(
 
 void Fortran::lower::genDateAndTime(Fortran::lower::FirOpBuilder &builder,
                                     mlir::Location loc,
-                                    llvm::Optional<fir::CharBoxValue> date) {
+                                    llvm::Optional<fir::CharBoxValue> date,
+                                    llvm::Optional<fir::CharBoxValue> time,
+                                    llvm::Optional<fir::CharBoxValue> zone) {
   auto callee = genRuntimeFunction<mkRTKey(DateAndTime)>(loc, builder);
   mlir::Type idxTy = builder.getIndexType();
+  mlir::Value zero;
+  auto splitArg = [&](llvm::Optional<fir::CharBoxValue> arg,
+                      mlir::Value &buffer, mlir::Value &len) {
+    if (arg) {
+      buffer = arg->getBuffer();
+      len = arg->getLen();
+    } else {
+      if (!zero)
+        zero = builder.createIntegerConstant(loc, idxTy, 0);
+      buffer = zero;
+      len = zero;
+    }
+  };
   mlir::Value dateBuffer;
   mlir::Value dateLen;
-  if (date) {
-    dateBuffer = date->getBuffer();
-    dateLen = date->getLen();
-  } else {
-    auto zero = builder.createIntegerConstant(loc, idxTy, 0);
-    dateBuffer = zero;
-    dateLen = zero;
-  }
-  llvm::SmallVector<mlir::Value, 2> args{dateBuffer, dateLen};
+  splitArg(date, dateBuffer, dateLen);
+  mlir::Value timeBuffer;
+  mlir::Value timeLen;
+  splitArg(time, timeBuffer, timeLen);
+  mlir::Value zoneBuffer;
+  mlir::Value zoneLen;
+  splitArg(zone, zoneBuffer, zoneLen);
+
+  llvm::SmallVector<mlir::Value, 2> args{dateBuffer, timeBuffer, zoneBuffer,
+                                         dateLen,    timeLen,    zoneLen};
   llvm::SmallVector<mlir::Value, 2> operands;
   for (const auto &op : llvm::zip(args, callee.getType().getInputs()))
     operands.emplace_back(

flang/runtime/clock.cpp

@@ -12,30 +12,59 @@
 #include <algorithm>
 #include <cstdlib>
 #include <cstring>
+#include <stdio.h>
 #include <time.h>
-// FIXME: windows
+// TODO: windows, localtime_r/gettimeofday do not exists/ are different.
+#ifndef _WIN32
 #include <sys/time.h>
 
 namespace Fortran::runtime {
 
-void RTNAME(DateAndTime)(char *date, std::size_t dateChars) {
-  static constexpr int buffSize{16};
-  char buffer[buffSize];
+void RTNAME(DateAndTime)(char *date, char *time, char *zone,
+    std::size_t dateChars, std::size_t timeChars, std::size_t zoneChars) {
   timeval t;
-  time_t timer;
-  tm time;
+  ::gettimeofday(&t, nullptr);
+  time_t timer{t.tv_sec};
+  tm localTime;
+  ::localtime_r(&timer, &localTime);
 
-  gettimeofday(&t, nullptr);
-  timer = t.tv_sec;
-  // TODO windows
-  localtime_r(&timer, &time);
+  static constexpr int buffSize{16};
+  char buffer[buffSize];
+  auto copyBufferAndPad{
+      [&](char *dest, std::size_t destChars, std::size_t len) {
+        auto copyLen{std::min(len, destChars)};
+        std::memcpy(dest, buffer, copyLen);
+        for (auto i{copyLen}; i < destChars; ++i) {
+          dest[i] = ' ';
+        }
+      }};
   if (date) {
-    auto len = strftime(buffer, buffSize, "%Y%m%d", &time);
-    auto copyLen = std::min(len, dateChars);
-    std::memcpy(date, buffer, copyLen);
-    for (auto i{copyLen}; i < dateChars; ++i) {
-      date[i] = ' ';
-    }
+    auto len = ::strftime(buffer, buffSize, "%Y%m%d", &localTime);
+    copyBufferAndPad(date, dateChars, len);
+  }
+  if (time) {
+    auto ms{t.tv_usec / 1000};
+    auto len{::snprintf(buffer, buffSize, "%02d%02d%02d.%03ld",
+        localTime.tm_hour, localTime.tm_min, localTime.tm_sec, ms)};
+    copyBufferAndPad(time, timeChars, len);
   }
+  if (zone) {
+    // Note: this may leave the buffer empty on many platforms. Classic flang
+    // has a much more complex way of doing this (see __io_timezone in classic
+    // flang).
+    auto len{::strftime(buffer, buffSize, "%z", &localTime)};
+    copyBufferAndPad(zone, zoneChars, len);
+  }
+}
+} // namespace Fortran::runtime
+
+#else /* Windows */
+// TODO: implement windows version (probably best to try merging implementations
+// as much as possible).
+namespace Fortran::runtime {
+void RTNAME(DateAndTime)(
+    char *, char *, char *, std::size_t, std::size_t, std::size_t) {
+  // TODO
 }
 } // namespace Fortran::runtime
+#endif

flang/runtime/clock.h

@@ -1,4 +1,4 @@
-//===-- runtime/clock.h -------------------------------------*- C++ -*-===//
+//===-- runtime/clock.h -----------------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
@@ -20,7 +20,14 @@ class Descriptor;
 
 extern "C" {
 
-void RTNAME(DateAndTime)(char *date, std::size_t dateChars);
+/// Implement runtime for DATE_AND_TIME intrinsic.
+/// TODO:
+/// - Add VALUES argument (through descriptor).
+/// - Windows implementation (currently does nothing)
+void RTNAME(DateAndTime)(char *date, char *time, char *zone,
+    std::size_t dateChars, std::size_t timeChars, std::size_t zoneChars);
 }
+
+// TODO: CPU_TIME, SYSTEM_CLOCK
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_CLOCK_H_