gcc/testsuite/gfortran.dg/round_3.f08

   1 ! { dg-do run }
   2 ! PR48615 Invalid UP/DOWN rounding with E and ES descriptors
   3 ! Test case provided by Thomas Henlich.
   4 program pr48615
   5     call checkfmt("(RU,F17.0)", 2.5,     "               3.")
   6     call checkfmt("(RU,-1P,F17.1)", 2.5, "              0.3")
   7     call checkfmt("(RU,E17.1)", 2.5,     "          0.3E+01")
   8     call checkfmt("(RU,1P,E17.0)", 2.5,  "           3.E+00")
   9     call checkfmt("(RU,ES17.0)", 2.5,    "           3.E+00")
  10     call checkfmt("(RU,EN17.0)", 2.5,    "           3.E+00")
  11     call checkfmt("(RU,F2.0)",      2.0,  "2.")
  12     call checkfmt("(RU,F6.4)",      2.0,  "2.0000")
  13     call checkfmt("(RU,1P,E6.0E2)", 2.0,  "2.E+00")
  14     call checkfmt("(RU,1P,E7.1E2)", 2.5,  "2.5E+00")
  15     call checkfmt("(RU,1P,E10.4E2)", 2.5,  "2.5000E+00")
  16     call checkfmt("(RU,1P,G6.0E2)", 2.0,  "2.E+00")
  17     call checkfmt("(RU,1P,G10.4E2)", 2.3456e5,  "2.3456E+05")
  18
  19     call checkfmt("(RU,F2.0)",     0.09,  "1.")     ! 0.
  20     call checkfmt("(RD,F3.0)",     -0.09,  "-1.")     ! -0.
  21     call checkfmt("(RU,F2.0)",      2.0,  "2.")     ! 3.
  22     call checkfmt("(RD,F3.0)",     -2.0,  "-2.")     ! -3.
  23     call checkfmt("(RU,F6.4)",      2.0,  "2.0000")     ! 2.0001
  24     call checkfmt("(RD,F7.4)",     -2.0,  "-2.0000")     ! -2.0001
  25     call checkfmt("(RU,1P,E6.0E2)", 2.0,  "2.E+00") ! 3.E+00
  26     call checkfmt("(RD,1P,E7.0E2)", -2.0,  "-2.E+00") ! -3.E+00
  27     call checkfmt("(RU,1P,E7.1E2)", 2.5,  "2.5E+00") ! 2.6E+00
  28     call checkfmt("(RD,1P,E8.1E2)", -2.5,  "-2.5E+00") ! -2.6E+00
  29     call checkfmt("(RU,1P,E10.4E2)", 2.5,  "2.5000E+00") ! 2.5001E+00
  30     call checkfmt("(RD,1P,E11.4E2)", -2.5,  "-2.5000E+00") ! -2.5001E+00
  31     call checkfmt("(RU,1P,G6.0E2)", 2.0,  "2.E+00") ! 3.E+00
  32     call checkfmt("(RD,1P,G7.0E2)", -2.0,  "-2.E+00") ! -3.E+00
  33     call checkfmt("(RU,1P,G10.4E2)", 2.3456e5,  "2.3456E+05") ! 2.3457E+05
  34     call checkfmt("(RD,1P,G11.4E2)", -2.3456e5,  "-2.3456E+05") ! -2.3457E+05
  35
  36     call checkfmt("(RD,F17.0)", 2.5,     "               2.")
  37     call checkfmt("(RD,-1P,F17.1)", 2.5, "              0.2")
  38     call checkfmt("(RD,E17.1)", 2.5,     "          0.2E+01")
  39     call checkfmt("(RD,1P,E17.0)", 2.5,  "           2.E+00")
  40     call checkfmt("(RD,ES17.0)", 2.5,    "           2.E+00")
  41     call checkfmt("(RD,EN17.0)", 2.5,    "           2.E+00")
  42
  43     call checkfmt("(RC,F17.0)", 2.5,     "               3.")
  44     call checkfmt("(RC,-1P,F17.1)", 2.5, "              0.3")
  45     call checkfmt("(RC,E17.1)", 2.5,     "          0.3E+01")
  46     call checkfmt("(RC,1P,E17.0)", 2.5,  "           3.E+00")
  47     call checkfmt("(RC,ES17.0)", 2.5,    "           3.E+00")
  48     call checkfmt("(RC,EN17.0)", 2.5,    "           3.E+00")
  49
  50     call checkfmt("(RN,F17.0)", 2.5,     "               2.")
  51     call checkfmt("(RN,-1P,F17.1)", 2.5, "              0.2")
  52     call checkfmt("(RN,E17.1)", 2.5,     "          0.2E+01")
  53     call checkfmt("(RN,1P,E17.0)", 2.5,  "           2.E+00")
  54     call checkfmt("(RN,ES17.0)", 2.5,    "           2.E+00")
  55     call checkfmt("(RN,EN17.0)", 2.5,    "           2.E+00")
  56
  57     call checkfmt("(RZ,F17.0)", 2.5,     "               2.")
  58     call checkfmt("(RZ,-1P,F17.1)", 2.5, "              0.2")
  59     call checkfmt("(RZ,E17.1)", 2.5,     "          0.2E+01")
  60     call checkfmt("(RZ,1P,E17.0)", 2.5,  "           2.E+00")
  61     call checkfmt("(RZ,ES17.0)", 2.5,    "           2.E+00")
  62     call checkfmt("(RZ,EN17.0)", 2.5,    "           2.E+00")
  63
  64     call checkfmt("(RZ,F17.0)", -2.5,     "              -2.")
  65     call checkfmt("(RZ,-1P,F17.1)", -2.5, "             -0.2")
  66     call checkfmt("(RZ,E17.1)", -2.5,     "         -0.2E+01")
  67     call checkfmt("(RZ,1P,E17.0)", -2.5,  "          -2.E+00")
  68     call checkfmt("(RZ,ES17.0)", -2.5,    "          -2.E+00")
  69     call checkfmt("(RZ,EN17.0)", -2.5,    "          -2.E+00")
  70
  71     call checkfmt("(RN,F17.0)", -2.5,     "              -2.")
  72     call checkfmt("(RN,-1P,F17.1)", -2.5, "             -0.2")
  73     call checkfmt("(RN,E17.1)", -2.5,     "         -0.2E+01")
  74     call checkfmt("(RN,1P,E17.0)", -2.5,  "          -2.E+00")
  75     call checkfmt("(RN,ES17.0)", -2.5,    "          -2.E+00")
  76     call checkfmt("(RN,EN17.0)", -2.5,    "          -2.E+00")
  77
  78     call checkfmt("(RC,F17.0)", -2.5,     "              -3.")
  79     call checkfmt("(RC,-1P,F17.1)", -2.5, "             -0.3")
  80     call checkfmt("(RC,E17.1)", -2.5,     "         -0.3E+01")
  81     call checkfmt("(RC,1P,E17.0)", -2.5,  "          -3.E+00")
  82     call checkfmt("(RC,ES17.0)", -2.5,    "          -3.E+00")
  83     call checkfmt("(RC,EN17.0)", -2.5,    "          -3.E+00")
  84
  85     call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01")
  86     call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01")
  87
  88 contains
  89     subroutine checkfmt(fmt, x, cmp)
  90         character(len=*), intent(in) :: fmt
  91         real, intent(in) :: x
  92         character(len=*), intent(in) :: cmp
  93         character(len=20) :: s
  94
  95         write(s, fmt) x
  96         if (s /= cmp) call abort
  97         !if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp
  98     end subroutine
  99 end program