[flang] Support lowering intrinsic `selected_real_kind` for variables

[peixin]

Summary

As Fortran 2018 16.9.170, the argument of selected_real_kind is integer
scalar, and result is default integer scalar. The constant expression in
this intrinsic has been supported by folding the constant expression.
This supports lowering this intrinsic for variables using runtime.

[peixin]

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

164

I am thinking if it is possible to refactor the Forced### ? For multiple arguments, the combination will result in a large amount of helpers. Or leave it there when more intrinsics have this problem.

[peixin]

Fix the error.

[jeanPerier]

I think this is way too much entry point for a not so performance critical important intrinsic (that is folded 90% of the cases).
Have you considered using a single select_real_kind(void* precision , int precisionKind, void* range, int rangeKind, void* radix, int radixKind) interface ? It should also allow a better handling of the dynamically absent cases.
(Simplifying the interface for select_int_kind is also actually probably worth it, but since it is simpler, I am also OK with its current form).

flang/runtime/numeric.cpp

148

Right now I think there would be an issue if RADIX is absent, lowering would set it to zero, causing the runtime to return an error while the runtime says there is no requirement is about the radix if it is dynamically absent (say it is an absent optional).

I think it would be better to have the runtime interface be const Descriptor*/void* so that the dynamically absent case can be handled by the runtime.

[peixin]

Use the new approach as @jeanPerier suggested.

[peixin]

Rebase due to application patch conflict.

[jeanPerier]

Thanks, looks good to me

flang/include/flang/Optimizer/Builder/Runtime/Numeric.h

 /// Generate call to RRSpacing intrinsic runtime routine.
 mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value x);
 
 /// Generate call to Scale intrinsic runtime routine.
 mlir::Value genScale(fir::FirOpBuilder &builder, mlir::Location loc,
                      mlir::Value x, mlir::Value i);
 
+/// Generate call to Selected_real_kind intrinsic runtime routine.
+mlir::Value genSelectedRealKind(fir::FirOpBuilder &builder, mlir::Location loc,
+                                mlir::Value precision, mlir::Value range,
+                                mlir::Value radix);
+
 /// Generate call to Set_exponent intrinsic runtime routine.
 mlir::Value genSetExponent(fir::FirOpBuilder &builder, mlir::Location loc,
                            mlir::Value x, mlir::Value i);
 
 /// Generate call to Spacing intrinsic runtime routine.
 mlir::Value genSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value x);
 
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_NUMERIC_H

flang/include/flang/Runtime/numeric.h

 CppTypeFor<TypeCategory::Real, 10> RTNAME(Scale10)(
     CppTypeFor<TypeCategory::Real, 10>, std::int64_t);
 #endif
 #if LDBL_MANT_DIG == 113 || HAS_FLOAT128
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16>, std::int64_t);
 #endif
 
+// SELECTED_REAL_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind)(
+    const char *, int, void *, int, void *, int, void *, int);
+
 // SPACING
 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
     CppTypeFor<TypeCategory::Real, 4>);
 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(
     CppTypeFor<TypeCategory::Real, 8>);
 #if LDBL_MANT_DIG == 64
 CppTypeFor<TypeCategory::Real, 10> RTNAME(Spacing10)(
     CppTypeFor<TypeCategory::Real, 10>);

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genRepeat(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genReshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genRRSpacing(mlir::Type resultType,
                            llvm::ArrayRef<mlir::Value> args);
   mlir::Value genScale(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSetExponent(mlir::Type resultType,
                              llvm::ArrayRef<mlir::Value> args);
   template <typename Shift>
   mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
   mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSpacing(mlir::Type resultType,
                          llvm::ArrayRef<mlir::Value> args);
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/true},
     {"scan",
      &I::genScan,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/true},
+    {"selected_real_kind",
+     &I::genSelectedRealKind,
+     {{{"precision", asAddr, handleDynamicOptional},
+       {"range", asAddr, handleDynamicOptional},
+       {"radix", asAddr, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"set_exponent", &I::genSetExponent},
     {"shifta", &I::genShift<mlir::arith::ShRSIOp>},
     {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
     {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
     {"sign", &I::genSign},
     {"size",
      &I::genSize,
      {{{"array", asBox},
IntrinsicLibrary::genScan(mlir::Type resultType,
 
   fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
                                   kind);
 
   // Handle cleanup of allocatable result descriptor and return
   return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
 }
 
+// SELECTED_INT_KIND
+mlir::Value
+IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 3);
+
+  // Handle optional precision(P) argument
+  mlir::Value precision =
+      isStaticallyAbsent(args[0])
+          ? builder.create<fir::AbsentOp>(
+                loc, fir::ReferenceType::get(builder.getI1Type()))
+          : fir::getBase(args[0]);
+
+  // Handle optional range(R) argument
+  mlir::Value range =
+      isStaticallyAbsent(args[1])
+          ? builder.create<fir::AbsentOp>(
+                loc, fir::ReferenceType::get(builder.getI1Type()))
+          : fir::getBase(args[1]);
+
+  // Handle optional radix(RADIX) argument
+  mlir::Value radix =
+      isStaticallyAbsent(args[2])
+          ? builder.create<fir::AbsentOp>(
+                loc, fir::ReferenceType::get(builder.getI1Type()))
+          : fir::getBase(args[2]);
+
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));
+}
+
 // SET_EXPONENT
 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
                                              llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
 
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),

flang/lib/Optimizer/Builder/Runtime/Numeric.cpp

return [](mlir::MLIRContext *ctx) {
       auto fltTy = mlir::FloatType::getF128(ctx);
       auto intTy = mlir::IntegerType::get(ctx, 64);
       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
     };
   }
 };
 
 /// Placeholder for real*10 version of RRSpacing Intrinsic
 struct ForcedSetExponent10 {
   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));
   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctx) {
       auto fltTy = mlir::FloatType::getF80(ctx);
       auto intTy = mlir::IntegerType::get(ctx, 64);
       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
     };
   }
