From 58c9d7d30371db69bc6a29bf9d9d44f7334459fc Mon Sep 17 00:00:00 2001 From: burnus Date: Sat, 5 Nov 2011 20:43:44 +0000 Subject: [PATCH] 2011-11-05 Tobias Burnus * gfortran.dg/quad_2.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181015 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 12 ++++--- gcc/testsuite/gfortran.dg/quad_2.f90 | 63 ++++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/quad_2.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0d7be80..634b218 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2011-11-05 Tobias Burnus + + * gfortran.dg/quad_2.f90: New. + 2011-11-05 Eric Botcazou * gcc.dg/strlenopt-22g.c: New wrapper around... @@ -26,10 +30,10 @@ 2011-10-09 Magnus Fromreide - * 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 diff --git a/gcc/testsuite/gfortran.dg/quad_2.f90 b/gcc/testsuite/gfortran.dg/quad_2.f90 new file mode 100644 index 0000000..c1334db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/quad_2.f90 @@ -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 -- 2.7.4