OSDN Git Service

2011-04-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / 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