else
     fir::emitFatalError(loc, "unsupported REAL kind in SCALE");
 
   auto funcTy = func.getFunctionType();
   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+/// Generate call to Selected_real_kind intrinsic runtime routine.
+mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,
+                                              mlir::Location loc,
+                                              mlir::Value precision,
+                                              mlir::Value range,
+                                              mlir::Value radix) {
+  mlir::func::FuncOp func =
+      fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind)>(loc, builder);
+  auto fTy = func.getFunctionType();
+  auto getArgKinds = [&](mlir::Value arg, int argKindIndex) -> mlir::Value {
+    if (fir::isa_ref_type(arg.getType())) {
+      mlir::Type eleTy = fir::unwrapRefType(arg.getType());
+      return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex),
+                                           eleTy.getIntOrFloatBitWidth() / 8);
+    } else {
+      return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex), 0);
+    }
+  };
+
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
+  mlir::Value pKind = getArgKinds(precision, 3);
+  mlir::Value rKind = getArgKinds(range, 5);
+  mlir::Value dKind = getArgKinds(radix, 7);
+  auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
+                                            sourceLine, precision, pKind, range,
+                                            rKind, radix, dKind);
+
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
+
 /// Generate call to Set_exponent instrinsic runtime routine.
 mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
                                          mlir::Location loc, mlir::Value x,
                                          mlir::Value i) {
   mlir::func::FuncOp func;
   mlir::Type fltTy = x.getType();
 
   if (fltTy.isF16())

flang/runtime/numeric.cpp

 #include "flang/Runtime/float128.h"
 #include <cfloat>
 #include <climits>
 #include <cmath>
 #include <limits>
 
 namespace Fortran::runtime {
 
+template <typename RES>
+inline RES getIntArgValue(const char *source, int line, void *arg, int kind,
+    std::int64_t defaultValue, int resKind) {
+  RES res;
+  if (!arg) {
+    res = static_cast<RES>(defaultValue);
+  } else if (kind == 1) {
+    res = static_cast<RES>(
+        *static_cast<CppTypeFor<TypeCategory::Integer, 1> *>(arg));
+  } else if (kind == 2) {
+    res = static_cast<RES>(
+        *static_cast<CppTypeFor<TypeCategory::Integer, 2> *>(arg));
+  } else if (kind == 4) {
+    res = static_cast<RES>(
+        *static_cast<CppTypeFor<TypeCategory::Integer, 4> *>(arg));
+  } else if (kind == 8) {
+    res = static_cast<RES>(
+        *static_cast<CppTypeFor<TypeCategory::Integer, 8> *>(arg));
+#ifdef __SIZEOF_INT128__
+  } else if (kind == 16) {
+    if (resKind != 16) {
+      Terminator{source, line}.Crash("Unexpected integer kind in runtime");
+    }
+    res = static_cast<RES>(
+        *static_cast<CppTypeFor<TypeCategory::Integer, 16> *>(arg));
+#endif
+  } else {
+    Terminator{source, line}.Crash("Unexpected integer kind in runtime");
+  }
+  return res;
+}
+
 // NINT (16.9.141)
 template <typename RESULT, typename ARG> inline RESULT Nint(ARG x) {
   if (x >= 0) {
     return std::trunc(x + ARG{0.5});
   } else {
     return std::trunc(x - ARG{0.5});
   }
 }
template <typename T> inline T Scale(T x, std::int64_t p) {
   auto ip{static_cast<int>(p)};
   if (ip != p) {
     ip = p < 0 ? std::numeric_limits<int>::min()
                : std::numeric_limits<int>::max();
   }
   return std::ldexp(x, p); // x*2**p
 }
 
+// SELECTED_REAL_KIND (16.9.170)
+template <typename P, typename R, typename D>
+inline CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(P p, R r, D d) {
+  if (d != 2) {
+    return -5;
+  }
+
+  int error{0};
+  int kind{0};
+  if (p <= 3) {
+    kind = 2;
+  } else if (p <= 6) {
+    kind = 4;
+  } else if (p <= 15) {
+    kind = 8;
+#if LDBL_MANT_DIG == 64
+  } else if (p <= 18) {
+    kind = 10;
+  } else if (p <= 33) {
+    kind = 16;
+#elif LDBL_MANT_DIG == 113
+  } else if (p <= 33) {
+    kind = 16;
+#endif
+  } else {
+    error -= 1;
+  }
+
+  if (r <= 4) {
+    kind = kind < 2 ? 2 : kind;
+  } else if (r <= 37) {
+    kind = kind < 3 ? (p == 3 ? 4 : 3) : kind;
+  } else if (r <= 307) {
+    kind = kind < 8 ? 8 : kind;
+#if LDBL_MANT_DIG == 64
+  } else if (r <= 4931) {
+    kind = kind < 10 ? 10 : kind;
+#elif LDBL_MANT_DIG == 113
+  } else if (r <= 4931) {
+    kind = kind < 16 ? 16 : kind;
+#endif
+  } else {
+    error -= 2;
+  }
+
+  return error ? error : kind;
+}
+
 // SET_EXPONENT (16.9.171)
 template <typename T> inline T SetExponent(T x, std::int64_t p) {
   if (std::isnan(x)) {
     return x; // NaN -> same NaN
   } else if (std::isinf(x)) {
     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
   } else if (x == 0) {
     return x; // return negative zero if x is negative zero

 }
 #elif LDBL_MANT_DIG == 113
 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
     CppTypeFor<TypeCategory::Real, 16> x, std::int64_t p) {
   return Scale(x, p);
 }
 #endif
 
+// SELECTED_REAL_KIND
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind)(
+    const char *source, int line, void *precision, int pKind, void *range,
+    int rKind, void *radix, int dKind) {
+#ifdef __SIZEOF_INT128__
+  CppTypeFor<TypeCategory::Integer, 16> p =
+      getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
+          source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);
+  CppTypeFor<TypeCategory::Integer, 16> r =
+      getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
+          source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);
+  CppTypeFor<TypeCategory::Integer, 16> d =
+      getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
+          source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);
+#else
+  std::int64_t p = getIntArgValue<std::int64_t>(
+      source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);
+  std::int64_t r = getIntArgValue<std::int64_t>(
+      source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);
+  std::int64_t d = getIntArgValue<std::int64_t>(
+      source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);
+#endif
+  return SelectedRealKind(p, r, d);
+}
+
 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
     CppTypeFor<TypeCategory::Real, 4> x) {
   return Spacing<24>(x);
 }
 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(
     CppTypeFor<TypeCategory::Real, 8> x) {
   return Spacing<53>(x);
 }

