mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:20:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

quad_2.f90: New.

Browse Source 
2011-11-05  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/quad_2.f90: New.

From-SVN: r181015
This commit is contained in:
Tobias Burnus 2011-11-05 21:43:44 +01:00
parent 5619e52cfb
commit 12ca92d4f0
2 changed files with 71 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2011-11-05 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/quad_2.f90: New.
2011-11-05 Eric Botcazou <ebotcazou@adacore.com>
* gcc.dg/strlenopt-22g.c: New wrapper around...
@ -26,10 +30,10 @@
2011-10-09 Magnus Fromreide <magfr@lysator.liu.se>
* g++.dg/cpp0x/enum21a.C: Test that enum x { y, } does
generate a pedwarn in c++98-mode.
* g++.dg/cpp0x/enum21b.C: Test that enum x { y, }
don't generate a pedwarn in c++0x-mode.
* g++.dg/cpp0x/enum21a.C: Test that enum x { y, } does
generate a pedwarn in c++98-mode.
* g++.dg/cpp0x/enum21b.C: Test that enum x { y, }
don't generate a pedwarn in c++0x-mode.
2011-11-04 Olivier Goffart <olivier@woboq.com>

63
gcc/testsuite/gfortran.dg/quad_2.f90 Normal file
View File

@ -0,0 +1,63 @@
! { dg-do run }
!
! This test checks whether the largest possible
! floating-point number works.
!
! This is a run-time check. Depending on the architecture,
! this tests REAL(8), REAL(10) or REAL(16) and REAL(16)
! might be a hardware or libquadmath 128bit number.
!
program test_qp
use iso_fortran_env, only: real_kinds
implicit none
integer, parameter :: QP = real_kinds(ubound(real_kinds,dim=1))
real(qp) :: fp1, fp2, fp3, fp4
character(len=80) :: str1, str2, str3, str4
fp1 = 1
fp2 = sqrt (2.0_qp)
write (str1,*) fp1
write (str2,'(g0)') fp1
write (str3,*) fp2
write (str4,'(g0)') fp2
! print '(3a)', '>',trim(str1),'<'
! print '(3a)', '>',trim(str2),'<'
! print '(3a)', '>',trim(str3),'<'
! print '(3a)', '>',trim(str4),'<'
read (str1, *) fp3
if (fp1 /= fp3) call abort()
read (str2, *) fp3
if (fp1 /= fp3) call abort()
read (str3, *) fp4
if (fp2 /= fp4) call abort()
read (str4, *) fp4
if (fp2 /= fp4) call abort()
select case (qp)
case (8)
if (str1 /= " 1.0000000000000000") call abort()
if (str2 /= "1.0000000000000000") call abort()
if (str3 /= " 1.4142135623730951") call abort()
if (str4 /= "1.4142135623730951") call abort()
case (10)
if (str1 /= " 1.00000000000000000000") call abort()
if (str2 /= "1.00000000000000000000") call abort()
if (str3 /= " 1.41421356237309504876") call abort()
if (str4 /= "1.41421356237309504876") call abort()
case (16)
if (str1 /= " 1.00000000000000000000000000000000000") call abort()
if (str2 /= "1.00000000000000000000000000000000000") call abort()
if (str3 /= " 1.41421356237309504880168872420969798") call abort()
if (str4 /= "1.41421356237309504880168872420969798") call abort()
block
real(qp), volatile :: fp2a
fp2a = 2.0_qp
fp2a = sqrt (fp2a)
if (abs (fp2a - fp2) > sqrt(2.0_qp)-nearest(sqrt(2.0_qp),-1.0_qp)) call abort()
end block
case default
call abort()
end select
end program test_qp