From f4c31037a235659024062506d8e07640a7165662 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 29 Apr 2011 15:08:57 +0000 Subject: [PATCH] re PR libfortran/48488 (Wrong default format for real numbers) 2011-04-29 Jerry DeLisle PR libgfortran/48488 PR libgfortran/48602 PR libgfortran/48615 PR libgfortran/48684 PR libgfortran/48787 * gfortran.dg/fmt_g.f: Adjust test. * gfortran.dg/fmt_g0_1.f08: Adjust test. * gfortran.dg/round_3.f08: New test. * gfortran.dg/namelist_print_1.f: Adjust test. * gfortran.dg/char4_iunit_1.f03: Adjust test. * gfortran.dg/f2003_io_5.f03: Adjust test. * gfortran.dg/coarray_15.f90: Adjust test. * gfortran.dg/namelist_65.f90: Adjust test. * gfortran.dg/fmt_cache_1.f: Adjust test. * gfortran.dg/char4_iunit_2.f03: Adjust test. * gfortran.dg/real_const_3.f90: Adjust test. From-SVN: r173168 --- gcc/testsuite/ChangeLog | 19 +++++ gcc/testsuite/gfortran.dg/char4_iunit_1.f03 | 10 +-- gcc/testsuite/gfortran.dg/char4_iunit_2.f03 | 2 +- gcc/testsuite/gfortran.dg/coarray_15.f90 | 44 ++++++------ gcc/testsuite/gfortran.dg/f2003_io_5.f03 | 6 +- gcc/testsuite/gfortran.dg/fmt_cache_1.f | 12 ++-- gcc/testsuite/gfortran.dg/fmt_g.f | 8 +-- gcc/testsuite/gfortran.dg/fmt_g0_1.f08 | 16 ++--- gcc/testsuite/gfortran.dg/namelist_65.f90 | 6 +- gcc/testsuite/gfortran.dg/namelist_print_1.f | 2 +- gcc/testsuite/gfortran.dg/real_const_3.f90 | 8 +-- gcc/testsuite/gfortran.dg/round_3.f08 | 75 ++++++++++++++++++++ 12 files changed, 151 insertions(+), 57 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/round_3.f08 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 16666cefd7c..e7153e59f9a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,22 @@ +2011-04-29 Jerry DeLisle + + PR libgfortran/48488 + PR libgfortran/48602 + PR libgfortran/48615 + PR libgfortran/48684 + PR libgfortran/48787 + * gfortran.dg/fmt_g.f: Adjust test. + * gfortran.dg/fmt_g0_1.f08: Adjust test. + * gfortran.dg/round_3.f08: New test. + * gfortran.dg/namelist_print_1.f: Adjust test. + * gfortran.dg/char4_iunit_1.f03: Adjust test. + * gfortran.dg/f2003_io_5.f03: Adjust test. + * gfortran.dg/coarray_15.f90: Adjust test. + * gfortran.dg/namelist_65.f90: Adjust test. + * gfortran.dg/fmt_cache_1.f: Adjust test. + * gfortran.dg/char4_iunit_2.f03: Adjust test. + * gfortran.dg/real_const_3.f90: Adjust test. + 2011-04-28 Xinliang David Li * testsuite/gcc.dg/tree-prof/prof-robust-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 index 5b1b285adf2..f02cc1a7b5b 100644 --- a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 +++ b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 @@ -5,7 +5,7 @@ ! Test case prepared by Jerry DeLisle program char4_iunit_1 implicit none - character(kind=4,len=42) :: string + character(kind=4,len=44) :: string integer(kind=4) :: i,j real(kind=4) :: inf, nan, large @@ -24,11 +24,11 @@ program char4_iunit_1 write(string, *) .true., .false. , .true. if (string .ne. 4_" T F T ") call abort write(string, *) 1.2345e-06, 4.2846e+10_8 - if (string .ne. 4_" 1.23450002E-06 42846000000.000000 ") call abort + if (string .ne. 4_" 1.23450002E-06 42846000000.000000 ") call abort write(string, *) nan, inf - if (string .ne. 4_" NaN Infinity ") call abort + if (string .ne. 4_" NaN Infinity ") call abort write(string, '(10x,f3.1,3x,f9.1)') nan, inf - if (string .ne. 4_" NaN Infinity ") call abort + if (string .ne. 4_" NaN Infinity ") call abort write(string, *) (1.2, 3.4 ) - if (string .ne. 4_" ( 1.2000000 , 3.4000001 ) ") call abort + if (string .ne. 4_" ( 1.20000005 , 3.40000010 ) ") call abort end program char4_iunit_1 diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 index 074321274ca..cbf0f7fbd3d 100644 --- a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 +++ b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 @@ -43,5 +43,5 @@ program char4_iunit_2 write(widestring,*)"test",i, x, str_default,& trim(str_char4) if (widestring .ne. & - k_" test 345 52.542999 0 hijklmnp qwertyuiopasd") call abort + k_" test 345 52.5429993 0 hijklmnp qwertyuiopasd") call abort end program char4_iunit_2 diff --git a/gcc/testsuite/gfortran.dg/coarray_15.f90 b/gcc/testsuite/gfortran.dg/coarray_15.f90 index 2289b6c9197..0aecb2f4e11 100644 --- a/gcc/testsuite/gfortran.dg/coarray_15.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_15.f90 @@ -9,7 +9,7 @@ program ex2 implicit none real, allocatable :: z(:)[:] integer :: image - character(len=80) :: str + character(len=128) :: str allocate(z(3)[*]) write(*,*) 'z allocated on image',this_image() @@ -25,18 +25,18 @@ program ex2 str = repeat('X', len(str)) write(str,*) 'z=',z(:),' on image',this_image() - if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") & - call abort () + if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") & + call abort str = repeat('X', len(str)) write(str,*) 'z=',z,' on image',this_image() - if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") & - call abort () + if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") & + call abort str = repeat('X', len(str)) write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image() - if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") & - call abort () + if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") & + call abort call ex2a() call ex5() @@ -46,7 +46,7 @@ subroutine ex2a() implicit none real, allocatable :: z(:,:)[:,:] integer :: image - character(len=100) :: str + character(len=128) :: str allocate(z(2,2)[1,*]) write(*,*) 'z allocated on image',this_image() @@ -62,38 +62,38 @@ subroutine ex2a() str = repeat('X', len(str)) write(str,*) 'z=',z(:,:),' on image',this_image() - if (str /= " z= 1.2000000 1.2000000 1.2000000 1.2000000 on image 1") & - call abort () + if (str /= " z= 1.20000005 1.20000005 1.20000005 1.20000005 on image 1") & + call abort str = repeat('X', len(str)) write(str,*) 'z=',z,' on image',this_image() - if (str /= " z= 1.2000000 1.2000000 1.2000000 1.2000000 on image 1") & - call abort () + if (str /= " z= 1.20000005 1.20000005 1.20000005 1.20000005 on image 1") & + call abort end subroutine ex2a subroutine ex5 implicit none integer :: me real, save :: w(4)[*] - character(len=100) :: str + character(len=128) :: str me = this_image() w = me str = repeat('X', len(str)) write(str,*) 'In main on image',this_image(), 'w= ',w - if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") & - call abort () + if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") & + call abort str = repeat('X', len(str)) write(str,*) 'In main on image',this_image(), 'w= ',w(1:4) - if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") & - call abort () + if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") & + call abort str = repeat('X', len(str)) write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1] - if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") & - call abort () + if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") & + call abort sync all call ex5_sub(me,w) @@ -103,10 +103,10 @@ subroutine ex5_sub(n,w) implicit none integer :: n real :: w(n) - character(len=50) :: str + character(len=75) :: str str = repeat('X', len(str)) write(str,*) 'In sub on image',this_image(), 'w= ',w - if (str /= " In sub on image 1 w= 1.0000000") & - call abort () + if (str /= " In sub on image 1 w= 1.00000000") & + call abort end subroutine ex5_sub diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 index b816ded69c5..c064e0cf3c1 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 @@ -5,7 +5,7 @@ integer :: i real :: a(10) = [ (i*1.3, i=1,10) ] real :: b(10) complex :: c -character(34) :: complex +character(36) :: complex namelist /nm/ a open(99,file="mynml",form="formatted",decimal="point",status="replace") @@ -18,9 +18,9 @@ close(99, status="delete") c = (3.123,4.456) write(complex,*,decimal="comma") c -if (complex.ne." ( 3,1229999 ; 4,4559999 )") call abort +if (complex.ne." ( 3,12299991 ; 4,45599985 )") call abort c = (0.0, 0.0) read(complex,*,decimal="comma") c -if (complex.ne." ( 3,1229999 ; 4,4559999 )") call abort +if (complex.ne." ( 3,12299991 ; 4,45599985 )") call abort end diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_1.f b/gcc/testsuite/gfortran.dg/fmt_cache_1.f index 41de3f0d705..1062c2f059b 100644 --- a/gcc/testsuite/gfortran.dg/fmt_cache_1.f +++ b/gcc/testsuite/gfortran.dg/fmt_cache_1.f @@ -3,9 +3,10 @@ ! pr40330 incorrect io. ! test case derived from pr40662, program astap - character(40) teststring - arlxca = 0.0 - open(10, status="scratch") + implicit none + character(34) :: teststring + real(4) :: arlxca = 0.0 + open(10) write(10,40) arlxca write(10,40) arlxca 40 format(t4,"arlxca = ",1pg13.6,t27,"arlxcc = ",g13.6,t53, @@ -20,14 +21,13 @@ . t4,"dtmpcc = ",g13.6,t27,"ebalna = ",g13.6,t53, . "ebalnc = ",g13.6,t79,"ebalsa = ",g13.6,t105, . "ebalsc = ",g13.6) - rewind 10 rewind 10 teststring = "" read(10,'(a)') teststring - if (teststring.ne." arlxca = 0.00000 arlxcc = ")call abort + if (teststring.ne." arlxca = 0.00000 arlxcc =")call abort teststring = "" read(10,'(a)') teststring - if (teststring.ne." arlxca = 0.00000 arlxcc = ")call abort + if (teststring.ne." arlxca = 0.00000 arlxcc =")call abort end program astap diff --git a/gcc/testsuite/gfortran.dg/fmt_g.f b/gcc/testsuite/gfortran.dg/fmt_g.f index 55b094ae07e..cb73492829e 100644 --- a/gcc/testsuite/gfortran.dg/fmt_g.f +++ b/gcc/testsuite/gfortran.dg/fmt_g.f @@ -31,13 +31,13 @@ WRITE(buffer,"(G12.5E5,'<')") -10000. if (buffer.ne."************<") call abort WRITE(buffer,"(G13.5E5,'<')") -10000. - if (buffer.ne."-10000. <") call abort + if (buffer.ne."*************<") call abort WRITE(buffer,"(G14.5E5,'<')") -10000. - if (buffer.ne." -10000. <") call abort + if (buffer.ne."-10000. <") call abort WRITE(buffer,"(G15.5E5,'<')") -10000. - if (buffer.ne." -10000. <") call abort + if (buffer.ne." -10000. <") call abort WRITE(buffer,"(G16.5E5,'<')") -10000. - if (buffer.ne." -10000. <") call abort + if (buffer.ne." -10000. <") call abort STOP END diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 index 2e7fc1877a4..ead6f81b28a 100644 --- a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 +++ b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 @@ -2,19 +2,19 @@ ! PR36420 Fortran 2008: g0 edit descriptor ! Test case provided by Jerry DeLisle character(25) :: string = "(g0,g0,g0)" - character(33) :: buffer + character(50) :: buffer write(buffer, '(g0,g0,g0)') ':',12340,':' if (buffer.ne.":12340:") call abort write(buffer, string) ':',0,':' if (buffer.ne.":0:") call abort - write(buffer, string) ':',1.0/3.0,':' - if (buffer.ne.":.33333334:") call abort - write(buffer, '(1x,a,g0,a)') ':',1.0/3.0,':' - if (buffer.ne." :.33333334:") call abort + write(buffer, string) ':',1.0_8/3.0_8,':' + if (buffer.ne.":.33333333333333331:") call abort + write(buffer, '(1x,a,g0,a)') ':',1.0_8/3.0_8,':' + if (buffer.ne." :.33333333333333331:") call abort write(buffer, string) ':',"hello",':' - if (buffer.ne.":hello:") call abort + if (buffer.ne.":hello:") call abort write(buffer, "(g0,g0,g0,g0)") ':',.true.,.false.,':' if (buffer.ne.":TF:") call abort - write(buffer, "(g0,g0,',',g0,g0)") '(',( 1.2345, 2.4567 ),')' - if (buffer.ne."(1.2345001,2.4567001)") call abort + write(buffer, "(g0,g0,',',g0,g0)") '(',( 1.2345_8, 2.4567_8 ),')' + if (buffer.ne."(1.2344999999999999,2.4567000000000001)") call abort end diff --git a/gcc/testsuite/gfortran.dg/namelist_65.f90 b/gcc/testsuite/gfortran.dg/namelist_65.f90 index 6ef8ca493a5..7efbe7083a3 100644 --- a/gcc/testsuite/gfortran.dg/namelist_65.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_65.f90 @@ -14,9 +14,9 @@ enddo write(out,nl1) if (out(1).ne."&NL1") call abort -if (out(2).ne." A= 1.0000000 ,") call abort -if (out(3).ne." B= 2.0000000 ,") call abort -if (out(4).ne." C= 3.0000000 ,") call abort +if (out(2).ne." A= 1.00000000 ,") call abort +if (out(3).ne." B= 2.00000000 ,") call abort +if (out(4).ne." C= 3.00000000 ,") call abort if (out(5).ne." /") call abort end program oneline diff --git a/gcc/testsuite/gfortran.dg/namelist_print_1.f b/gcc/testsuite/gfortran.dg/namelist_print_1.f index abc8aec6cdc..2e5de8305b8 100644 --- a/gcc/testsuite/gfortran.dg/namelist_print_1.f +++ b/gcc/testsuite/gfortran.dg/namelist_print_1.f @@ -9,5 +9,5 @@ namelist /mynml/ x x = 1 ! ( dg-output "^" } - print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.0000000 ,(\n|\r\n|\r) /(\n|\r\n|\r)" } + print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.00000000 ,(\n|\r\n|\r) /(\n|\r\n|\r)" } end diff --git a/gcc/testsuite/gfortran.dg/real_const_3.f90 b/gcc/testsuite/gfortran.dg/real_const_3.f90 index 9f3f5d837d7..e4b5de7e46e 100644 --- a/gcc/testsuite/gfortran.dg/real_const_3.f90 +++ b/gcc/testsuite/gfortran.dg/real_const_3.f90 @@ -42,15 +42,15 @@ program main if (trim(adjustl(str)) .ne. 'NaN') call abort write(str,*) z - if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort + if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort write(str,*) z2 - if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort + if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort write(str,*) z3 - if (trim(adjustl(str)) .ne. '( Infinity, -Infinity)') call abort + if (trim(adjustl(str)) .ne. '( Infinity, -Infinity)') call abort write(str,*) z4 - if (trim(adjustl(str)) .ne. '( 0.0000000 , -0.0000000 )') call abort + if (trim(adjustl(str)) .ne. '( 0.00000000 , -0.00000000 )') call abort end program main diff --git a/gcc/testsuite/gfortran.dg/round_3.f08 b/gcc/testsuite/gfortran.dg/round_3.f08 new file mode 100644 index 00000000000..ec02bc93129 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/round_3.f08 @@ -0,0 +1,75 @@ +! { dg-do run } +! PR48615 Invalid UP/DOWN rounding with E and ES descriptors +! Test case provided by Thomas Henlich. +program pr48615 + call checkfmt("(RU,F17.0)", 2.5, " 3.") + call checkfmt("(RU,-1P,F17.1)", 2.5, " 0.3") + call checkfmt("(RU,E17.1)", 2.5, " 0.3E+01") ! 0.2E+01 + call checkfmt("(RU,1P,E17.0)", 2.5, " 3.E+00") + call checkfmt("(RU,ES17.0)", 2.5, " 3.E+00") ! 2.E+00 + call checkfmt("(RU,EN17.0)", 2.5, " 3.E+00") + + call checkfmt("(RD,F17.0)", 2.5, " 2.") + call checkfmt("(RD,-1P,F17.1)", 2.5, " 0.2") + call checkfmt("(RD,E17.1)", 2.5, " 0.2E+01") + call checkfmt("(RD,1P,E17.0)", 2.5, " 2.E+00") + call checkfmt("(RD,ES17.0)", 2.5, " 2.E+00") + call checkfmt("(RD,EN17.0)", 2.5, " 2.E+00") + + call checkfmt("(RC,F17.0)", 2.5, " 3.") + call checkfmt("(RC,-1P,F17.1)", 2.5, " 0.3") + call checkfmt("(RC,E17.1)", 2.5, " 0.3E+01") ! 0.2E+01 + call checkfmt("(RC,1P,E17.0)", 2.5, " 3.E+00") + call checkfmt("(RC,ES17.0)", 2.5, " 3.E+00") ! 2.E+00 + call checkfmt("(RC,EN17.0)", 2.5, " 3.E+00") + + call checkfmt("(RN,F17.0)", 2.5, " 2.") + call checkfmt("(RN,-1P,F17.1)", 2.5, " 0.2") + call checkfmt("(RN,E17.1)", 2.5, " 0.2E+01") + call checkfmt("(RN,1P,E17.0)", 2.5, " 2.E+00") + call checkfmt("(RN,ES17.0)", 2.5, " 2.E+00") + call checkfmt("(RN,EN17.0)", 2.5, " 2.E+00") + + call checkfmt("(RZ,F17.0)", 2.5, " 2.") + call checkfmt("(RZ,-1P,F17.1)", 2.5, " 0.2") + call checkfmt("(RZ,E17.1)", 2.5, " 0.2E+01") + call checkfmt("(RZ,1P,E17.0)", 2.5, " 2.E+00") + call checkfmt("(RZ,ES17.0)", 2.5, " 2.E+00") + call checkfmt("(RZ,EN17.0)", 2.5, " 2.E+00") + + call checkfmt("(RZ,F17.0)", -2.5, " -2.") + call checkfmt("(RZ,-1P,F17.1)", -2.5, " -0.2") + call checkfmt("(RZ,E17.1)", -2.5, " -0.2E+01") + call checkfmt("(RZ,1P,E17.0)", -2.5, " -2.E+00") + call checkfmt("(RZ,ES17.0)", -2.5, " -2.E+00") + call checkfmt("(RZ,EN17.0)", -2.5, " -2.E+00") + + call checkfmt("(RN,F17.0)", -2.5, " -2.") + call checkfmt("(RN,-1P,F17.1)", -2.5, " -0.2") + call checkfmt("(RN,E17.1)", -2.5, " -0.2E+01") + call checkfmt("(RN,1P,E17.0)", -2.5, " -2.E+00") + call checkfmt("(RN,ES17.0)", -2.5, " -2.E+00") + call checkfmt("(RN,EN17.0)", -2.5, " -2.E+00") + + call checkfmt("(RC,F17.0)", -2.5, " -3.") + call checkfmt("(RC,-1P,F17.1)", -2.5, " -0.3") + call checkfmt("(RC,E17.1)", -2.5, " -0.3E+01") ! -0.2E+01 + call checkfmt("(RC,1P,E17.0)", -2.5, " -3.E+00") + call checkfmt("(RC,ES17.0)", -2.5, " -3.E+00") ! -2.E+00 + call checkfmt("(RC,EN17.0)", -2.5, " -3.E+00") + + call checkfmt("(RU,E17.1)", nearest(2.0, 1.0), " 0.3E+01") ! 0.2E+01 + call checkfmt("(RD,E17.1)", nearest(3.0, -1.0), " 0.2E+01") ! 0.3E+01 + +contains + subroutine checkfmt(fmt, x, cmp) + character(len=*), intent(in) :: fmt + real, intent(in) :: x + character(len=*), intent(in) :: cmp + character(len=40) :: s + + write(s, fmt) x + if (s /= cmp) call abort + !if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp + end subroutine +end program -- 2.30.2