flang/test/Lower/Intrinsics/selected_real_kind.f90

+! REQUIRES: shell
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test1(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i8> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i8> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i8> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i8 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test1Eres"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i8>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i8>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i8>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i8
+! CHECK:         fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<i8>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test1(p, r, d)
+  integer(1) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test2(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i16> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i16> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i16> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i16 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test2Eres"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i16>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i16>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i16>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i16
+! CHECK:         fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<i16>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test2(p, r, d)
+  integer(2) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test4(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test4Eres"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         fir.store %[[VAL_13]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test4(p, r, d)
+  integer(4) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test8(
+! CHECK-SAME:                                         %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "p"},
+! CHECK-SAME:                                         %[[VAL_1:.*]]: !fir.ref<i64> {fir.bindc_name = "r"},
+! CHECK-SAME:                                         %[[VAL_2:.*]]: !fir.ref<i64> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i64 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test8Eres"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 8 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 8 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 8 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i64>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i64>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i64
+! CHECK:         fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<i64>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test8(p, r, d)
+  integer(8) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test16(
+! CHECK-SAME:                                          %[[VAL_0:.*]]: !fir.ref<i128> {fir.bindc_name = "p"},
+! CHECK-SAME:                                          %[[VAL_1:.*]]: !fir.ref<i128> {fir.bindc_name = "r"},
+! CHECK-SAME:                                          %[[VAL_2:.*]]: !fir.ref<i128> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i128 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test16Eres"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 16 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 16 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 16 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i128>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i128>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<i128>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i128
+! CHECK:         fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<i128>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test16(p, r, d)
+  integer(16) :: p, r, d, res
+  res = selected_real_kind(P=p, R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test_rd(
+! CHECK-SAME:                                           %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "r"},
+! CHECK-SAME:                                           %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test_rdEres"}
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.ref<i1>
+! CHECK:         %[[VAL_6:.*]] = arith.constant 0 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i1>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test_rd(r, d)
+  integer :: r, d, res
+  res = selected_real_kind(R=r, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test_pd(
+! CHECK-SAME:                                           %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "p"},
+! CHECK-SAME:                                           %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "d"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test_pdEres"}
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.ref<i1>
+! CHECK:         %[[VAL_6:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 0 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i1>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test_pd(p, d)
+  integer :: p, d, res
+  res = selected_real_kind(P=p, RADIX=d)
+end
+
+! CHECK-LABEL: func.func @_QPselected_real_kind_test_pr(
+! CHECK-SAME:                                           %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "p"},
+! CHECK-SAME:                                           %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "r"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_real_kind_test_prEres"}
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.ref<i1>
+! CHECK:         %[[VAL_6:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_7:.*]] = arith.constant 4 : i32
+! CHECK:         %[[VAL_8:.*]] = arith.constant 0 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i1>) -> !fir.llvm_ptr<i8>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranASelectedRealKind(%{{.*}}, %{{.*}}, %[[VAL_10]], %[[VAL_6]], %[[VAL_11]], %[[VAL_7]], %[[VAL_12]], %[[VAL_8]]) : (!fir.ref<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32, !fir.llvm_ptr<i8>, i32) -> i32
+! CHECK:         fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine selected_real_kind_test_pr(p, r)
+  integer :: p, r, res
+  res = selected_real_kind(P=p, R=r)
+end

flang/unittests/Runtime/Numeric.cpp

TEST(Numeric, SetExponent) {
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 1), 1.0);
   EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, -1), 0.25);
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent4)(std::numeric_limits<Real<4>>::infinity(), 1)));
   EXPECT_TRUE(std::isnan(
       RTNAME(SetExponent8)(std::numeric_limits<Real<8>>::quiet_NaN(), 1)));
 }
 
