OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c490002.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C490002.A
2
--
3
--                             Grant of Unlimited Rights
4
--
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
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
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.
24
--*
25
--
26
-- OBJECTIVE:
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.
34
--
35
-- TEST DESCRIPTION:
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.
44
--
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.
49
--
50
--      A, B, and C are constructed using the following static expressions:
51
--
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.
55
--
56
--      Since these are static expressions, they must be evaluated exactly,
57
--      and no rounding may occur until the final result is calculated.
58
--
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.
61
--
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.
68
--
69
--
70
-- CHANGE HISTORY:
71
--      26 Sep 95   SAIC    Initial prerelease version.
72
--
73
--!
74
 
75
package C490002_0 is
76
 
77
   type My_Fix is delta 0.0625 range -1000.0 .. 1000.0;
78
 
79
   Small : constant := My_Fix'Small;                      -- Named number.
80
 
81
   procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String);
82
 
83
   procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String);
84
 
85
 
86
--
87
-- Positive cases:
88
--
89
 
90
   --  |----|-------------|-----------------|-------------------|-----------|
91
   --  |    |             |                 |                   |           |
92
   --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
93
 
94
 
95
   Positive_Real  : constant := 0.11433;          -- Named number.
96
   Pos_Multiplier : constant := Float'Truncation(Positive_Real/Small);
97
 
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
103
   -- subtypes.
104
 
105
   Positive_Fixed : constant My_Fix := Positive_Real;
106
 
107
   P_M1 : constant My_Fix := Pos_Multiplier * Small;
108
   P_M2 : constant My_Fix := My_Fix'Succ(P_M1);
109
 
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.
116
 
117
 
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.
126
 
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);
130
 
131
 
132
--
133
-- Negative cases:
134
--
135
 
136
   --  -|-------------|-----------------|-------------------|-----------|----|
137
   --   |             |                 |                   |           |    |
138
   --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
139
 
140
 
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.
144
 
145
   Negative_Real  : constant := -467.13988;       -- Named number.
146
   Neg_Multiplier : constant := Float'Truncation(Negative_Real/Small);
147
 
148
   Negative_Fixed : constant My_Fix := Negative_Real;
149
 
150
   N_M1 : constant My_Fix := Neg_Multiplier * Small;
151
   N_M2 : constant My_Fix := My_Fix'Pred(N_M1);
152
 
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);
156
 
157
end C490002_0;
158
 
159
 
160
     --==================================================================--
161
 
162
 
163
with TCTouch;
164
package body C490002_0 is
165
 
166
   procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String) is
167
   begin
168
       TCTouch.Assert (A = B, Msg);
169
   end Fixed_Subtest;
170
 
171
   procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String) is
172
   begin
173
       TCTouch.Assert (A = B or A = C, Msg);
174
   end Fixed_Subtest;
175
 
176
end C490002_0;
177
 
178
 
179
     --==================================================================--
180
 
181
 
182
with C490002_0;  -- Fixed point support.
183
use  C490002_0;
184
 
185
with Report;
186
procedure C490002 is
187
begin
188
   Report.Test ("C490002", "Rounding of real static expressions: " &
189
                "ordinary fixed point subtypes");
190
 
191
 
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:
198
   --
199
   --        if (Positive_Fixed = P_M1) then -- Rounding was toward 0.0.
200
   --
201
   -- Check here that the rounding direction is consistent for literals:
202
 
203
   if (Positive_Fixed = P_M1) then
204
      Fixed_Subtest (0.11433, P_M1, "Positive Fixed: literal");
205
   else
206
      Fixed_Subtest (0.11433, P_M2, "Positive Fixed: literal");
207
   end if;
208
 
209
   if (Negative_Fixed = N_M1) then
210
      Fixed_Subtest (-467.13988, N_M1, "Negative Fixed: literal");
211
   else
212
      Fixed_Subtest (-467.13988, N_M2, "Negative Fixed: literal");
213
   end if;
214
 
215
 
216
   -- Now check that rounding is performed correctly for values between
217
   -- multiples of the small, according to the value of 'Machine_Rounds:
218
 
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");
223
 
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");
227
   else
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");
231
 
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");
235
   end if;
236
 
237
 
238
   Report.Result;
239
end C490002;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.