[AArch64] Merge stores of D-register values with different modes
[official-gcc.git] / gcc / testsuite / gfortran.dg / fmt_g0_6.f08
blob89907434a996b696ea6e9e2818f2157fc5c615ff
1 ! { dg-do run }
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
5 program test_g0fr
6     use iso_fortran_env
7     implicit none
8     integer, parameter :: RT = REAL64
9     
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)
15 contains
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
26     
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
36         real(kind=RT) :: r
37         integer :: n, dec
39         mag = abs(val)
40         if (e == 0) then
41             n = 4
42         else
43             n = e + 2
44         end if
45         select case (roundmode)
46             case('U')
47                 r = 1.0_RT
48             case('D')
49                 r = 0.0_RT
50             case('C')
51                 r = 0.5_RT
52         end select
54         if (mag == 0) then
55             write(fmt_f, "('R', a, ',F', i0, '.', i0, ',', i0, 'X')") roundmode, w - n, d - 1, n
56         else
57             do dec = d, 0, -1
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
62                     exit
63                 end if
64             end do
65         end if
66         if (len_trim(fmt_f) == 0) then
67             ! e editing
68             return
69         end if
70         if (e == 0) then
71             write(fmt_g, "('R', a, ',G', i0, '.', i0)") roundmode, w, d
72         else
73             write(fmt_g, "('R', a, ',G', i0, '.', i0, 'e', i0)") roundmode, w, d, e
74         end if
75         write(s_g, "('''', " // trim(fmt_g) // ",'''')") val
76         write(s_f, "('''', " // trim(fmt_f) // ",'''')") val
77         if (s_g /= s_f) STOP 1
78         !if (s_g /= s_f) then
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
81         !end if
82     end subroutine check_f_fmt
83 end program test_g0fr