gcc/testsuite/gfortran.dg/fmt_g0_5.f08

   1 ! { dg-do run }
   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
   6
   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)")
  16 contains
  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
  20
  21         nan = zero / zero
  22         pinf = one / zero
  23         minf = -one / zero
  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
  32
  33         write(s1, fmt1) r
  34         write(s2, fmt2) r
  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