re PR libfortran/48589 (Invalid G0/G0.d editing for NaN/infinity)

2011-04-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/48589
	* gfortran.dg/fmt_g0_5.f08: New test.

From-SVN: r172503

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fe84eb0ee558b6b313de27ce318d6f6ffbe13e4f..0cb6d3aea8f10c736f7f357f5247d566cdfd9d16 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-04-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/48589
+       * gfortran.dg/fmt_g0_5.f08: New test.
+
 2011-04-15  Richard Guenther  <rguenther@suse.de>
 
        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 (file)
index 0000000..a7ec0f1
--- /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