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
This commit is contained in:
Jerry DeLisle
parent
45a2c4774f
commit
f4c31037a2
12 changed files with 151 additions and 57 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
75
gcc/testsuite/gfortran.dg/round_3.f08
Normal file
75
gcc/testsuite/gfortran.dg/round_3.f08
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue