[Bug fortran/64104] New: [F2003][IEEE] Allow IEEE functions in specification expressions

[fxcoudert at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64104

            Bug ID: 64104
           Summary: [F2003][IEEE] Allow IEEE functions in specification
                    expressions
           Product: gcc
           Version: 5.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: fxcoudert at gcc dot gnu.org

Reported by James Van Buskirk on comp.lang.fortran:

Have you tested whether gfortran accepts IEEE functions syntactically?
The following should be OK I think, but gfortran shows a lot of errors.

module funcs
   use IEEE_ARITHMETIC
   use IEEE_EXCEPTIONS
   implicit none
   integer, parameter :: ep = selected_real_kind(18,4931)
   integer, parameter :: ik4 = selected_int_kind(9)
   integer, parameter :: ik8 = selected_int_kind(18)
   contains
      subroutine test_specification(x)
         real(ep) x
         integer src(IEEE_SELECTED_REAL_KIND())
         integer datatype(merge(1,2,IEEE_SUPPORT_DATATYPE(x)))
         integer denormal(merge(1,2,IEEE_SUPPORT_DENORMAL(x)))
         integer divide(merge(1,2,IEEE_SUPPORT_DIVIDE(x)))
         integer inf(merge(1,2,IEEE_SUPPORT_INF(x)))
         integer io(merge(1,2,IEEE_SUPPORT_IO(x)))
         integer nan(merge(1,2,IEEE_SUPPORT_NAN(x)))
         integer rounding(merge(1,2,IEEE_SUPPORT_ROUNDING(IEEE_TO_ZERO,x)))
         integer sqrt(merge(1,2,IEEE_SUPPORT_SQRT(x)))
         integer standard(merge(1,2,IEEE_SUPPORT_STANDARD(x)))
         integer 
underflow_control(merge(1,2,IEEE_SUPPORT_UNDERFLOW_CONTROL(x)))
         integer flag(merge(1,2,IEEE_SUPPORT_FLAG(IEEE_INEXACT,x)))
         integer halting(merge(1,2,IEEE_SUPPORT_HALTING(IEEE_INEXACT)))
         src = 1
         write(*,*) 'src',size(src), src
         datatype = 1
         write(*,*) 'datatype',size(datatype),datatype
         denormal = 1
         write(*,*) 'denormal',size(denormal),denormal
         divide = 1
         write(*,*) 'divide',size(divide),divide
         inf = 1
         write(*,*) 'inf',size(inf),inf
         io = 1
         write(*,*) 'io',size(io),io
         nan = 1
         write(*,*) 'nan',size(nan),nan
         rounding = 1
         write(*,*) 'rounding',size(rounding),rounding
         sqrt = 1
         write(*,*) 'sqrt',size(sqrt),sqrt
         standard = 1
         write(*,*) 'standard',size(standard),standard
         underflow_control = 1
         write(*,*) 
'underflow_control',size(underflow_control),underflow_control
         flag = 1
         write(*,*) 'flag',size(flag),flag
         halting = 1
         write(*,*) 'halting',size(halting),halting
      end subroutine test_specification
      subroutine test_constant(x)
         real(ep) x
         real(IEEE_SELECTED_REAL_KIND()) src
         integer(merge(ik4,ik8,IEEE_SUPPORT_DATATYPE(x))) datatype
         integer(merge(ik4,ik8,IEEE_SUPPORT_DENORMAL(x))) denormal
         integer(merge(ik4,ik8,IEEE_SUPPORT_DIVIDE(x))) divide
         integer(merge(ik4,ik8,IEEE_SUPPORT_INF(x))) inf
         integer(merge(ik4,ik8,IEEE_SUPPORT_IO(x))) io
         integer(merge(ik4,ik8,IEEE_SUPPORT_NAN(x))) nan
         integer(merge(ik4,ik8,IEEE_SUPPORT_ROUNDING(IEEE_TO_ZERO,x))) 
rounding
         integer(merge(ik4,ik8,IEEE_SUPPORT_SQRT(x))) sqrt
         integer(merge(ik4,ik8,IEEE_SUPPORT_STANDARD(x))) standard
         integer(merge(ik4,ik8,IEEE_SUPPORT_UNDERFLOW_CONTROL(x))) 
underflow_control
         integer(merge(ik4,ik8,IEEE_SUPPORT_FLAG(IEEE_INEXACT,x))) flag
         integer(merge(ik4,ik8,IEEE_SUPPORT_HALTING(IEEE_INEXACT))) halting
         src = 1
         write(*,*) 'src',kind(src), src
         datatype = 1
         write(*,*) 'datatype',kind(datatype),datatype
         denormal = 1
         write(*,*) 'denormal',kind(denormal),denormal
         divide = 1
         write(*,*) 'divide',kind(divide),divide
         inf = 1
         write(*,*) 'inf',kind(inf),inf
         io = 1
         write(*,*) 'io',kind(io),io
         nan = 1
         write(*,*) 'nan',kind(nan),nan
         rounding = 1
         write(*,*) 'rounding',kind(rounding),rounding
         sqrt = 1
         write(*,*) 'sqrt',kind(sqrt),sqrt
         standard = 1
         write(*,*) 'standard',kind(standard),standard
         underflow_control = 1
         write(*,*) 
'underflow_control',kind(underflow_control),underflow_control
         flag = 1
         write(*,*) 'flag',kind(flag),flag
         halting = 1
         write(*,*) 'halting',kind(halting),halting
      end subroutine test_constant
end module funcs

program ieee
   use funcs
   implicit none
   real(ep) x
   call test_specification(x)
   call test_constant(x)
end program ieee