2 ! { dg-options "-ffloat-store" }
3 ! PR48602 Invalid F conversion of G descriptor for values close to powers of 10
4 ! Test case provided by Thomas Henlich
8 integer, parameter :: RT = REAL64
10 call check_all(0.0_RT, 15, 2, 0)
11 call check_all(0.991_RT, 15, 2, 0)
12 call check_all(0.995_RT, 15, 2, 0)
13 call check_all(0.996_RT, 15, 2, 0)
14 call check_all(0.999_RT, 15, 2, 0)
16 subroutine check_all(val, w, d, e)
17 real(kind=RT), intent(in) :: val
18 integer, intent(in) :: w
19 integer, intent(in) :: d
20 integer, intent(in) :: e
22 call check_f_fmt(val, 'C', w, d, e)
23 call check_f_fmt(val, 'U', w, d, e)
24 call check_f_fmt(val, 'D', w, d, e)
25 end subroutine check_all
27 subroutine check_f_fmt(val, roundmode, w, d, e)
28 real(kind=RT), intent(in) :: val
29 character, intent(in) :: roundmode
30 integer, intent(in) :: w
31 integer, intent(in) :: d
32 integer, intent(in) :: e
33 character(len=80) :: fmt_f, fmt_g
34 character(len=80) :: s_f, s_g
35 real(kind=RT) :: mag, lower, upper
45 select case (roundmode)
55 write(fmt_f, "('R', a, ',F', i0, '.', i0, ',', i0, 'X')") roundmode, w - n, d - 1, n
58 lower = 10.0_RT ** (d - 1 - dec) - r * 10.0_RT ** (- dec - 1)
59 upper = 10.0_RT ** (d - dec) - r * 10.0_RT ** (- dec)
60 if (lower <= mag .and. mag < upper) then
61 write(fmt_f, "('R', a, ',F', i0, '.', i0, ',', i0, 'X')") roundmode, w - n, dec, n
66 if (len_trim(fmt_f) == 0) then
71 write(fmt_g, "('R', a, ',G', i0, '.', i0)") roundmode, w, d
73 write(fmt_g, "('R', a, ',G', i0, '.', i0, 'e', i0)") roundmode, w, d, e
75 write(s_g, "('''', " // trim(fmt_g) // ",'''')") val
76 write(s_f, "('''', " // trim(fmt_f) // ",'''')") val
77 if (s_g /= s_f) STOP 1
79 !print "(a,g0,a,g0)", "lower=", lower, " upper=", upper
80 ! print "(a, ' /= ', a, ' ', a, '/', a, ':', g0)", trim(s_g), trim(s_f), trim(fmt_g), trim(fmt_f), val
82 end subroutine check_f_fmt