[flang] Implement SECOND intrinsic (#98881)

The SECOND intrinsic is a gnu extension providing an alias for CPU_TIME:
https://gcc.gnu.org/onlinedocs/gfortran/SECOND.html

This cannot be implemented as a straightforward alias because there is
both a function and a subroutine form.

Author: tblah

flang/docs/Intrinsics.md

@@ -1047,3 +1047,16 @@ program rename_proc
     call rename('dst', 'src')
 end program rename_proc
 ```
+
+### Non-standard Intrinsics: SECOND
+This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
+function form.
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL SECOND(TIME)` or `TIME = SECOND()`
+- **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in
+                          seconds is written
+- **RETURN value:** same as TIME argument

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -357,6 +357,8 @@ struct IntrinsicLibrary {
                                    llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genSecond(std::optional<mlir::Type>,
+                               mlir::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSelectedCharKind(mlir::Type,
                                          llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef<mlir::Value>);

flang/lib/Evaluate/intrinsics.cpp

@@ -822,6 +822,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
             DefaultingKIND},
         KINDInt},
+    {"second", {}, DefaultReal, Rank::scalar},
     {"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt,
         Rank::scalar, IntrinsicClass::transformationalFunction},
     {"selected_int_kind", {{"r", AnyInt, Rank::scalar}}, DefaultInt,
@@ -1474,6 +1475,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"status", DefaultInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::scalar, IntrinsicClass::impureSubroutine},
+    {"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar,
+        IntrinsicClass::impureSubroutine},
     {"system",
         {{"command", DefaultChar, Rank::scalar},
             {"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
@@ -2623,7 +2626,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
   // Collection for some intrinsics with function and subroutine form,
   // in order to pass the semantic check.
   static const std::string dualIntrinsic[]{
-      {"etime"s}, {"getcwd"s}, {"rename"s}};
+      {"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}};
 
   return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
              [&name](const std::string &dualName) {

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -583,6 +583,10 @@ static constexpr IntrinsicHandler handlers[]{
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
+    {"second",
+     &I::genSecond,
+     {{{"time", asAddr}}},
+     /*isElemental=*/false},
     {"selected_char_kind",
      &I::genSelectedCharKind,
      {{{"name", asAddr}}},
@@ -6140,6 +6144,27 @@ IntrinsicLibrary::genScan(mlir::Type resultType,
   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
 }
 
+// SECOND
+fir::ExtendedValue
+IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType,
+                            mlir::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1 && !resultType || args.empty() && resultType);
+
+  fir::ExtendedValue result;
+
+  if (resultType)
+    result = builder.createTemporary(loc, *resultType);
+  else
+    result = args[0];
+
+  llvm::SmallVector<fir::ExtendedValue, 1> subroutineArgs(1, result);
+  genCpuTime(subroutineArgs);
+
+  if (resultType)
+    return result;
+  return {};
+}
+
 // SELECTED_CHAR_KIND
 fir::ExtendedValue
 IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType,

flang/test/Lower/Intrinsics/second.f90

@@ -0,0 +1,37 @@
+!RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+subroutine test_subroutine(time)
+  real :: time
+  call second(time)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_subroutine(
+! CHECK-SAME:                                  %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+! CHECK:           %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QFtest_subroutineEtime"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_3:.*]] = fir.call @_FortranACpuTime() fastmath<contract> : () -> f64
+! CHECK:           %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (f64) -> f32
+! CHECK:           fir.store %[[VAL_4]] to %[[VAL_2]]#1 : !fir.ref<f32>
+! CHECK:           return
+! CHECK:         }
+
+
+subroutine test_function(time)
+  real :: time
+  time = second()
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_function(
+! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "time"}) {
+! CHECK:           %[[VAL_1:.*]] = fir.alloca f32
+! CHECK:           %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_2]] {uniq_name = "_QFtest_functionEtime"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_4:.*]] = fir.call @_FortranACpuTime() fastmath<contract> : () -> f64
+! CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (f64) -> f32
+! CHECK:           fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:           %[[VAL_7:.*]] = arith.constant false
+! CHECK:           %[[VAL_8:.*]] = hlfir.as_expr %[[VAL_6]]#0 move %[[VAL_7]] : (!fir.ref<f32>, i1) -> !hlfir.expr<f32>
+! CHECK:           hlfir.assign %[[VAL_8]] to %[[VAL_3]]#0 : !hlfir.expr<f32>, !fir.ref<f32>
+! CHECK:           hlfir.destroy %[[VAL_8]] : !hlfir.expr<f32>
+! CHECK:           return
+! CHECK:         }