3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that, for a real static expression that is not part of a larger
28 -- static expression, and whose expected type T is an ordinary fixed
29 -- point type that is not a descendant of a formal scalar type, the value
30 -- is rounded to the nearest integral multiple of the small of T if
31 -- T'Machine_Rounds is true, and is truncated otherwise. Check that if
32 -- rounding is performed, and the value is exactly halfway between two
33 -- multiples of the small, one of the two multiples of small is used.
36 -- The test obtains an integral multiple M1 of the small of an ordinary
37 -- fixed point subtype S by dividing a real literal by S'Small, and then
38 -- truncating the result using 'Truncation. It then obtains an adjacent
39 -- multiple M2 of the small by using S'Succ (or S'Pred). It then
40 -- constructs values which lie between these multiples: one (A) which is
41 -- closer to M1, one (B) which is exactly halfway between M1 and M2, and
42 -- one (C) which is closer to M2. This is done for both positive and
43 -- negative multiples of the small.
45 -- Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
46 -- C must be rounded to M2, A must be rounded to M1, and B must be rounded
47 -- to either M1 or M2. If S'Machine_Rounds is false, all the values must
48 -- be truncated to M1.
50 -- A, B, and C are constructed using the following static expressions:
52 -- A: constant S := M1 + (M2 - M1)/Z; -- Z slightly more than 2.0.
53 -- B: constant S := M1 + (M2 - M1)/Z; -- Z equals 2.0.
54 -- C: constant S := M1 + (M2 - M1)/Z; -- Z slightly less than 2.0.
56 -- Since these are static expressions, they must be evaluated exactly,
57 -- and no rounding may occur until the final result is calculated.
59 -- The checks for equality between the members of (A, B, C) and (M1, M2)
60 -- are performed at run-time within the body of a subprogram.
62 -- The test performs additional checks that the rounding performed on
63 -- real literals is consistent for ordinary fixed point subtypes. A
64 -- named number (initialized with a literal) is assigned to a constant of
65 -- a fixed point subtype S. The same literal is then passed to a
66 -- subprogram, along with the constant, and an equality check is
67 -- performed within the body of the subprogram.
71 -- 26 Sep 95 SAIC Initial prerelease version.
77 type My_Fix
is delta 0.0625 range -1000.0 .. 1000.0;
79 Small
: constant := My_Fix
'Small; -- Named number.
81 procedure Fixed_Subtest
(A
, B
: in My_Fix
; Msg
: in String);
83 procedure Fixed_Subtest
(A
, B
, C
: in My_Fix
; Msg
: in String);
90 -- |----|-------------|-----------------|-------------------|-----------|
92 -- 0 P_M1 Less_Pos_Than_Half Pos_Exactly_Half More_Pos_Than_Half P_M2
95 Positive_Real
: constant := 0.11433; -- Named number.
96 Pos_Multiplier
: constant := Float'Truncation(Positive_Real
/Small
);
98 -- Pos_Multiplier is the number of integral multiples of small contained
99 -- in Positive_Real. P_M1 is thus the largest integral multiple of
100 -- small less than or equal to Positive_Real. Note that since Positive_Real
101 -- is a named number and not a fixed point object, P_M1 is generated
102 -- without assuming that rounding is performed correctly for fixed point
105 Positive_Fixed
: constant My_Fix
:= Positive_Real
;
107 P_M1
: constant My_Fix
:= Pos_Multiplier
* Small
;
108 P_M2
: constant My_Fix
:= My_Fix
'Succ(P_M1
);
110 -- P_M1 and P_M2 are adjacent multiples of the small of My_Fix. Note that
111 -- 0.11433 either equals P_M1 (if it is an integral multiple of the small)
112 -- or lies between P_M1 and P_M2 (since truncation was forced in
113 -- generating Pos_Multiplier). It is not certain, however, exactly where
114 -- it lies between them (halfway, less than halfway, more than halfway).
115 -- This fact is irrelevant to the test.
118 -- The following entities are used to verify that rounding is performed
119 -- according to the value of 'Machine_Rounds. If language rules are
120 -- obeyed, the intermediate expressions in the following static
121 -- initialization expressions will not be rounded; all calculations will
122 -- be performed exactly. The final result, however, will be rounded to
123 -- an integral multiple of the small (either P_M1 or P_M2, depending on the
124 -- value of My_Fix'Machine_Rounds). Thus, the value of each constant below
125 -- will equal that of P_M1 or P_M2.
127 Less_Pos_Than_Half
: constant My_Fix
:= P_M1
+ ((P_M2
- P_M1
)/2.050);
128 Pos_Exactly_Half
: constant My_Fix
:= P_M1
+ ((P_M2
- P_M1
)/2.000);
129 More_Pos_Than_Half
: constant My_Fix
:= P_M1
+ ((P_M2
- P_M1
)/1.975);
136 -- -|-------------|-----------------|-------------------|-----------|----|
138 -- N_M2 More_Neg_Than_Half Neg_Exactly_Half Less_Neg_Than_Half N_M1 0
141 -- The descriptions for the positive cases above apply to the negative
142 -- cases below as well. Note that, for N_M2, 'Pred is used rather than
143 -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
145 Negative_Real
: constant := -467.13988; -- Named number.
146 Neg_Multiplier
: constant := Float'Truncation(Negative_Real
/Small
);
148 Negative_Fixed
: constant My_Fix
:= Negative_Real
;
150 N_M1
: constant My_Fix
:= Neg_Multiplier
* Small
;
151 N_M2
: constant My_Fix
:= My_Fix
'Pred(N_M1
);
153 More_Neg_Than_Half
: constant My_Fix
:= N_M1
+ ((N_M2
- N_M1
)/1.980);
154 Neg_Exactly_Half
: constant My_Fix
:= N_M1
+ ((N_M2
- N_M1
)/2.000);
155 Less_Neg_Than_Half
: constant My_Fix
:= N_M1
+ ((N_M2
- N_M1
)/2.033);
160 --==================================================================--
164 package body C490002_0
is
166 procedure Fixed_Subtest
(A
, B
: in My_Fix
; Msg
: in String) is
168 TCTouch
.Assert
(A
= B
, Msg
);
171 procedure Fixed_Subtest
(A
, B
, C
: in My_Fix
; Msg
: in String) is
173 TCTouch
.Assert
(A
= B
or A
= C
, Msg
);
179 --==================================================================--
182 with C490002_0
; -- Fixed point support.
188 Report
.Test
("C490002", "Rounding of real static expressions: " &
189 "ordinary fixed point subtypes");
192 -- Literal cases: If the named numbers used to initialize Positive_Fixed
193 -- and Negative_Fixed are rounded to an integral multiple of the small
194 -- prior to assignment (as expected), then Positive_Fixed and
195 -- Negative_Fixed are already integral multiples of the small, and
196 -- equal either P_M1 or P_M2 (resp., N_M1 or N_M2). An equality check
197 -- can determine in which direction rounding occurred. For example:
199 -- if (Positive_Fixed = P_M1) then -- Rounding was toward 0.0.
201 -- Check here that the rounding direction is consistent for literals:
203 if (Positive_Fixed
= P_M1
) then
204 Fixed_Subtest
(0.11433, P_M1
, "Positive Fixed: literal");
206 Fixed_Subtest
(0.11433, P_M2
, "Positive Fixed: literal");
209 if (Negative_Fixed
= N_M1
) then
210 Fixed_Subtest
(-467.13988, N_M1
, "Negative Fixed: literal");
212 Fixed_Subtest
(-467.13988, N_M2
, "Negative Fixed: literal");
216 -- Now check that rounding is performed correctly for values between
217 -- multiples of the small, according to the value of 'Machine_Rounds:
219 if My_Fix
'Machine_Rounds then
220 Fixed_Subtest
(Pos_Exactly_Half
, P_M1
, P_M2
, "Positive Fixed: = half");
221 Fixed_Subtest
(More_Pos_Than_Half
, P_M2
, "Positive Fixed: > half");
222 Fixed_Subtest
(Less_Pos_Than_Half
, P_M1
, "Positive Fixed: < half");
224 Fixed_Subtest
(Neg_Exactly_Half
, N_M1
, N_M2
, "Negative Fixed: = half");
225 Fixed_Subtest
(More_Neg_Than_Half
, N_M2
, "Negative Fixed: > half");
226 Fixed_Subtest
(Less_Neg_Than_Half
, N_M1
, "Negative Fixed: < half");
228 Fixed_Subtest
(Pos_Exactly_Half
, P_M1
, "Positive Fixed: = half");
229 Fixed_Subtest
(More_Pos_Than_Half
, P_M1
, "Positive Fixed: > half");
230 Fixed_Subtest
(Less_Pos_Than_Half
, P_M1
, "Positive Fixed: < half");
232 Fixed_Subtest
(Neg_Exactly_Half
, N_M1
, "Negative Fixed: = half");
233 Fixed_Subtest
(More_Neg_Than_Half
, N_M1
, "Negative Fixed: > half");
234 Fixed_Subtest
(Less_Neg_Than_Half
, N_M1
, "Negative Fixed: < half");