2 ! { dg-add-options ieee }
3 ! PR48589 Invalid G0/G0.d editing for NaN/infinity
4 ! Test case by Thomas Henlich
5 program test_g0_special
7 call check_all("(g10.3)", "(f10.3)")
8 call check_all("(g10.3e3)", "(f10.3)")
9 call check_all("(spg10.3)", "(spf10.3)")
10 call check_all("(spg10.3e3)", "(spf10.3)")
11 !print *, "-----------------------------------"
12 call check_all("(g0)", "(f0.0)")
13 call check_all("(g0.15)", "(f0.0)")
14 call check_all("(spg0)", "(spf0.0)")
15 call check_all("(spg0.15)", "(spf0.0)")
17 subroutine check_all(fmt1, fmt2)
18 character(len=*), intent(in) :: fmt1, fmt2
19 real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf
24 call check_equal(fmt1, fmt2, nan)
25 call check_equal(fmt1, fmt2, pinf)
26 call check_equal(fmt1, fmt2, minf)
27 end subroutine check_all
28 subroutine check_equal(fmt1, fmt2, r)
29 real(8), intent(in) :: r
30 character(len=*), intent(in) :: fmt1, fmt2
31 character(len=80) :: s1, s2
35 if (s1 /= s2) call abort
36 !if (s1 /= s2) print "(6a)", trim(fmt1), ": '", trim(s1), "' /= '", trim(s2), "'"
37 !print "(6a)", trim(fmt1), ": '", trim(s1), "' /= '", trim(s2), "'"
38 end subroutine check_equal
39 end program test_g0_special