[flang] Accept & fold IEEE_SELECTED_REAL_KIND
F18 supports the standard intrinsic function SELECTED_REAL_KIND
but not its synonym in the standard module IEEE_ARITHMETIC
named IEEE_SELECTED_REAL_KIND until this patch.
Differential Revision: https://reviews.llvm.org/D100066
GitOrigin-RevId: 8f16101c703e7d9995dc238ba0f03be52bdf4528
diff --git a/lib/Evaluate/fold-integer.cpp b/lib/Evaluate/fold-integer.cpp
index d780df5..8f18a06 100644
--- a/lib/Evaluate/fold-integer.cpp
+++ b/lib/Evaluate/fold-integer.cpp
@@ -579,7 +579,8 @@
if (auto p{GetInt64Arg(args[0])}) {
return Expr<T>{SelectedIntKind(*p)};
}
- } else if (name == "selected_real_kind") {
+ } else if (name == "selected_real_kind" ||
+ name == "__builtin_ieee_selected_real_kind") {
if (auto p{GetInt64ArgOr(args[0], 0)}) {
if (auto r{GetInt64ArgOr(args[1], 0)}) {
if (auto radix{GetInt64ArgOr(args[2], 2)}) {
diff --git a/lib/Evaluate/intrinsics.cpp b/lib/Evaluate/intrinsics.cpp
index 8636c9e..26889a6 100644
--- a/lib/Evaluate/intrinsics.cpp
+++ b/lib/Evaluate/intrinsics.cpp
@@ -772,6 +772,11 @@
{"back", AnyLogical, Rank::elemental, Optionality::optional},
DefaultingKIND},
KINDInt},
+ {"__builtin_ieee_selected_real_kind", // alias for selected_real_kind
+ {{"p", AnyInt, Rank::scalar},
+ {"r", AnyInt, Rank::scalar, Optionality::optional},
+ {"radix", AnyInt, Rank::scalar, Optionality::optional}},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
{"__builtin_ieee_support_datatype",
{{"x", AnyReal, Rank::elemental, Optionality::optional}},
DefaultLogical},
diff --git a/lib/Semantics/mod-file.cpp b/lib/Semantics/mod-file.cpp
index a60c8dd..0053420 100644
--- a/lib/Semantics/mod-file.cpp
+++ b/lib/Semantics/mod-file.cpp
@@ -561,6 +561,9 @@
void PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
if (symbol.attrs().test(Attr::INTRINSIC)) {
os << "intrinsic::" << symbol.name() << '\n';
+ if (symbol.attrs().test(Attr::PRIVATE)) {
+ os << "private::" << symbol.name() << '\n';
+ }
return;
}
const auto &details{symbol.get<ProcEntityDetails>()};
diff --git a/module/__fortran_builtins.f90 b/module/__fortran_builtins.f90
index c9cf111..d7e73f8 100644
--- a/module/__fortran_builtins.f90
+++ b/module/__fortran_builtins.f90
@@ -13,11 +13,14 @@
module __Fortran_builtins
use __Fortran_type_info, only: __builtin_c_ptr, __builtin_c_funptr
- integer, parameter, private :: int64 = selected_int_kind(18)
intrinsic :: __builtin_c_f_pointer
intrinsic :: sizeof ! extension
+ intrinsic :: selected_int_kind
+ private :: selected_int_kind
+ integer, parameter, private :: int64 = selected_int_kind(18)
+
type :: __builtin_event_type
integer(kind=int64) :: __count
end type
@@ -32,10 +35,12 @@
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
+ intrinsic :: __builtin_ieee_selected_real_kind
intrinsic :: __builtin_ieee_support_datatype, &
__builtin_ieee_support_denormal, __builtin_ieee_support_divide, &
__builtin_ieee_support_inf, __builtin_ieee_support_io, &
__builtin_ieee_support_nan, __builtin_ieee_support_sqrt, &
__builtin_ieee_support_standard, __builtin_ieee_support_subnormal, &
__builtin_ieee_support_underflow_control
+
end module
diff --git a/module/ieee_arithmetic.f90 b/module/ieee_arithmetic.f90
index 488a950..bd73c24 100644
--- a/module/ieee_arithmetic.f90
+++ b/module/ieee_arithmetic.f90
@@ -19,7 +19,8 @@
ieee_support_sqrt => __builtin_ieee_support_sqrt, &
ieee_support_standard => __builtin_ieee_support_standard, &
ieee_support_subnormal => __builtin_ieee_support_subnormal, &
- ieee_support_underflow_control => __builtin_ieee_support_underflow_control
+ ieee_support_underflow_control => __builtin_ieee_support_underflow_control, &
+ ieee_selected_real_kind => __builtin_ieee_selected_real_kind
type :: ieee_class_type
private
diff --git a/test/Semantics/modfile40.f90 b/test/Semantics/modfile40.f90
new file mode 100644
index 0000000..392b320
--- /dev/null
+++ b/test/Semantics/modfile40.f90
@@ -0,0 +1,58 @@
+! RUN: %S/test_modfile.sh %s %t %f18
+! Ensure that intrinsics in module files retain their 'private' attribute,
+! if they are private.
+
+module m1
+ intrinsic :: selected_real_kind
+ public :: selected_real_kind
+end module
+!Expect: m1.mod
+!module m1
+!intrinsic::selected_real_kind
+!end
+
+module m2
+ use m1, only: foo => selected_real_kind
+ real(foo(5,10)) :: x
+end module
+!Expect: m2.mod
+!module m2
+!use m1,only:foo=>selected_real_kind
+!real(4)::x
+!end
+
+module m3
+ intrinsic :: selected_real_kind
+ private :: selected_real_kind
+end module
+!Expect: m3.mod
+!module m3
+!intrinsic::selected_real_kind
+!private::selected_real_kind
+!end
+
+module m4
+ use m3
+ external :: selected_real_kind
+end module
+!Expect: m4.mod
+!module m4
+!procedure()::selected_real_kind
+!end
+
+module m5
+ private
+ intrinsic :: selected_real_kind
+end module
+!Expect: m5.mod
+!module m5
+!intrinsic::selected_real_kind
+!private::selected_real_kind
+!end
+
+use m2
+use m4
+use m5
+print *, kind(x)
+end
+
