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

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