https://gcc.gnu.org/bugzilla/show_bug.cgi?id=79540
--- Comment #10 from Dominique d'Humieres <dominiq at lps dot ens.fr> ---
Could you please post the result of
call verify_fmt(100.0)
end
! loop through values for w, d
subroutine verify_fmt(x)
real, intent(in) :: x
integer :: w, d
character(len=80) :: str, str0
integer :: len, len0, pos
do d = 0, 1
do w = 1, 3
str = fmt_w_d(x, w, d)
len = len_trim(str)
pos = verify(str(:len), "*")
if (pos == 0) call errormsg(x, str, len, w, d, "no digits")
end do
end do
end subroutine
function fmt_w_d(x, w, d)
real, intent(in) :: x
integer, intent(in) :: w, d
character(len=*) :: fmt_w_d
character(len=10) :: fmt, make_fmt
fmt = make_fmt(w, d)
write (fmt_w_d, fmt) x
end function
function make_fmt(w, d)
integer, intent(in) :: w, d
character(len=10) :: make_fmt
write (make_fmt,'("(f",i0,".",i0,")")') w, d
end function
subroutine errormsg(x, str, len, w, d, reason)
real, intent(in) :: x
character(len=80), intent(in) :: str
integer, intent(in) :: len, w, d
character(len=*), intent(in) :: reason
integer :: fmt_len
integer(1) :: slen
character(len=10) :: fmt, make_fmt
fmt = make_fmt(w, d)
fmt_len = len_trim(fmt)
slen=len
print *, "print '", fmt(:fmt_len), "', ", x, " ! => ", "len=", slen,
str(:len), ": ", reason
end subroutine
?
