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") ! 0.2E+01
   8     call checkfmt("(RU,1P,E17.0)", 2.5,  "           3.E+00")
   9     call checkfmt("(RU,ES17.0)", 2.5,    "           3.E+00") ! 2.E+00
  10     call checkfmt("(RU,EN17.0)", 2.5,    "           3.E+00")
  11
  12     call checkfmt("(RD,F17.0)", 2.5,     "               2.")
  13     call checkfmt("(RD,-1P,F17.1)", 2.5, "              0.2")
  14     call checkfmt("(RD,E17.1)", 2.5,     "          0.2E+01")
  15     call checkfmt("(RD,1P,E17.0)", 2.5,  "           2.E+00")
  16     call checkfmt("(RD,ES17.0)", 2.5,    "           2.E+00")
  17     call checkfmt("(RD,EN17.0)", 2.5,    "           2.E+00")
  18
  19     call checkfmt("(RC,F17.0)", 2.5,     "               3.")
  20     call checkfmt("(RC,-1P,F17.1)", 2.5, "              0.3")
  21     call checkfmt("(RC,E17.1)", 2.5,     "          0.3E+01") ! 0.2E+01
  22     call checkfmt("(RC,1P,E17.0)", 2.5,  "           3.E+00")
  23     call checkfmt("(RC,ES17.0)", 2.5,    "           3.E+00") ! 2.E+00
  24     call checkfmt("(RC,EN17.0)", 2.5,    "           3.E+00")
  25
  26     call checkfmt("(RN,F17.0)", 2.5,     "               2.")
  27     call checkfmt("(RN,-1P,F17.1)", 2.5, "              0.2")
  28     call checkfmt("(RN,E17.1)", 2.5,     "          0.2E+01")
  29     call checkfmt("(RN,1P,E17.0)", 2.5,  "           2.E+00")
  30     call checkfmt("(RN,ES17.0)", 2.5,    "           2.E+00")
  31     call checkfmt("(RN,EN17.0)", 2.5,    "           2.E+00")
  32
  33     call checkfmt("(RZ,F17.0)", 2.5,     "               2.")
  34     call checkfmt("(RZ,-1P,F17.1)", 2.5, "              0.2")
  35     call checkfmt("(RZ,E17.1)", 2.5,     "          0.2E+01")
  36     call checkfmt("(RZ,1P,E17.0)", 2.5,  "           2.E+00")
  37     call checkfmt("(RZ,ES17.0)", 2.5,    "           2.E+00")
  38     call checkfmt("(RZ,EN17.0)", 2.5,    "           2.E+00")
  39
  40     call checkfmt("(RZ,F17.0)", -2.5,     "              -2.")
  41     call checkfmt("(RZ,-1P,F17.1)", -2.5, "             -0.2")
  42     call checkfmt("(RZ,E17.1)", -2.5,     "         -0.2E+01")
  43     call checkfmt("(RZ,1P,E17.0)", -2.5,  "          -2.E+00")
  44     call checkfmt("(RZ,ES17.0)", -2.5,    "          -2.E+00")
  45     call checkfmt("(RZ,EN17.0)", -2.5,    "          -2.E+00")
  46
  47     call checkfmt("(RN,F17.0)", -2.5,     "              -2.")
  48     call checkfmt("(RN,-1P,F17.1)", -2.5, "             -0.2")
  49     call checkfmt("(RN,E17.1)", -2.5,     "         -0.2E+01")
  50     call checkfmt("(RN,1P,E17.0)", -2.5,  "          -2.E+00")
  51     call checkfmt("(RN,ES17.0)", -2.5,    "          -2.E+00")
  52     call checkfmt("(RN,EN17.0)", -2.5,    "          -2.E+00")
  53
  54     call checkfmt("(RC,F17.0)", -2.5,     "              -3.")
  55     call checkfmt("(RC,-1P,F17.1)", -2.5, "             -0.3")
  56     call checkfmt("(RC,E17.1)", -2.5,     "         -0.3E+01") ! -0.2E+01
  57     call checkfmt("(RC,1P,E17.0)", -2.5,  "          -3.E+00")
  58     call checkfmt("(RC,ES17.0)", -2.5,    "          -3.E+00") ! -2.E+00
  59     call checkfmt("(RC,EN17.0)", -2.5,    "          -3.E+00")
  60
  61     call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01") ! 0.2E+01
  62     call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01") ! 0.3E+01
  63
  64 contains
  65     subroutine checkfmt(fmt, x, cmp)
  66         character(len=*), intent(in) :: fmt
  67         real, intent(in) :: x
  68         character(len=*), intent(in) :: cmp
  69         character(len=40) :: s
  70
  71         write(s, fmt) x
  72         if (s /= cmp) call abort
  73         !if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp
  74     end subroutine
  75 end program