Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/fmt_g0_5.f08 @ 118:fd00160c1b76
ifdef TARGET_64BIT
author | mir3636 |
---|---|
date | Tue, 27 Feb 2018 15:01:35 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! { dg-do run } ! { dg-add-options ieee } ! PR48589 Invalid G0/G0.d editing for NaN/infinity ! Test case by Thomas Henlich program test_g0_special call check_all("(g10.3)", "(f10.3)") call check_all("(g10.3e3)", "(f10.3)") call check_all("(spg10.3)", "(spf10.3)") call check_all("(spg10.3e3)", "(spf10.3)") !print *, "-----------------------------------" call check_all("(g0)", "(f0.0)") call check_all("(g0.15)", "(f0.0)") call check_all("(spg0)", "(spf0.0)") call check_all("(spg0.15)", "(spf0.0)") contains subroutine check_all(fmt1, fmt2) character(len=*), intent(in) :: fmt1, fmt2 real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf nan = zero / zero pinf = one / zero minf = -one / zero call check_equal(fmt1, fmt2, nan) call check_equal(fmt1, fmt2, pinf) call check_equal(fmt1, fmt2, minf) end subroutine check_all subroutine check_equal(fmt1, fmt2, r) real(8), intent(in) :: r character(len=*), intent(in) :: fmt1, fmt2 character(len=80) :: s1, s2 write(s1, fmt1) r write(s2, fmt2) r if (s1 /= s2) call abort !if (s1 /= s2) print "(6a)", trim(fmt1), ": '", trim(s1), "' /= '", trim(s2), "'" !print "(6a)", trim(fmt1), ": '", trim(s1), "' /= '", trim(s2), "'" end subroutine check_equal end program test_g0_special