2 ! { dg-additional-options "-mfp-rounding-mode=d" { target alpha*-*-* } }
4 use, intrinsic :: ieee_features
, only
: ieee_rounding
5 use, intrinsic :: ieee_arithmetic
9 procedure check_equal_float
, check_equal_double
12 interface check_not_equal
13 procedure check_not_equal_float
, check_not_equal_double
17 procedure divide_float
, divide_double
21 double precision :: dx1
, dx2
, dx3
22 type(ieee_round_type
) :: mode
24 ! We should support at least C float and C double types
25 if (ieee_support_rounding(ieee_nearest
)) then
26 if (.not
. ieee_support_rounding(ieee_nearest
, 0.)) call abort
27 if (.not
. ieee_support_rounding(ieee_nearest
, 0.d0
)) call abort
30 ! The initial rounding mode should probably be NEAREST
31 ! (at least on the platforms we currently support)
32 if (ieee_support_rounding(ieee_nearest
, 0.)) then
33 call ieee_get_rounding_mode (mode
)
34 if (mode
/= ieee_nearest
) call abort
38 if (ieee_support_rounding(ieee_up
, sx1
) .and
. &
39 ieee_support_rounding(ieee_down
, sx1
) .and
. &
40 ieee_support_rounding(ieee_nearest
, sx1
) .and
. &
41 ieee_support_rounding(ieee_to_zero
, sx1
)) then
45 sx1
= divide(sx1
, sx2
, ieee_up
)
49 sx3
= divide(sx3
, sx2
, ieee_down
)
50 call check_not_equal(sx1
, sx3
)
51 call check_equal(sx3
, nearest(sx1
, -1.))
52 call check_equal(sx1
, nearest(sx3
, 1.))
54 call check_equal(1./3., divide(1., 3., ieee_nearest
))
55 call check_equal(-1./3., divide(-1., 3., ieee_nearest
))
57 call check_equal(divide(3., 7., ieee_to_zero
), &
58 divide(3., 7., ieee_down
))
59 call check_equal(divide(-3., 7., ieee_to_zero
), &
60 divide(-3., 7., ieee_up
))
64 if (ieee_support_rounding(ieee_up
, dx1
) .and
. &
65 ieee_support_rounding(ieee_down
, dx1
) .and
. &
66 ieee_support_rounding(ieee_nearest
, dx1
) .and
. &
67 ieee_support_rounding(ieee_to_zero
, dx1
)) then
71 dx1
= divide(dx1
, dx2
, ieee_up
)
75 dx3
= divide(dx3
, dx2
, ieee_down
)
76 call check_not_equal(dx1
, dx3
)
77 call check_equal(dx3
, nearest(dx1
, -1.d0
))
78 call check_equal(dx1
, nearest(dx3
, 1.d0
))
80 call check_equal(1.d0
/3.d0
, divide(1.d0
, 3.d0
, ieee_nearest
))
81 call check_equal(-1.d0
/3.d0
, divide(-1.d0
, 3.d0
, ieee_nearest
))
83 call check_equal(divide(3.d0
, 7.d0
, ieee_to_zero
), &
84 divide(3.d0
, 7.d0
, ieee_down
))
85 call check_equal(divide(-3.d0
, 7.d0
, ieee_to_zero
), &
86 divide(-3.d0
, 7.d0
, ieee_up
))
92 real function divide_float (x
, y
, rounding
) result(res
)
93 use, intrinsic :: ieee_arithmetic
94 real, intent(in
) :: x
, y
95 type(ieee_round_type
), intent(in
) :: rounding
96 type(ieee_round_type
) :: old
98 call ieee_get_rounding_mode (old
)
99 call ieee_set_rounding_mode (rounding
)
103 call ieee_set_rounding_mode (old
)
106 double precision function divide_double (x
, y
, rounding
) result(res
)
107 use, intrinsic :: ieee_arithmetic
108 double precision, intent(in
) :: x
, y
109 type(ieee_round_type
), intent(in
) :: rounding
110 type(ieee_round_type
) :: old
112 call ieee_get_rounding_mode (old
)
113 call ieee_set_rounding_mode (rounding
)
117 call ieee_set_rounding_mode (old
)
120 subroutine check_equal_float (x
, y
)
121 real, intent(in
) :: x
, y
128 subroutine check_equal_double (x
, y
)
129 double precision, intent(in
) :: x
, y
136 subroutine check_not_equal_float (x
, y
)
137 real, intent(in
) :: x
, y
144 subroutine check_not_equal_double (x
, y
)
145 double precision, intent(in
) :: x
, y