[flang] Accept & fold IEEE_SELECTED_REAL_KIND

[klausler]

Summary

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.

[PeteSteinfeld]

When I run check-flang, I get errors:

******************** TEST 'Flang :: Semantics/modfile40.f90' FAILED ********************
Script:
--
: 'RUN: at line 1';   /local/home/psteinfeld/main/66/flang/test/Semantics/test_modfile.sh /local/home/psteinfeld/main/66/flang/test/Semantics/modfile40.f90 /local/home/psteinfeld/main/66/build/tools/flang/test/Semantics/Output/modfile40.f90.tmp /local/home/psteinfeld/main/66/build/bin/f18
--
Exit Code: 1

Command Output (stdout):
--
Unexpected .mod files produced: m1.mod m2.mod m3.mod m4.mod m5.mod

--
Command Output (stderr):
--
test_modfile.sh: FAIL flang/test/Semantics/modfile40.f90

[tskeith]

flang/test/Semantics/modfile40.f90

10

There is a 0xfeff character between '!' and 'E' that is causing problems for the test script.

[klausler]

Remove byte order marks that were inadvertently copied from generated module files for comparison in a new test.

[klausler]

ping

flang/lib/Evaluate/fold-integer.cpp

if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
             context.defaults().GetDefaultKind(TypeCategory::Character)};
         return Expr<T>{SelectedCharKind(*value, defaultKind)};
       }
     }
   } else if (name == "selected_int_kind") {
     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)}) {
           return Expr<T>{SelectedRealKind(*p, *r, *radix)};
         }
       }
     }
   } else if (name == "shape") {

flang/lib/Evaluate/intrinsics.cpp

// NULL() is a special case handled in Probe() below
         {{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
             {"field", SameType, Rank::conformable}},
         SameType, Rank::conformable, IntrinsicClass::transformationalFunction},
     {"verify",
         {{"string", SameChar}, {"set", SameChar},
             {"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},
     {"__builtin_ieee_support_denormal",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
     {"__builtin_ieee_support_divide",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},

flang/lib/Semantics/mod-file.cpp

void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   PutShape(os, details.coshape(), '[', ']');
   PutInit(os, symbol, details.init());
   os << '\n';
 }
 
 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>()};
   const ProcInterface &interface{details.interface()};
   Attrs attrs{symbol.attrs()};
   if (details.passName()) {
     attrs.reset(Attr::PASS);
   }

flang/module/__fortran_builtins.f90

 !===-- module/__fortran_builtins.f90 ---------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! These naming shenanigans prevent names from Fortran intrinsic modules
 ! from being usable on INTRINSIC statements, and force the program
 ! to USE the standard intrinsic modules in order to access the
 ! standard names of the procedures.
 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
 
   type :: __builtin_lock_type
     integer(kind=int64) :: __count
   end type
 
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   end type
 
   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

flang/module/ieee_arithmetic.f90

use __Fortran_builtins, only: &
     ieee_support_denormal => __builtin_ieee_support_denormal, &
     ieee_support_divide => __builtin_ieee_support_divide, &
     ieee_support_inf => __builtin_ieee_support_inf, &
     ieee_support_io => __builtin_ieee_support_io, &
     ieee_support_nan => __builtin_ieee_support_nan, &
     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
     integer(kind=1) :: which = 0
   end type ieee_class_type
 
   type(ieee_class_type), parameter :: &
     ieee_signaling_nan = ieee_class_type(1), &

flang/test/Semantics/modfile40.f90

+! 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
+