Mercurial > hg > CbC > CbC_gcc

view gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 @ 158:494b0b89df80 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
line wrap: on
line source

!pr 12839- F2003 formatting of Inf /Nan 
! Modified for PR47434
       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 = 0
       fmt = '(F0.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'Inf') STOP 1
       write(l,fmt=fmt)neg_inf
       if (l.ne.'-Inf') STOP 2
       write(l,fmt=fmt)nan
       if (l.ne.'NaN') STOP 3

! check a field width < 3
       fmt = '(F2.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'**') STOP 4
       write(l,fmt=fmt)neg_inf
       if (l.ne.'**') STOP 5
       write(l,fmt=fmt)nan
       if (l.ne.'**') STOP 6

! check a field width = 3
       fmt = '(F3.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'Inf') STOP 7
       write(l,fmt=fmt)neg_inf
       if (l.ne.'***') STOP 8
       write(l,fmt=fmt)nan
       if (l.ne.'NaN') STOP 9

! check a field width > 3
       fmt = '(F4.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.' Inf') STOP 10
       write(l,fmt=fmt)neg_inf
       if (l.ne.'-Inf') STOP 11
       write(l,fmt=fmt)nan
       if (l.ne.' NaN') STOP 12

! check a field width = 7
       fmt = '(F7.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'    Inf') STOP 13
       write(l,fmt=fmt)neg_inf
       if (l.ne.'   -Inf') STOP 14
       write(l,fmt=fmt)nan
       if (l.ne.'    NaN') STOP 15

! check a field width = 8
       fmt = '(F8.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'Infinity') STOP 16
       write(l,fmt=fmt)neg_inf
       if (l.ne.'    -Inf') STOP 17
       write(l,fmt=fmt)nan
       if (l.ne.'     NaN') STOP 18

! check a field width = 9
       fmt = '(F9.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.' Infinity') STOP 19
       write(l,fmt=fmt)neg_inf
       if (l.ne.'-Infinity') STOP 20
       write(l,fmt=fmt)nan
       if (l.ne.'      NaN') STOP 21

! check a field width = 14
       fmt = '(F14.0)'
       write(l,fmt=fmt)pos_inf
       if (l.ne.'      Infinity') STOP 22
       write(l,fmt=fmt)neg_inf
       if (l.ne.'     -Infinity') STOP 23
       write(l,fmt=fmt)nan
       if (l.ne.'           NaN') STOP 24
       end