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
