From b8388bb06202fa5a007193f189d8a4dc24b98f6c Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 15 Apr 2011 16:33:07 +0000 Subject: [PATCH] re PR libfortran/48589 (Invalid G0/G0.d editing for NaN/infinity) 2011-04-15 Jerry DeLisle PR libgfortran/48589 * gfortran.dg/fmt_g0_5.f08: New test. From-SVN: r172503 --- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/fmt_g0_5.f08 | 38 ++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/fmt_g0_5.f08 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fe84eb0ee55..0cb6d3aea8f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-04-15 Jerry DeLisle + + PR libgfortran/48589 + * gfortran.dg/fmt_g0_5.f08: New test. + 2011-04-15 Richard Guenther PR testsuite/48286 diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_5.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_5.f08 new file mode 100644 index 00000000000..a7ec0f17f70 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_g0_5.f08 @@ -0,0 +1,38 @@ +! { dg-do run } +! 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 -- 2.30.2