re PR libfortran/48488 (Wrong default format for real numbers)

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

	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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 16666ce..e7153e5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,22 @@
+2011-04-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       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  <davidxl@google.com>
 
        * 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 5b1b285..f02cc1a 100644 (file)
--- 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  <jvdelisle@gcc.gnu.org>
 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 0743212..cbf0f7f 100644 (file)
--- 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 2289b6c..0aecb2f 100644 (file)
--- 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 b816ded..c064e0c 100644 (file)
--- 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 41de3f0..1062c2f 100644 (file)
--- 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, <jvdelisle@gcc.gnu.org>
       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,
@@ -21,13 +22,12 @@
      .            "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 55b094a..cb73492 100644 (file)
--- 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 2e7fc18..ead6f81 100644 (file)
--- 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 <jvdelisle@gcc.gnu.org>
     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 6ef8ca4..7efbe70 100644 (file)
--- 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 abc8aec..2e5de83 100644 (file)
--- 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 9f3f5d8..e4b5de7 100644 (file)
--- 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 (file)
index 0000000..ec02bc9
--- /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