diff options
| author | Bud Davis <bdavis9659@comcast.net> | 2004-06-12 12:50:54 +0000 |
|---|---|---|
| committer | Bud Davis <bdavis@gcc.gnu.org> | 2004-06-12 12:50:54 +0000 |
| commit | 8204210bd612ade3760c5c9eec6d6b1368dee15b (patch) | |
| tree | b352ec80ae8b4024e59c79a5dd8215afaac2ac8e /gcc | |
| parent | 3d27dbd01aa4a707a4c179d6f4b12d2bce16d097 (diff) | |
| download | gcc-8204210bd612ade3760c5c9eec6d6b1368dee15b.zip gcc-8204210bd612ade3760c5c9eec6d6b1368dee15b.tar.gz gcc-8204210bd612ade3760c5c9eec6d6b1368dee15b.tar.bz2 | |
re PR libfortran/12839 (incorrect IO of Inf)
2004-06-12 Bud Davis <bdavis9659@comcast.net>
PR gfortran/12839
* gfortran.fortran-torture/execute/nan_inf_fmt.f90: New test.
* io/write.c(write_float): format inf and nan IAW F2003.
From-SVN: r83024
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 | 79 |
2 files changed, 84 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8fc34ba..ec49a66 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-06-12 Bud Davis <bdavis9659@comcast.net> + + PR gfortran/12839 + * gfortran.fortran-torture/execute/nan_inf_fmt.f90: New test. + 2004-06-11 Mark Mitchell <mark@codesourcery.com> PR c++/15862 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 new file mode 100644 index 0000000..84322c6 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 @@ -0,0 +1,79 @@ +!pr 12839- F2003 formatting of Inf /Nan + implicit none + character*40 l + character*12 fmt + real zero, pos_inf, neg_inf, nan + zero = 0.0 + +! need a better way of generating these floating point +! exceptional constants. + + pos_inf = 1.0/zero + neg_inf = -1.0/zero + nan = zero/zero + + +! check a field width < 3 + fmt = '(F2.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.'**') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.'**') call abort + write(l,fmt=fmt)nan + if (l.ne.'**') call abort + +! check a field width = 3 + fmt = '(F3.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.'Inf') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.'Inf') call abort + write(l,fmt=fmt)nan + if (l.ne.'NaN') call abort + +! check a field width > 3 + fmt = '(F4.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.'+Inf') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.'-Inf') call abort + write(l,fmt=fmt)nan + if (l.ne.' NaN') call abort + +! check a field width = 7 + fmt = '(F7.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.' +Inf') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.' -Inf') call abort + write(l,fmt=fmt)nan + if (l.ne.' NaN') call abort + +! check a field width = 8 + fmt = '(F8.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.'Infinity') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.'Infinity') call abort + write(l,fmt=fmt)nan + if (l.ne.' NaN') call abort + +! check a field width = 9 + fmt = '(F9.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.'+Infinity') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.'-Infinity') call abort + write(l,fmt=fmt)nan + if (l.ne.' NaN') call abort + +! check a field width = 14 + fmt = '(F14.0)' + write(l,fmt=fmt)pos_inf + if (l.ne.' +Infinity') call abort + write(l,fmt=fmt)neg_inf + if (l.ne.' -Infinity') call abort + write(l,fmt=fmt)nan + if (l.ne.' NaN') call abort + end + |