re PR fortran/60128 (Wrong ouput using en edit descriptor)

2014-03-23  Dominique d'Humieres  <dominiq@lps.ens.fr>

	PR libfortran/60128
	* gfortran.dg/fmt_en.f90: Update test. XFAIL for
	i?86-*-solaris2.9*.

From-SVN: r208780

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f95f4bd23c772c2c7770e1261f1a72a4aa534bb7..af54373287c2ab760fd68a1e8cc71769c07c5b42 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-03-23  Dominique d'Humieres  <dominiq@lps.ens.fr>
+
+       PR libfortran/60128
+       * gfortran.dg/fmt_en.f90: Update test. XFAIL for
+       i?86-*-solaris2.9*.
+
 2014-03-22  Jakub Jelinek  <jakub@redhat.com>
 
        PR sanitizer/60613

diff --git a/gcc/testsuite/gfortran.dg/fmt_en.f90 b/gcc/testsuite/gfortran.dg/fmt_en.f90
index 75d6040d8e8f931a68c9171502f6292cdb3f486b..7d9c8aa61a564a70d1eeb09ae00db0b1bd3dfd1c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/fmt_en.f90
+++ b/gcc/testsuite/gfortran.dg/fmt_en.f90
@@ -2,8 +2,40 @@
 ! PR60128 Invalid outputs with EN descriptors
 ! Test case provided by Walt Brainerd.
 program pr60128
-implicit none
+use ISO_FORTRAN_ENV
+    implicit none
+    integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
+    logical :: l_skip(4) = .false.
+    integer :: i
     integer :: n_tst = 0, n_cnt = 0
+    character(len=20) :: s
+
+    open (unit = 10, file = 'fmt_en.res')
+!   Check that the default rounding mode is to nearest and to even on tie.
+    do i=1,size(real_kinds)
+      if (i == 1) then
+        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
+                                  real(9.49999905,kind=j(1)),  &
+                                  real(9.5,kind=j(1)), real(8.5,kind=j(1))
+      else if (i == 2) then
+        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
+                                  real(9.49999905,kind=j(2)),  &
+                                  real(9.5,kind=j(2)), real(8.5,kind=j(2))
+      else if (i == 3) then
+        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
+                                  real(9.49999905,kind=j(3)),  &
+                                  real(9.5,kind=j(3)), real(8.5,kind=j(3))
+      else if (i == 4) then
+        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
+                                  real(9.49999905,kind=j(4)),  &
+                                  real(9.5,kind=j(4)), real(8.5,kind=j(4))
+      end if
+      if (s /= '-9.5 9.5 10.  8.') then
+        l_skip(i) = .true.
+        print "('Unsupported rounding for real(',i0,')')", j(i)
+      end if
+    end do
+        
 
 ! Original test.
     call checkfmt("(en15.2)", -.44444,    "    -444.44E-03")
@@ -109,18 +141,18 @@ implicit none
 
     !print *, n_tst, n_cnt
     if (n_cnt /= 0) call abort
+    if (all(.not. l_skip)) write (10, *) "All kinds rounded to nearest"
+    close (10)
 
 contains
     subroutine checkfmt(fmt, x, cmp)
-        use ISO_FORTRAN_ENV
         implicit none
-        integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
         integer :: i
         character(len=*), intent(in) :: fmt
         real, intent(in) :: x
         character(len=*), intent(in) :: cmp
-        character(len=20) :: s
         do i=1,size(real_kinds)
+          if (l_skip(i)) cycle
           if (i == 1) then
             write(s, fmt) real(x,kind=j(1))
           else if (i == 2) then
@@ -139,3 +171,5 @@ contains
         
     end subroutine
 end program
+! { dg-final { scan-file fmt_en.res "All kinds rounded to nearest" { xfail i?86-*-solaris2.9* } } }
+! { dg-final { cleanup-saved-temps } }