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("(RC,G10.2)", 99.5,   "  0.10E+03") ! pr59774
  20     call checkfmt("(RC,G10.2)", 995.,   "  0.10E+04") ! pr59774
  21     call checkfmt("(RC,G10.3)", 999.5,  " 0.100E+04") ! pr59774
  22     call checkfmt("(RC,G10.3)", 9995.,  " 0.100E+05") ! pr59774
  23     call checkfmt("(RU,G10.2)", .099,   "  0.10    ") ! pr59774
  24     call checkfmt("(RC,G10.1)", .095,   "   0.1    ") ! pr59774
  25     call checkfmt("(RU,G10.3)", .0999,  " 0.100    ") ! pr59774
  26     call checkfmt("(RC,G10.2)", .0995,  "  0.10    ") ! pr59774
  27
  28     call checkfmt("(RU,G9.3)",  891.1,  " 892.")      ! pr59836
  29     call checkfmt("(RD,G9.3)", -891.1,  "-892.")      ! pr59836
  30
  31     call checkfmt("(RU,F6.4)",     0.00006,  "0.0001")! 0.
  32     call checkfmt("(RU,F5.3)",     0.0007,  "0.001")  ! 0.
  33     call checkfmt("(RU,F4.2)",     0.008,  "0.01")    ! 0.
  34     call checkfmt("(RU,F3.1)",     0.09,  "0.1")      ! 0.
  35
  36     call checkfmt("(RU,F2.0)",     0.09,  "1.")       ! 0.
  37     call checkfmt("(RD,F3.0)",     -0.09,  "-1.")     ! -0.
  38     call checkfmt("(RU,F2.0)",     0.9,  "1.")        ! pr59836
  39     call checkfmt("(RC,F2.0)",     0.4,  "0.")        ! pr59836
  40     call checkfmt("(RC,F2.0)",     0.5,  "1.")        ! pr59836
  41     call checkfmt("(RC,F2.0)",     0.6,  "1.")        ! pr59836
  42     call checkfmt("(RD,F3.0)",     -0.9,  "-1.")      ! pr59836
  43     call checkfmt("(RC,F3.0)",     -0.4,  "-0.")      ! pr59836
  44     call checkfmt("(RC,F3.0)",     -0.5,  "-1.")      ! pr59836
  45     call checkfmt("(RC,F3.0)",     -0.6,  "-1.")      ! pr59836
  46     call checkfmt("(RU,F2.0)",      2.0,  "2.")       ! 3.
  47     call checkfmt("(RD,F3.0)",     -2.0,  "-2.")      ! -3.
  48     call checkfmt("(RU,F6.4)",      2.0,  "2.0000")   ! 2.0001
  49     call checkfmt("(RD,F7.4)",     -2.0,  "-2.0000")  ! -2.0001
  50     call checkfmt("(RU,1P,E6.0E2)", 2.0,  "2.E+00")   ! 3.E+00
  51     call checkfmt("(RD,1P,E7.0E2)", -2.0,  "-2.E+00") ! -3.E+00
  52     call checkfmt("(RU,1P,E7.1E2)", 2.5,  "2.5E+00")  ! 2.6E+00
  53     call checkfmt("(RD,1P,E8.1E2)", -2.5,  "-2.5E+00") ! -2.6E+00
  54     call checkfmt("(RU,1P,E10.4E2)", 2.5,  "2.5000E+00") ! 2.5001E+00
  55     call checkfmt("(RD,1P,E11.4E2)", -2.5,  "-2.5000E+00") ! -2.5001E+00
  56     call checkfmt("(RU,1P,G6.0E2)", 2.0,  "2.E+00")   ! 3.E+00
  57     call checkfmt("(RD,1P,G7.0E2)", -2.0,  "-2.E+00") ! -3.E+00
  58     call checkfmt("(RU,1P,G10.4E2)", 2.3456e5,  "2.3456E+05") ! 2.3457E+05
  59     call checkfmt("(RD,1P,G11.4E2)", -2.3456e5,  "-2.3456E+05") ! -2.3457E+05
  60
  61     call checkfmt("(RD,F17.0)", 2.5,     "               2.")
  62     call checkfmt("(RD,-1P,F17.1)", 2.5, "              0.2")
  63     call checkfmt("(RD,E17.1)", 2.5,     "          0.2E+01")
  64     call checkfmt("(RD,1P,E17.0)", 2.5,  "           2.E+00")
  65     call checkfmt("(RD,ES17.0)", 2.5,    "           2.E+00")
  66     call checkfmt("(RD,EN17.0)", 2.5,    "           2.E+00")
  67
  68     call checkfmt("(RC,F17.0)", 2.5,     "               3.")
  69     call checkfmt("(RC,-1P,F17.1)", 2.5, "              0.3")
  70     call checkfmt("(RC,E17.1)", 2.5,     "          0.3E+01")
  71     call checkfmt("(RC,1P,E17.0)", 2.5,  "           3.E+00")
  72     call checkfmt("(RC,ES17.0)", 2.5,    "           3.E+00")
  73     call checkfmt("(RC,EN17.0)", 2.5,    "           3.E+00")
  74
  75     call checkfmt("(RN,F17.0)", 2.5,     "               2.")
  76     call checkfmt("(RN,-1P,F17.1)", 2.5, "              0.2")
  77     call checkfmt("(RN,E17.1)", 2.5,     "          0.2E+01")
  78     call checkfmt("(RN,1P,E17.0)", 2.5,  "           2.E+00")
  79     call checkfmt("(RN,ES17.0)", 2.5,    "           2.E+00")
  80     call checkfmt("(RN,EN17.0)", 2.5,    "           2.E+00")
  81
  82     call checkfmt("(RZ,F17.0)", 2.5,     "               2.")
  83     call checkfmt("(RZ,-1P,F17.1)", 2.5, "              0.2")
  84     call checkfmt("(RZ,E17.1)", 2.5,     "          0.2E+01")
  85     call checkfmt("(RZ,1P,E17.0)", 2.5,  "           2.E+00")
  86     call checkfmt("(RZ,ES17.0)", 2.5,    "           2.E+00")
  87     call checkfmt("(RZ,EN17.0)", 2.5,    "           2.E+00")
  88
  89     call checkfmt("(RZ,F17.0)", -2.5,     "              -2.")
  90     call checkfmt("(RZ,-1P,F17.1)", -2.5, "             -0.2")
  91     call checkfmt("(RZ,E17.1)", -2.5,     "         -0.2E+01")
  92     call checkfmt("(RZ,1P,E17.0)", -2.5,  "          -2.E+00")
  93     call checkfmt("(RZ,ES17.0)", -2.5,    "          -2.E+00")
  94     call checkfmt("(RZ,EN17.0)", -2.5,    "          -2.E+00")
  95
  96     call checkfmt("(RN,F17.0)", -2.5,     "              -2.")
  97     call checkfmt("(RN,-1P,F17.1)", -2.5, "             -0.2")
  98     call checkfmt("(RN,E17.1)", -2.5,     "         -0.2E+01")
  99     call checkfmt("(RN,1P,E17.0)", -2.5,  "          -2.E+00")
 100     call checkfmt("(RN,ES17.0)", -2.5,    "          -2.E+00")
 101     call checkfmt("(RN,EN17.0)", -2.5,    "          -2.E+00")
 102
 103     call checkfmt("(RC,F17.0)", -2.5,     "              -3.")
 104     call checkfmt("(RC,-1P,F17.1)", -2.5, "             -0.3")
 105     call checkfmt("(RC,E17.1)", -2.5,     "         -0.3E+01")
 106     call checkfmt("(RC,1P,E17.0)", -2.5,  "          -3.E+00")
 107     call checkfmt("(RC,ES17.0)", -2.5,    "          -3.E+00")
 108     call checkfmt("(RC,EN17.0)", -2.5,    "          -3.E+00")
 109
 110     call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01")
 111     call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01")
 112
 113     call checkfmt("(G12.2)", 99.0,       "     99.    ")
 114     call checkfmt("(G12.2)", 99.5,       "    0.10E+03")
 115     call checkfmt("(G12.2)", 100.0,      "    0.10E+03")
 116     call checkfmt("(G12.2)", -99.0,      "    -99.    ")
 117     call checkfmt("(G12.2)", -99.5,      "   -0.10E+03")
 118     call checkfmt("(G12.2)", -100.0,     "   -0.10E+03")
 119     call checkfmt("(RU,G12.2)", 99.0,    "     99.    ")    ! pr93567
 120     call checkfmt("(RU,G12.2)", 99.01,   "    0.10E+03")
 121     call checkfmt("(RU,G12.2)", -99.0,   "    -99.    ")
 122     call checkfmt("(RU,G12.2)", -99.01,  "    -99.    ")
 123     call checkfmt("(RU,G12.2)", -100.01, "   -0.10E+03")
 124     call checkfmt("(RU,G12.4)", 99.0 ,   "   99.00    ")
 125     call checkfmt("(RU,G12.4)", 99.01,   "   99.02    ")
 126     call checkfmt("(RD,G12.2)", 99.0,    "     99.    ")
 127     call checkfmt("(RD,G12.2)", 99.01,   "     99.    ")
 128     call checkfmt("(RD,G12.2)", 100.01,  "    0.10E+03")
 129     call checkfmt("(RD,G12.2)", -99.0,   "    -99.    ")
 130     call checkfmt("(RD,G12.2)", -99.01,  "   -0.10E+03")
 131     call checkfmt("(RD,G12.2)", -100.00, "   -0.10E+03")
 132     call checkfmt("(Rz,G12.2)", 99.01,   "     99.    ")
 133     call checkfmt("(Rz,G12.2)", 100.01,  "    0.10E+03")
 134     call checkfmt("(Rz,G12.2)", -99.01,  "    -99.    ")
 135     call checkfmt("(Rz,G12.2)", -100.01, "   -0.10E+03")
 136
 137 contains
 138     subroutine checkfmt(fmt, x, cmp)
 139         character(len=*), intent(in) :: fmt
 140         real, intent(in) :: x
 141         character(len=*), intent(in) :: cmp
 142         character(len=20) :: s
 143
 144         write(s, fmt) x
 145         if (s /= cmp) STOP 1
 146         !if (s /= cmp) print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
 147     end subroutine
 148 end program