[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
This commit is contained in:
peter klausler 2021-04-07 13:21:10 -07:00
parent 8fa3975247
commit 8f16101c70
6 changed files with 76 additions and 3 deletions

View File

@ -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)}) {

View File

@ -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},

View File

@ -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>()};

View File

@ -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 @@ module __Fortran_builtins
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

View File

@ -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

View File

@ -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