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

        * gfortran.dg/quad_2.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181015 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0d7be80..634b218 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 

diff --git a/gcc/testsuite/gfortran.dg/quad_2.f90 b/gcc/testsuite/gfortran.dg/quad_2.f90
new file mode 100644 (file)
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