[flang-commits] [flang] 57e3fa3 - [flang] Support lowering intrinsic `selected_real_kind` for variables
Peixin Qiao via flang-commits
flang-commits at lists.llvm.org
Mon Jul 25 04:38:16 PDT 2022
Author: Peixin Qiao
Date: 2022-07-25T19:36:14+08:00
New Revision: 57e3fa38154309308b928dc13ef1181e7eb3e19a
URL: https://github.com/llvm/llvm-project/commit/57e3fa38154309308b928dc13ef1181e7eb3e19a
DIFF: https://github.com/llvm/llvm-project/commit/57e3fa38154309308b928dc13ef1181e7eb3e19a.diff
LOG: [flang] Support lowering intrinsic `selected_real_kind` for variables
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.
Reviewed By: Jean Perier
Differential Revision: https://reviews.llvm.org/D130183
Added:
flang/test/Lower/Intrinsics/selected_real_kind.f90
Modified:
flang/include/flang/Optimizer/Builder/Runtime/Numeric.h
flang/include/flang/Runtime/numeric.h
flang/lib/Lower/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/Runtime/Numeric.cpp
flang/runtime/numeric.cpp
flang/unittests/Runtime/Numeric.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h b/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h
index 9380ad76ccd73..6a0999edcbbfe 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h
@@ -38,6 +38,11 @@ mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc,
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);
diff --git a/flang/include/flang/Runtime/numeric.h b/flang/include/flang/Runtime/numeric.h
index 42737a4fa874c..5953094dd3bd2 100644
--- a/flang/include/flang/Runtime/numeric.h
+++ b/flang/include/flang/Runtime/numeric.h
@@ -355,6 +355,10 @@ 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>);
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 248bb1d07bb0b..1dbb12229aa52 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -545,6 +545,7 @@ struct IntrinsicLibrary {
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>
@@ -919,6 +920,12 @@ static constexpr IntrinsicHandler handlers[]{
{"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>},
@@ -3759,6 +3766,38 @@ IntrinsicLibrary::genScan(mlir::Type resultType,
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) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp
index 69b1cfd03dce6..9f6280c11cade 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp
@@ -360,6 +360,38 @@ mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
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,
diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp
index 7ab1f137e58ef..958ea8698c7e0 100644
--- a/flang/runtime/numeric.cpp
+++ b/flang/runtime/numeric.cpp
@@ -16,6 +16,38 @@
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) {
@@ -110,6 +142,54 @@ template <typename T> inline T Scale(T x, std::int64_t p) {
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)) {
@@ -714,6 +794,31 @@ CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
}
#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);
diff --git a/flang/test/Lower/Intrinsics/selected_real_kind.f90 b/flang/test/Lower/Intrinsics/selected_real_kind.f90
new file mode 100644
index 0000000000000..6d01555e93ab2
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/selected_real_kind.f90
@@ -0,0 +1,174 @@
+! 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
diff --git a/flang/unittests/Runtime/Numeric.cpp b/flang/unittests/Runtime/Numeric.cpp
index dafde4475bf57..84a83ec001c97 100644
--- a/flang/unittests/Runtime/Numeric.cpp
+++ b/flang/unittests/Runtime/Numeric.cpp
@@ -130,6 +130,58 @@ TEST(Numeric, SetExponent) {
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));
More information about the flang-commits
mailing list