From: Dominique d'Humieres Date: Mon, 24 Mar 2014 00:29:43 +0000 (+0100) Subject: re PR fortran/60128 (Wrong ouput using en edit descriptor) X-Git-Tag: releases/gcc-4.9.0~338 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d3413e5fefcea4cb5cd4a505fada2f5ee4f02ee1;p=thirdparty%2Fgcc.git re PR fortran/60128 (Wrong ouput using en edit descriptor) 2014-03-23 Dominique d'Humieres 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 f95f4bd23c77..af54373287c2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-03-23 Dominique d'Humieres + + PR libfortran/60128 + * gfortran.dg/fmt_en.f90: Update test. XFAIL for + i?86-*-solaris2.9*. + 2014-03-22 Jakub Jelinek PR sanitizer/60613 diff --git a/gcc/testsuite/gfortran.dg/fmt_en.f90 b/gcc/testsuite/gfortran.dg/fmt_en.f90 index 75d6040d8e8f..7d9c8aa61a56 100644 --- 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 } }