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