diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp index 76d4ead4af091..e1cc4266e8024 100644 --- a/flang/lib/Semantics/check-do-forall.cpp +++ b/flang/lib/Semantics/check-do-forall.cpp @@ -279,7 +279,8 @@ class DoConcurrentBodyEnforce { " CONCURRENT"_err_en_US, doConcurrentSourcePosition_); } - if (name->symbol && fromScope(*name->symbol, "ieee_exceptions"s)) { + if (name->symbol && + fromScope(*name->symbol, "__fortran_ieee_exceptions"s)) { if (name->source == "ieee_set_halting_mode") { SayWithDo(context_, currentStatementSourcePosition_, "IEEE_SET_HALTING_MODE is not allowed in DO " diff --git a/flang/module/__fortran_ieee_exceptions.f90 b/flang/module/__fortran_ieee_exceptions.f90 new file mode 100644 index 0000000000000..bd8782e4db5a6 --- /dev/null +++ b/flang/module/__fortran_ieee_exceptions.f90 @@ -0,0 +1,129 @@ +!===-- module/__fortran_ieee_exceptions.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 +! +!===------------------------------------------------------------------------===! + +! See Fortran 2018, clause 17 +! The content of the standard intrinsic IEEE_EXCEPTIONS module is packaged +! here under another name so that IEEE_ARITHMETIC can USE it and export its +! declarations without clashing with a non-intrinsic module in a program. + +module __Fortran_ieee_exceptions + + type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3 + private + integer(kind=1) :: flag = 0 + end type ieee_flag_type + + type(ieee_flag_type), parameter :: & + ieee_invalid = ieee_flag_type(1), & + ieee_overflow = ieee_flag_type(2), & + ieee_divide_by_zero = ieee_flag_type(4), & + ieee_underflow = ieee_flag_type(8), & + ieee_inexact = ieee_flag_type(16), & + ieee_denorm = ieee_flag_type(32) ! PGI extension + + type(ieee_flag_type), parameter :: & + ieee_usual(*) = [ & + ieee_overflow, ieee_divide_by_zero, ieee_invalid ], & + ieee_all(*) = [ & + ieee_usual, ieee_underflow, ieee_inexact, ieee_denorm ] + + type :: ieee_modes_type ! Fortran 2018, 17.7 + private + end type ieee_modes_type + + type :: ieee_status_type ! Fortran 2018, 17.7 + private + end type ieee_status_type + + private :: ieee_support_flag_2, ieee_support_flag_3, & + ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, & + ieee_support_flag_16 + interface ieee_support_flag + module procedure :: ieee_support_flag, & + ieee_support_flag_2, ieee_support_flag_3, & + ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, & + ieee_support_flag_16 + end interface + + contains + elemental subroutine ieee_get_flag(flag, flag_value) + type(ieee_flag_type), intent(in) :: flag + logical, intent(out) :: flag_value + end subroutine ieee_get_flag + + elemental subroutine ieee_get_halting_mode(flag, halting) + type(ieee_flag_type), intent(in) :: flag + logical, intent(out) :: halting + end subroutine ieee_get_halting_mode + + subroutine ieee_get_modes(modes) + type(ieee_modes_type), intent(out) :: modes + end subroutine ieee_get_modes + + subroutine ieee_get_status(status) + type(ieee_status_type), intent(out) :: status + end subroutine ieee_get_status + + pure subroutine ieee_set_flag(flag, flag_value) + type(ieee_flag_type), intent(in) :: flag + logical, intent(in) :: flag_value + end subroutine ieee_set_flag + + pure subroutine ieee_set_halting_mode(flag, halting) + type(ieee_flag_type), intent(in) :: flag + logical, intent(in) :: halting + end subroutine ieee_set_halting_mode + + subroutine ieee_set_modes(modes) + type(ieee_modes_type), intent(in) :: modes + end subroutine ieee_set_modes + + subroutine ieee_set_status(status) + type(ieee_status_type), intent(in) :: status + end subroutine ieee_set_status + + pure logical function ieee_support_flag(flag) + type(ieee_flag_type), intent(in) :: flag + ieee_support_flag = .true. + end function + pure logical function ieee_support_flag_2(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=2), intent(in) :: x(..) + ieee_support_flag_2 = .true. + end function + pure logical function ieee_support_flag_3(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=3), intent(in) :: x(..) + ieee_support_flag_3 = .true. + end function + pure logical function ieee_support_flag_4(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=4), intent(in) :: x(..) + ieee_support_flag_4 = .true. + end function + pure logical function ieee_support_flag_8(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=8), intent(in) :: x(..) + ieee_support_flag_8 = .true. + end function + pure logical function ieee_support_flag_10(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=10), intent(in) :: x(..) + ieee_support_flag_10 = .true. + end function + pure logical function ieee_support_flag_16(flag, x) + type(ieee_flag_type), intent(in) :: flag + real(kind=16), intent(in) :: x(..) + ieee_support_flag_16 = .true. + end function + + pure logical function ieee_support_halting(flag) + type(ieee_flag_type), intent(in) :: flag + end function ieee_support_halting + +end module __Fortran_ieee_exceptions diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90 index 45d3cc3f02a1e..5fe57f782a815 100644 --- a/flang/module/ieee_arithmetic.f90 +++ b/flang/module/ieee_arithmetic.f90 @@ -29,6 +29,11 @@ module ieee_arithmetic ieee_support_subnormal => __builtin_ieee_support_subnormal, & ieee_support_underflow_control => __builtin_ieee_support_underflow_control + ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a USE statement + ! for IEEE_EXCEPTIONS; everything that is public in IEEE_EXCEPTIONS is public + ! in IEEE_ARITHMETIC." + use __Fortran_ieee_exceptions + implicit none type :: ieee_class_type diff --git a/flang/module/ieee_exceptions.f90 b/flang/module/ieee_exceptions.f90 index 82df89697729b..2d050412772a5 100644 --- a/flang/module/ieee_exceptions.f90 +++ b/flang/module/ieee_exceptions.f90 @@ -6,120 +6,6 @@ ! !===------------------------------------------------------------------------===! -! See Fortran 2018, clause 17 module ieee_exceptions - - type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3 - private - integer(kind=1) :: flag = 0 - end type ieee_flag_type - - type(ieee_flag_type), parameter :: & - ieee_invalid = ieee_flag_type(1), & - ieee_overflow = ieee_flag_type(2), & - ieee_divide_by_zero = ieee_flag_type(4), & - ieee_underflow = ieee_flag_type(8), & - ieee_inexact = ieee_flag_type(16), & - ieee_denorm = ieee_flag_type(32) ! PGI extension - - type(ieee_flag_type), parameter :: & - ieee_usual(*) = [ & - ieee_overflow, ieee_divide_by_zero, ieee_invalid ], & - ieee_all(*) = [ & - ieee_usual, ieee_underflow, ieee_inexact, ieee_denorm ] - - type :: ieee_modes_type ! Fortran 2018, 17.7 - private - end type ieee_modes_type - - type :: ieee_status_type ! Fortran 2018, 17.7 - private - end type ieee_status_type - - private :: ieee_support_flag_2, ieee_support_flag_3, & - ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, & - ieee_support_flag_16 - interface ieee_support_flag - module procedure :: ieee_support_flag, & - ieee_support_flag_2, ieee_support_flag_3, & - ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, & - ieee_support_flag_16 - end interface - - contains - elemental subroutine ieee_get_flag(flag, flag_value) - type(ieee_flag_type), intent(in) :: flag - logical, intent(out) :: flag_value - end subroutine ieee_get_flag - - elemental subroutine ieee_get_halting_mode(flag, halting) - type(ieee_flag_type), intent(in) :: flag - logical, intent(out) :: halting - end subroutine ieee_get_halting_mode - - subroutine ieee_get_modes(modes) - type(ieee_modes_type), intent(out) :: modes - end subroutine ieee_get_modes - - subroutine ieee_get_status(status) - type(ieee_status_type), intent(out) :: status - end subroutine ieee_get_status - - pure subroutine ieee_set_flag(flag, flag_value) - type(ieee_flag_type), intent(in) :: flag - logical, intent(in) :: flag_value - end subroutine ieee_set_flag - - pure subroutine ieee_set_halting_mode(flag, halting) - type(ieee_flag_type), intent(in) :: flag - logical, intent(in) :: halting - end subroutine ieee_set_halting_mode - - subroutine ieee_set_modes(modes) - type(ieee_modes_type), intent(in) :: modes - end subroutine ieee_set_modes - - subroutine ieee_set_status(status) - type(ieee_status_type), intent(in) :: status - end subroutine ieee_set_status - - pure logical function ieee_support_flag(flag) - type(ieee_flag_type), intent(in) :: flag - ieee_support_flag = .true. - end function - pure logical function ieee_support_flag_2(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=2), intent(in) :: x(..) - ieee_support_flag_2 = .true. - end function - pure logical function ieee_support_flag_3(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=3), intent(in) :: x(..) - ieee_support_flag_3 = .true. - end function - pure logical function ieee_support_flag_4(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=4), intent(in) :: x(..) - ieee_support_flag_4 = .true. - end function - pure logical function ieee_support_flag_8(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=8), intent(in) :: x(..) - ieee_support_flag_8 = .true. - end function - pure logical function ieee_support_flag_10(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=10), intent(in) :: x(..) - ieee_support_flag_10 = .true. - end function - pure logical function ieee_support_flag_16(flag, x) - type(ieee_flag_type), intent(in) :: flag - real(kind=16), intent(in) :: x(..) - ieee_support_flag_16 = .true. - end function - - pure logical function ieee_support_halting(flag) - type(ieee_flag_type), intent(in) :: flag - end function ieee_support_halting - + use __Fortran_ieee_exceptions end module ieee_exceptions diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index aa77676c6229f..877ebb06e4b09 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -6,6 +6,7 @@ set(LLVM_LINK_COMPONENTS set(MODULES "__fortran_builtins" + "__fortran_ieee_exceptions" "__fortran_type_info" "ieee_arithmetic" "ieee_exceptions" @@ -27,6 +28,10 @@ foreach(filename ${MODULES}) if(NOT ${filename} MATCHES "__fortran_type_info") set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod) endif() + if(${filename} MATCHES "ieee_arithmetic" OR + ${filename} MATCHES "ieee_exceptions") + set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod) + endif() endif() add_custom_command(OUTPUT ${base}.mod COMMAND ${CMAKE_COMMAND} -E make_directory ${FLANG_INTRINSIC_MODULES_DIR}