[flang-commits] [flang] 8f16101 - [flang] Accept & fold IEEE_SELECTED_REAL_KIND

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-04-10T10:01:14-07:00
New Revision: 8f16101c703e7d9995dc238ba0f03be52bdf4528

URL: https://github.com/llvm/llvm-project/commit/8f16101c703e7d9995dc238ba0f03be52bdf4528
DIFF: https://github.com/llvm/llvm-project/commit/8f16101c703e7d9995dc238ba0f03be52bdf4528.diff

LOG: [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

Added: 
    flang/test/Semantics/modfile40.f90

Modified: 
    flang/lib/Evaluate/fold-integer.cpp
    flang/lib/Evaluate/intrinsics.cpp
    flang/lib/Semantics/mod-file.cpp
    flang/module/__fortran_builtins.f90
    flang/module/ieee_arithmetic.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index d780df5529570..8f18a0605b2e5 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -579,7 +579,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     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/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 8636c9ed3d77f..26889a6e21d40 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -772,6 +772,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             {"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/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index a60c8dd1cd020..005342007302c 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -561,6 +561,9 @@ void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) {
 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/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index c9cf1110f59c7..d7e73f830d044 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/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/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
index 488a950af681a..bd73c247fe7dd 100644
--- a/flang/module/ieee_arithmetic.f90
+++ b/flang/module/ieee_arithmetic.f90
@@ -19,7 +19,8 @@ module ieee_arithmetic
     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/flang/test/Semantics/modfile40.f90 b/flang/test/Semantics/modfile40.f90
new file mode 100644
index 0000000000000..392b320afdb31
--- /dev/null
+++ b/flang/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
+