gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90

   1 !pr 12839- F2003 formatting of Inf /Nan
   2 ! Modified for PR47434
   3        implicit none
   4        character*40 l
   5        character*12 fmt
   6        real zero, pos_inf, neg_inf, nan
   7        zero = 0.0
   8
   9 ! need a better way of generating these floating point
  10 ! exceptional constants.
  11
  12        pos_inf =  1.0/zero
  13        neg_inf = -1.0/zero
  14        nan = zero/zero
  15
  16 ! check a field width = 0
  17        fmt = '(F0.0)'
  18        write(l,fmt=fmt)pos_inf
  19        if (l.ne.'Inf') call abort
  20        write(l,fmt=fmt)neg_inf
  21        if (l.ne.'-Inf') call abort
  22        write(l,fmt=fmt)nan
  23        if (l.ne.'NaN') call abort
  24
  25 ! check a field width < 3
  26        fmt = '(F2.0)'
  27        write(l,fmt=fmt)pos_inf
  28        if (l.ne.'**') call abort
  29        write(l,fmt=fmt)neg_inf
  30        if (l.ne.'**') call abort
  31        write(l,fmt=fmt)nan
  32        if (l.ne.'**') call abort
  33
  34 ! check a field width = 3
  35        fmt = '(F3.0)'
  36        write(l,fmt=fmt)pos_inf
  37        if (l.ne.'Inf') call abort
  38        write(l,fmt=fmt)neg_inf
  39        if (l.ne.'***') call abort
  40        write(l,fmt=fmt)nan
  41        if (l.ne.'NaN') call abort
  42
  43 ! check a field width > 3
  44        fmt = '(F4.0)'
  45        write(l,fmt=fmt)pos_inf
  46        if (l.ne.' Inf') call abort
  47        write(l,fmt=fmt)neg_inf
  48        if (l.ne.'-Inf') call abort
  49        write(l,fmt=fmt)nan
  50        if (l.ne.' NaN') call abort
  51
  52 ! check a field width = 7
  53        fmt = '(F7.0)'
  54        write(l,fmt=fmt)pos_inf
  55        if (l.ne.'    Inf') call abort
  56        write(l,fmt=fmt)neg_inf
  57        if (l.ne.'   -Inf') call abort
  58        write(l,fmt=fmt)nan
  59        if (l.ne.'    NaN') call abort
  60
  61 ! check a field width = 8
  62        fmt = '(F8.0)'
  63        write(l,fmt=fmt)pos_inf
  64        if (l.ne.'Infinity') call abort
  65        write(l,fmt=fmt)neg_inf
  66        if (l.ne.'    -Inf') call abort
  67        write(l,fmt=fmt)nan
  68        if (l.ne.'     NaN') call abort
  69
  70 ! check a field width = 9
  71        fmt = '(F9.0)'
  72        write(l,fmt=fmt)pos_inf
  73        if (l.ne.' Infinity') call abort
  74        write(l,fmt=fmt)neg_inf
  75        if (l.ne.'-Infinity') call abort
  76        write(l,fmt=fmt)nan
  77        if (l.ne.'      NaN') call abort
  78
  79 ! check a field width = 14
  80        fmt = '(F14.0)'
  81        write(l,fmt=fmt)pos_inf
  82        if (l.ne.'      Infinity') call abort
  83        write(l,fmt=fmt)neg_inf
  84        if (l.ne.'     -Infinity') call abort
  85        write(l,fmt=fmt)nan
  86        if (l.ne.'           NaN') call abort
  87        end
  88