+TEST(Numeric, SelectedRealKind) {
+  std::int8_t p_s = 1;
+  std::int16_t p[11] = {-10, 1, 1, 4, 50, 1, 1, 4, 1, 1, 50};
+  std::int32_t r[11] = {-1, 1, 1, 1, 2, 1, 20, 20, 100, 5000, 5000};
+  std::int64_t d[11] = {2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2};
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[0], 2, &r[0], 4, &d[0], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[1], 2, &r[1], 4, &d[1], 8),
+      -5);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[2], 2, &r[2], 4, &d[2], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[3], 2, &r[3], 4, &d[3], 8),
+      4);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[4], 2, &r[4], 4, &d[4], 8),
+      -1);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[5], 2, &r[5], 4, &d[5], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[6], 2, &r[6], 4, &d[6], 8),
+      3);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[7], 2, &r[7], 4, &d[7], 8),
+      4);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[8], 2, &r[8], 4, &d[8], 8),
+      8);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[9], 2, &r[9], 4, &d[9], 8),
+      -2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[10], 2, &r[10], 4, &d[10], 8),
+      -3);
+  EXPECT_EQ(
+      RTNAME(SelectedRealKind)(__FILE__, __LINE__, &p_s, 1, &r[0], 4, &d[0], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, nullptr, 0, &r[0], 4, &d[0], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[0], 2, nullptr, 0, &d[0], 8),
+      2);
+  EXPECT_EQ(RTNAME(SelectedRealKind)(
+                __FILE__, __LINE__, &p[0], 2, &r[0], 4, nullptr, 0),
+      2);
+}
+
 TEST(Numeric, Spacing) {
   EXPECT_EQ(RTNAME(Spacing8)(Real<8>{0}), std::numeric_limits<Real<8>>::min());
   EXPECT_EQ(RTNAME(Spacing4)(Real<4>{3.0}), std::ldexp(Real<4>{1.0}, -22));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing4)(std::numeric_limits<Real<4>>::infinity())));
   EXPECT_TRUE(
       std::isnan(RTNAME(Spacing8)(std::numeric_limits<Real<8>>::quiet_NaN())));
 }