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/] [cxa/] [cxa5015.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXA5015.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 the following representation-oriented attributes are
28
--      available and that the produce correct results:
29
--      'Denorm, 'Signed_Zeros, 'Exponent 'Fraction, 'Compose, 'Scaling,
30
--      'Floor, 'Ceiling, 'Rounding, 'Unbiased_Rounding, 'Truncation,
31
--      'Remainder, 'Adjacent, 'Copy_Sign, 'Leading_Part, 'Machine, and
32
--      'Model_Small.
33
--
34
-- TEST DESCRIPTION:
35
--      This test checks whether certain attributes of floating point types
36
--      are available from an implementation.  Where attribute correctness
37
--      can be verified in a straight forward manner, the appropriate checks
38
--      are included here.  However, this test is not intended to ensure the
39
--      correctness of the results returned from all of the attributes
40
--      examined in this test; that process will occur in the tests of the
41
--      Numerics_Annex.
42
--
43
--
44
-- CHANGE HISTORY:
45
--      26 Jun 95   SAIC    Initial prerelease version.
46
--      29 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
47
--      01 DEC 97   EDS     Fix value for checking the S'Adjacent attribute
48
--!
49
 
50
with Report;
51
 
52
procedure CXA5015 is
53
 
54
   subtype Float_Subtype   is Float range -10.0..10.0;
55
   type    Derived_Float_1 is digits  8;
56
   type    Derived_Float_2 is new Derived_Float_1 range -10.0..10.0E10;
57
 
58
   use type Float, Float_Subtype, Derived_Float_1, Derived_Float_2;
59
 
60
   TC_Boolean   : Boolean;
61
   TC_Float     : Float;
62
   TC_SFloat    : Float_Subtype;
63
   TC_DFloat_1  : Derived_Float_1;
64
   TC_DFloat_2  : Derived_Float_2;
65
   TC_Tolerance : Float := 0.001;
66
 
67
   function Not_Equal (Actual_Result, Expected_Result, Tolerance : Float)
68
     return Boolean is
69
   begin
70
      return abs(Actual_Result - Expected_Result) > Tolerance;
71
   end Not_Equal;
72
 
73
 
74
begin
75
 
76
   Report.Test ("CXA5015", "Check that certain representation-oriented " &
77
                           "attributes are available and that they "     &
78
                           "produce correct results");
79
 
80
   -- New Representation-Oriented Attributes.
81
   --
82
   -- Check the S'Denorm attribute.
83
 
84
   TC_Boolean := Float'Denorm;
85
   TC_Boolean := Float_Subtype'Denorm;
86
   TC_Boolean := Derived_Float_1'Denorm;
87
   TC_Boolean := Derived_Float_2'Denorm;
88
 
89
 
90
   -- Check the S'Signed_Zeroes attribute.
91
 
92
   TC_Boolean := Float'Signed_Zeros;
93
   TC_Boolean := Float_Subtype'Signed_Zeros;
94
   TC_Boolean := Derived_Float_1'Signed_Zeros;
95
   TC_Boolean := Derived_Float_2'Signed_Zeros;
96
 
97
 
98
   -- New Primitive Function Attributes.
99
   --
100
   -- Check the S'Exponent attribute.
101
 
102
   TC_Float    := 0.5;
103
   TC_SFloat   := 0.99;
104
   TC_DFloat_1 := 2.45;
105
   TC_DFloat_2 := 2.65;
106
 
107
   if Float'Exponent(TC_Float) > Float_Subtype'Exponent(TC_SFloat) or
108
      Float'Exponent(TC_Float) > 2
109
   then
110
      Report.Failed("Incorrect result from the 'Exponent attribute");
111
   end if;
112
 
113
 
114
   -- Check the S'Fraction attribute.
115
 
116
   if Not_Equal
117
        (Float'Fraction(TC_Float),
118
         TC_Float * Float(Float'Machine_Radix)**(-Float'Exponent(TC_Float)),
119
         TC_Tolerance)
120
   then
121
      Report.Failed("Incorrect result from the 'Fraction attribute - 1");
122
   end if;
123
 
124
   if Float'Fraction(TC_Float) <
125
      (1.0/Float(Float'Machine_Radix)) - TC_Tolerance  or
126
      Float'Fraction(TC_Float) >= 1.0 - TC_Tolerance
127
   then
128
      Report.Failed("Incorrect result from the 'Fraction attribute - 2");
129
   end if;
130
 
131
 
132
   -- Check the S'Compose attribute.
133
 
134
   if Not_Equal
135
       (Float'Compose(TC_Float, 3),
136
        TC_Float * Float(Float'Machine_Radix)**(3-Float'Exponent(TC_Float)),
137
        TC_Tolerance)
138
   then
139
      Report.Failed("Incorrect result from the 'Compose attribute");
140
   end if;
141
 
142
 
143
   -- Check the S'Scaling attribute.
144
 
145
   if Not_Equal
146
        (Float'Scaling(TC_Float, 2),
147
         TC_Float * Float(Float'Machine_Radix)**2,
148
         TC_Tolerance)
149
   then
150
      Report.Failed("Incorrect result from the 'Scaling attribute");
151
   end if;
152
 
153
 
154
   -- Check the S'Floor attribute.
155
 
156
   TC_Float    :=  0.99;
157
   TC_SFloat   :=  1.00;
158
   TC_DFloat_1 :=  2.50;
159
   TC_DFloat_2 := -2.50;
160
 
161
   if Float'Floor(TC_Float)               /=  0.0  or
162
      Float_Subtype'Floor(TC_SFloat)      /=  1.0  or
163
      Derived_Float_1'Floor(TC_DFloat_1)  /=  2.0  or
164
      Derived_Float_2'Floor(TC_DFloat_2)  /= -3.0
165
   then
166
      Report.Failed("Incorrect result from the 'Floor attribute");
167
   end if;
168
 
169
 
170
   -- Check the S'Ceiling attribute.
171
 
172
   TC_Float    :=  0.99;
173
   TC_SFloat   :=  1.00;
174
   TC_DFloat_1 :=  2.50;
175
   TC_DFloat_2 := -2.99;
176
 
177
   if Float'Ceiling(TC_Float)               /=  1.0  or
178
      Float_Subtype'Ceiling(TC_SFloat)      /=  1.0  or
179
      Derived_Float_1'Ceiling(TC_DFloat_1)  /=  3.0  or
180
      Derived_Float_2'Ceiling(TC_DFloat_2)  /= -2.0
181
   then
182
      Report.Failed("Incorrect result from the 'Ceiling attribute");
183
   end if;
184
 
185
 
186
   -- Check the S'Rounding attribute.
187
 
188
   TC_Float    :=  0.49;
189
   TC_SFloat   :=  1.00;
190
   TC_DFloat_1 :=  2.50;
191
   TC_DFloat_2 := -2.50;
192
 
193
   if Float'Rounding(TC_Float)               /=  0.0  or
194
      Float_Subtype'Rounding(TC_SFloat)      /=  1.0  or
195
      Derived_Float_1'Rounding(TC_DFloat_1)  /=  3.0  or
196
      Derived_Float_2'Rounding(TC_DFloat_2)  /= -3.0
197
   then
198
      Report.Failed("Incorrect result from the 'Rounding attribute");
199
   end if;
200
 
201
 
202
   -- Check the S'Unbiased_Rounding attribute.
203
 
204
   TC_Float    :=  0.50;
205
   TC_SFloat   :=  1.50;
206
   TC_DFloat_1 :=  2.50;
207
   TC_DFloat_2 := -2.50;
208
 
209
   if Float'Unbiased_Rounding(TC_Float)               /=  0.0  or
210
      Float_Subtype'Unbiased_Rounding(TC_SFloat)      /=  2.0  or
211
      Derived_Float_1'Unbiased_Rounding(TC_DFloat_1)  /=  2.0  or
212
      Derived_Float_2'Unbiased_Rounding(TC_DFloat_2)  /= -2.0
213
   then
214
      Report.Failed("Incorrect result from the 'Unbiased_Rounding " &
215
                    "attribute");
216
   end if;
217
 
218
 
219
   -- Check the S'Truncation attribute.
220
 
221
   TC_Float    := -0.99;
222
   TC_SFloat   :=  1.50;
223
   TC_DFloat_1 :=  2.99;
224
   TC_DFloat_2 := -2.50;
225
 
226
   if Float'Truncation(TC_Float)               /=  0.0  or
227
      Float_Subtype'Truncation(TC_SFloat)      /=  1.0  or
228
      Derived_Float_1'Truncation(TC_DFloat_1)  /=  2.0  or
229
      Derived_Float_2'Truncation(TC_DFloat_2)  /= -2.0
230
   then
231
      Report.Failed("Incorrect result from the 'Truncation attribute");
232
   end if;
233
 
234
 
235
   -- Check the S'Remainder attribute.
236
 
237
   TC_Float    :=  9.0;
238
   TC_SFloat   :=  7.5;
239
   TC_DFloat_1 :=  5.0;
240
   TC_DFloat_2 :=  8.0;
241
 
242
   if Float'Remainder(TC_Float, 2.0)                /=  1.0  or
243
      Float_Subtype'Remainder(TC_SFloat, 3.0)       /=  1.5  or
244
      Derived_Float_1'Remainder(TC_DFloat_1, 2.0)   /=  1.0  or
245
      Derived_Float_2'Remainder(TC_DFloat_2, 4.0)   /=  0.0
246
   then
247
      Report.Failed("Incorrect result from the 'Remainder attribute");
248
   end if;
249
 
250
 
251
   -- Check the S'Adjacent attribute.
252
 
253
   TC_Float    :=  4.0;
254
   TC_SFloat   := -1.0;
255
 
256
   if Float'Adjacent(TC_Float, TC_Float)           /=  TC_Float  or
257
      Float_Subtype'Adjacent(TC_SFloat, -1.0)      /=  TC_SFloat
258
   then
259
      Report.Failed("Incorrect result from the 'Adjacent attribute");
260
   end if;
261
 
262
 
263
   -- Check the S'Copy_Sign attribute.
264
 
265
   TC_Float    :=  0.0;
266
   TC_SFloat   := -1.0;
267
   TC_DFloat_1 :=  5.0;
268
   TC_DFloat_2 := -2.5;
269
 
270
   if Float'Copy_Sign(TC_Float, -2.0)               /=  0.0  or
271
      Float_Subtype'Copy_Sign(TC_SFloat, 4.0)       /=  1.0  or
272
      Derived_Float_1'Copy_Sign(TC_DFloat_1, -2.0)  /= -5.0  or
273
      Derived_Float_2'Copy_Sign(TC_DFloat_2, -2.0)  /= -2.5
274
   then
275
      Report.Failed("Incorrect result from the 'Copy_Sign attribute");
276
   end if;
277
 
278
 
279
   -- Check the S'Leading_Part attribute.
280
 
281
   TC_Float    :=  0.0;
282
   TC_SFloat   := -1.0;
283
   TC_DFloat_1 :=  5.88;
284
   TC_DFloat_2 := -2.52;
285
 
286
   -- Leading part obtained in the variables.
287
   TC_Float    :=  Float'Leading_Part(TC_Float, 2);
288
   TC_SFloat   :=  Float_Subtype'Leading_Part(TC_SFloat, 2);
289
   TC_DFloat_1 :=  Derived_Float_1'Leading_Part(TC_DFloat_1, 2);
290
   TC_DFloat_2 :=  Derived_Float_2'Leading_Part(TC_DFloat_2, 2);
291
 
292
   -- Checking for the leading part of the variables at this point should
293
   -- produce the same values.
294
   if Float'Leading_Part(TC_Float, 2)              /= TC_Float    or
295
      Float_Subtype'Leading_Part(TC_SFloat, 2)     /= TC_SFloat   or
296
      Derived_Float_1'Leading_Part(TC_DFloat_1, 2) /= TC_DFloat_1 or
297
      Derived_Float_2'Leading_Part(TC_DFloat_2, 2) /= TC_DFloat_2
298
   then
299
      Report.Failed("Incorrect result from the 'Leading_Part attribute");
300
   end if;
301
 
302
 
303
   -- Check the S'Machine attribute.
304
 
305
   TC_Float    :=  0.0;
306
   TC_SFloat   := -1.0;
307
   TC_DFloat_1 :=  5.88;
308
   TC_DFloat_2 := -2.52;
309
 
310
   -- Closest machine number obtained in the variables.
311
   TC_Float    :=  Float'Machine(TC_Float);
312
   TC_SFloat   :=  Float_Subtype'Machine(TC_SFloat);
313
   TC_DFloat_1 :=  Derived_Float_1'Machine(TC_DFloat_1);
314
   TC_DFloat_2 :=  Derived_Float_2'Machine(TC_DFloat_2);
315
 
316
   -- Checking for the closest machine number to each of the variables at
317
   -- this point should produce the same values.
318
   if Float'Machine(TC_Float)              /= TC_Float    or
319
      Float_Subtype'Machine(TC_SFloat)     /= TC_SFloat   or
320
      Derived_Float_1'Machine(TC_DFloat_1) /= TC_DFloat_1 or
321
      Derived_Float_2'Machine(TC_DFloat_2) /= TC_DFloat_2
322
   then
323
      Report.Failed("Incorrect result from the 'Machine attribute");
324
   end if;
325
 
326
 
327
   -- New Model-Oriented Attributes.
328
   --
329
   -- Check the S'Model_Small attribute.
330
 
331
   if Not_Equal
332
        (Float'Model_Small,
333
         Float(Float'Machine_Radix)**(Float'Model_Emin-1),
334
         TC_Tolerance)
335
   then
336
      Report.Failed("Incorrect result from the 'Model_Small attribute");
337
   end if;
338
 
339
 
340
   Report.Result;
341
 
342
end CXA5015;

powered by: WebSVN 2.1.0

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