Motivated by the report at
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/6373a2dfe64f0b83
There is currently no run-test check that libquadmath actually works.
The attached and committed (Rev. 181015) adds one which tests for
libquadmath that I/O read/write works. Additionally, it checks that the
result for sqrt(2.0) is OK.
The test uses the largest available floating-point number - be it 8, 10
or 16 - and tests for that. The checks should be thus OK for any system.
Regarding the issue mentioned in the linked report: Kai could reproduce
the issue - he also gets "0.0" under MinGW64 with the current trunk.
(The report was for MinGW32 4.7.0 and allegedly it worked for 4.6.2.)
Tobias
Index: gcc/testsuite/gfortran.dg/quad_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/quad_2.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/quad_2.f90 (Revision 0)
@@ -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
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 181014)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,7 @@
+2011-11-05 Tobias Burnus <bur...@net-b.de>
+
+ * gfortran.dg/quad_2.f90: New.
+
2011-11-05 Eric Botcazou <ebotca...@adacore.com>
* gcc.dg/strlenopt-22g.c: New wrapper around...
@@ -26,10 +30,10 @@
2011-10-09 Magnus Fromreide <ma...@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 <oliv...@woboq.com>
