|
111
|
1 -- C45331A.ADA
|
|
|
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 -- CHECK THAT FOR FIXED POINT TYPES THE OPERATORS "+" AND "-" PRODUCE
|
|
|
26 -- CORRECT RESULTS WHEN:
|
|
|
27 -- (A) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS.
|
|
|
28 -- (B) A IS A MODEL NUMBER BUT B, A+B, AND A-B ARE NOT.
|
|
|
29 -- (C) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS WITH DIFFERENT
|
|
|
30 -- SUBTYPES.
|
|
|
31
|
|
|
32 -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
|
|
|
33
|
|
|
34 -- WRG 8/27/86
|
|
|
35 -- KAS 11/14/95 REDUCE EXPECTATION FOR T'SMALL
|
|
|
36 -- KAS 11/30/95 ONE MORE CHANGE...
|
|
|
37 -- PWN 02/28/96 CLEANED COMMENTS FOR RELEASE
|
|
|
38 -- KAS 03/18/96 ELIDED TWO 'SMALL CASES FOR 2.1
|
|
|
39
|
|
|
40 WITH REPORT; USE REPORT;
|
|
|
41 PROCEDURE C45331A IS
|
|
|
42
|
|
|
43 TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
|
|
|
44 -- 'MANTISSA = 23.
|
|
|
45 SUBTYPE F IS LIKE_DURATION DELTA 0.25 RANGE -1000.0 .. 1000.0;
|
|
|
46 SUBTYPE ST_F1 IS LIKE_DURATION DELTA 0.5 RANGE -4.0 .. 3.0;
|
|
|
47 SUBTYPE ST_F2 IS LIKE_DURATION DELTA 1.0 / 16
|
|
|
48 RANGE -13.0 / 16 .. 5.0 + 1.0 / 16;
|
|
|
49
|
|
|
50 BEGIN
|
|
|
51
|
|
|
52 TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " &
|
|
|
53 "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " &
|
|
|
54 "RESULTS - BASIC TYPES");
|
|
|
55
|
|
|
56 -------------------------------------------------------------------
|
|
|
57
|
|
|
58 A: DECLARE
|
|
|
59 SMALL, MAX, MIN, ZERO : F := 0.5;
|
|
|
60 X : F := 0.0;
|
|
|
61 BEGIN
|
|
|
62 -- INITIALIZE "CONSTANTS":
|
|
|
63 IF EQUAL (3, 3) THEN
|
|
|
64 SMALL := F'SMALL;
|
|
|
65 MAX := F'LAST; -- BECAUSE F'LAST < F'LARGE AND F'LAST
|
|
|
66 -- IS A MODEL NUMBER.
|
|
|
67 MIN := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
|
|
|
68 ZERO := 0.0;
|
|
|
69 END IF;
|
|
|
70
|
|
|
71 -- CHECK SMALL + OR - ZERO = SMALL:
|
|
|
72 IF "+"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
|
|
|
73 0.0 + SMALL /= SMALL THEN
|
|
|
74 FAILED ("F'SMALL + 0.0 /= F'SMALL");
|
|
|
75 END IF;
|
|
|
76 IF "-"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
|
|
|
77 SMALL - 0.0 /= SMALL THEN
|
|
|
78 FAILED ("F'SMALL - 0.0 /= F'SMALL");
|
|
|
79 END IF;
|
|
|
80
|
|
|
81 -- CHECK MAX + OR - ZERO = MAX:
|
|
|
82 IF MAX + ZERO /= MAX OR 0.0 + MAX /= MAX THEN
|
|
|
83 FAILED ("F'LAST + 0.0 /= F'LAST");
|
|
|
84 END IF;
|
|
|
85 IF MAX - ZERO /= MAX OR MAX - 0.0 /= MAX THEN
|
|
|
86 FAILED ("F'LAST - 0.0 /= F'LAST");
|
|
|
87 END IF;
|
|
|
88
|
|
|
89 -- CHECK SMALL - SMALL = 0.0:
|
|
|
90 IF EQUAL (3, 3) THEN
|
|
|
91 X := SMALL;
|
|
|
92 END IF;
|
|
|
93 IF SMALL - X /= 0.0 OR SMALL - SMALL /= 0.0 OR
|
|
|
94 F'SMALL - F'SMALL /= 0.0 THEN
|
|
|
95 FAILED ("F'SMALL - F'SMALL /= 0.0");
|
|
|
96 END IF;
|
|
|
97
|
|
|
98 -- CHECK MAX - MAX = 0.0:
|
|
|
99 IF EQUAL (3, 3) THEN
|
|
|
100 X := MAX;
|
|
|
101 END IF;
|
|
|
102 IF MAX - X /= 0.0 OR MAX - MAX /= 0.0 OR
|
|
|
103 F'LAST - F'LAST /= 0.0 THEN
|
|
|
104 FAILED ("F'LAST - F'LAST /= 0.0");
|
|
|
105 END IF;
|
|
|
106
|
|
|
107 -- CHECK ZERO - MAX = MIN, MIN - MIN = 0.0,
|
|
|
108 -- AND MIN + MAX = 0.0:
|
|
|
109 IF EQUAL (3, 3) THEN
|
|
|
110 X := ZERO - MAX;
|
|
|
111 END IF;
|
|
|
112 IF X /= MIN THEN
|
|
|
113 FAILED ("0.0 - 1000.0 /= -1000.0");
|
|
|
114 END IF;
|
|
|
115 IF EQUAL (3, 3) THEN
|
|
|
116 X := MIN;
|
|
|
117 END IF;
|
|
|
118 IF MIN - X /= 0.0 OR MIN - MIN /= 0.0 OR
|
|
|
119 F'FIRST - F'FIRST /= 0.0 THEN
|
|
|
120 FAILED ("F'FIRST - F'FIRST /= 0.0");
|
|
|
121 END IF;
|
|
|
122 IF MIN + MAX /= 0.0 OR MAX + MIN /= 0.0 OR
|
|
|
123 F'FIRST + F'LAST /= 0.0 THEN
|
|
|
124 FAILED ("-1000.0 + 1000.0 /= 0.0");
|
|
|
125 END IF;
|
|
|
126
|
|
|
127 -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
|
|
|
128 -- NUMBERS:
|
|
|
129 IF EQUAL (3, 3) THEN
|
|
|
130 X := 100.75;
|
|
|
131 END IF;
|
|
|
132 IF (X + SMALL) /= (SMALL + X) OR
|
|
|
133 (X + SMALL) > (X + 0.25) THEN -- X + SMALL SB <= X + DELTA
|
|
|
134 FAILED("X + SMALL DELIVERED BAD RESULT");
|
|
|
135 END IF;
|
|
|
136
|
|
|
137 -- CHECK (MAX - SMALL) + SMALL = MAX:
|
|
|
138 IF EQUAL (3, 3) THEN
|
|
|
139 X := MAX - SMALL;
|
|
|
140 END IF;
|
|
|
141 IF X + SMALL /= MAX THEN
|
|
|
142 FAILED("(MAX - SMALL) + SMALL /= MAX");
|
|
|
143 END IF;
|
|
|
144
|
|
|
145 EXCEPTION
|
|
|
146 WHEN OTHERS =>
|
|
|
147 FAILED ("EXCEPTION RAISED - A");
|
|
|
148 END A;
|
|
|
149
|
|
|
150 -------------------------------------------------------------------
|
|
|
151
|
|
|
152 B: DECLARE
|
|
|
153 NON_MODEL_CONST : CONSTANT := 2.0 / 3;
|
|
|
154 NON_MODEL_VAR : F := 0.0;
|
|
|
155
|
|
|
156 SMALL, MAX, MIN, ZERO : F := 0.5;
|
|
|
157 X : F := 0.0;
|
|
|
158 BEGIN
|
|
|
159 -- INITIALIZE "CONSTANTS":
|
|
|
160 IF EQUAL (3, 3) THEN
|
|
|
161 SMALL := F'SMALL;
|
|
|
162 MAX := F'LAST; -- BECAUSE F'LAST < F'LARGE AND
|
|
|
163 -- F'LAST IS A MODEL NUMBER.
|
|
|
164 MIN := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
|
|
|
165 ZERO := 0.0;
|
|
|
166 NON_MODEL_VAR := NON_MODEL_CONST;
|
|
|
167 END IF;
|
|
|
168
|
|
|
169 -- CHECK VALUE OF NON_MODEL_VAR:
|
|
|
170 IF NON_MODEL_VAR NOT IN 0.5 .. 0.75 THEN
|
|
|
171 FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE");
|
|
|
172 END IF;
|
|
|
173
|
|
|
174 -- CHECK NON-MODEL VALUE + OR - ZERO:
|
|
|
175 IF NON_MODEL_VAR + ZERO NOT IN 0.5 .. 0.75 OR
|
|
|
176 F'(0.0) + NON_MODEL_CONST NOT IN 0.5 .. 0.75 THEN
|
|
|
177 FAILED ("(2.0 / 3) + 0.0 NOT IN 0.5 .. 0.75");
|
|
|
178 END IF;
|
|
|
179 IF NON_MODEL_VAR - ZERO NOT IN 0.5 .. 0.75 OR
|
|
|
180 NON_MODEL_CONST - F'(0.0) NOT IN 0.5 .. 0.75 THEN
|
|
|
181 FAILED ("(2.0 / 3) - 0.0 NOT IN 0.5 .. 0.75");
|
|
|
182 END IF;
|
|
|
183
|
|
|
184 -- CHECK ZERO - NON-MODEL:
|
|
|
185 IF F'(0.0) - NON_MODEL_CONST NOT IN -0.75 .. -0.5 THEN
|
|
|
186 FAILED ("0.0 - (2.0 / 3) NOT IN -0.75 .. -0.5");
|
|
|
187 END IF;
|
|
|
188
|
|
|
189 IF F'(1.0) - NON_MODEL_CONST NOT IN 0.25 .. 0.5 THEN
|
|
|
190 FAILED ("1.0 - (2.0 / 3) NOT IN 0.25 .. 0.5");
|
|
|
191 END IF;
|
|
|
192
|
|
|
193 -- CHECK ADDITION AND SUBTRACTION OF NON-MODEL NEAR MIN AND
|
|
|
194 -- MAX:
|
|
|
195 IF MIN + NON_MODEL_VAR NOT IN -999.5 .. -999.25 OR
|
|
|
196 NON_MODEL_CONST + F'FIRST NOT IN -999.5 .. -999.25 THEN
|
|
|
197 FAILED ("-1000.0 + (2.0 / 3) NOT IN -999.5 .. -999.25");
|
|
|
198 END IF;
|
|
|
199 IF MAX - NON_MODEL_VAR NOT IN 999.25 .. 999.5 OR
|
|
|
200 F'LAST - NON_MODEL_CONST NOT IN 999.25 .. 999.5 THEN
|
|
|
201 FAILED ("1000.0 - (2.0 / 3) NOT IN 999.25 .. 999.5");
|
|
|
202 END IF;
|
|
|
203
|
|
|
204 -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
|
|
|
205 -- MODEL NUMBER WITH NON-MODEL:
|
|
|
206 IF EQUAL (3, 3) THEN
|
|
|
207 X := -213.25;
|
|
|
208 END IF;
|
|
|
209 IF X + NON_MODEL_CONST NOT IN -212.75 .. -212.5 THEN
|
|
|
210 FAILED ("-213.25 + (2.0 / 3) NOT IN -212.75 .. -212.5");
|
|
|
211 END IF;
|
|
|
212 IF NON_MODEL_VAR - X NOT IN 213.75 .. 214.0 THEN
|
|
|
213 FAILED ("(2.0 / 3) - (-213.25) NOT IN 213.75 .. 214.0");
|
|
|
214 END IF;
|
|
|
215
|
|
|
216 EXCEPTION
|
|
|
217 WHEN OTHERS =>
|
|
|
218 FAILED ("EXCEPTION RAISED - B");
|
|
|
219 END B;
|
|
|
220
|
|
|
221 -------------------------------------------------------------------
|
|
|
222
|
|
|
223 C: DECLARE
|
|
|
224 A_SMALL, A_MAX, A_MIN : ST_F1 := 0.0;
|
|
|
225 B_SMALL, B_MAX, B_MIN : ST_F2 := 0.0;
|
|
|
226 X : F;
|
|
|
227 BEGIN
|
|
|
228 -- INITIALIZE "CONSTANTS":
|
|
|
229 IF EQUAL (3, 3) THEN
|
|
|
230 A_SMALL := ST_F1'SMALL;
|
|
|
231 A_MAX := ST_F1'LAST; -- BECAUSE 'LAST < 'LARGE AND
|
|
|
232 -- 'LAST IS A MODEL NUMBER.
|
|
|
233 A_MIN := ST_F1'FIRST; -- 'FIRST IS A MODEL NUMBER.
|
|
|
234
|
|
|
235 B_SMALL := ST_F2'SMALL;
|
|
|
236 B_MAX := ST_F2'LAST; -- BECAUSE 'LAST <= 'LARGE AND
|
|
|
237 -- 'LAST IS A MODEL NUMBER.
|
|
|
238 B_MIN := ST_F2'FIRST; -- 'FIRST IS A MODEL NUMBER.
|
|
|
239 END IF;
|
|
|
240
|
|
|
241 IF A_MIN + B_MIN /= -4.8125 THEN
|
|
|
242 FAILED ("-4.0 + (-0.8125) /= -4.8125");
|
|
|
243 END IF;
|
|
|
244
|
|
|
245 IF A_MIN - B_MIN /= -3.1875 THEN
|
|
|
246 FAILED ("-4.0 - (-0.8125) /= -3.1875");
|
|
|
247 END IF;
|
|
|
248
|
|
|
249 IF (A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375 THEN
|
|
|
250 FAILED ("(A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375");
|
|
|
251 END IF;
|
|
|
252
|
|
|
253 IF (A_MIN - B_SMALL) NOT IN -4.0625 .. -4.0 THEN
|
|
|
254 FAILED ("(A_MIN - B_SMALL) NOT IN -4.0 .. -4.0625");
|
|
|
255 END IF;
|
|
|
256
|
|
|
257 IF A_MIN + B_MAX /= 1.0625 THEN
|
|
|
258 FAILED ("-4.0 + 5.0625 /= 1.0625");
|
|
|
259 END IF;
|
|
|
260
|
|
|
261 IF A_MIN - B_MAX /= -9.0625 THEN
|
|
|
262 FAILED ("-4.0 - 5.0625 /= -9.0625");
|
|
|
263 END IF;
|
|
|
264
|
|
|
265 IF (A_SMALL + B_MIN) NOT IN B_MIN..-0.3125 THEN
|
|
|
266 FAILED ("(A_SMALL + B_MIN) NOT IN B_MIN..-0.3125");
|
|
|
267 END IF;
|
|
|
268
|
|
|
269 IF (A_SMALL - B_MIN) NOT IN +0.8125 .. 1.3125 THEN
|
|
|
270 FAILED ("(A_SMALL - B_MIN) NOT IN -0.8125 .. 1.3125");
|
|
|
271 END IF;
|
|
|
272
|
|
|
273
|
|
|
274
|
|
|
275 IF (A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625 THEN
|
|
|
276 FAILED ("(A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625");
|
|
|
277 END IF;
|
|
|
278
|
|
|
279 IF (A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625 THEN
|
|
|
280 FAILED ("(A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625");
|
|
|
281 END IF;
|
|
|
282
|
|
|
283 IF A_MAX + B_MIN /= 2.1875 THEN
|
|
|
284 FAILED ("3.0 + (-0.8125) /= 2.1875");
|
|
|
285 END IF;
|
|
|
286
|
|
|
287 IF A_MAX - B_MIN /= 3.8125 THEN
|
|
|
288 FAILED ("3.0 - (-0.8125) /= 3.8125");
|
|
|
289 END IF;
|
|
|
290
|
|
|
291 IF (A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625 THEN
|
|
|
292 FAILED ("(A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625");
|
|
|
293 END IF;
|
|
|
294
|
|
|
295 IF (A_MAX - B_SMALL) NOT IN 2.9375..3.0 THEN
|
|
|
296 FAILED ("(A_MAX - B_SMALL) NOT IN 2.9375..3.0");
|
|
|
297 END IF;
|
|
|
298
|
|
|
299 IF A_MAX + B_MAX /= 8.0625 THEN
|
|
|
300 FAILED ("3.0 + 5.0625 /= 8.0625");
|
|
|
301 END IF;
|
|
|
302
|
|
|
303 IF A_MAX - B_MAX /= -2.0625 THEN
|
|
|
304 FAILED ("3.0 - 5.0625 /= -2.0625");
|
|
|
305 END IF;
|
|
|
306
|
|
|
307 X := B_MIN - A_MIN;
|
|
|
308 IF X NOT IN 3.0 .. 3.25 THEN
|
|
|
309 FAILED ("-0.8125 - (-4.0) NOT IN RANGE");
|
|
|
310 END IF;
|
|
|
311
|
|
|
312 X := B_MIN - A_SMALL;
|
|
|
313 IF X NOT IN -1.3125 .. -0.8125 THEN
|
|
|
314 FAILED ("B_MIN - A_SMALL NOT IN RANGE");
|
|
|
315 END IF;
|
|
|
316
|
|
|
317 X := B_MIN - A_MAX;
|
|
|
318 IF X NOT IN -4.0 .. -3.75 THEN
|
|
|
319 FAILED ("-0.8125 - 3.0 NOT IN RANGE");
|
|
|
320 END IF;
|
|
|
321
|
|
|
322 X := B_SMALL - A_MIN;
|
|
|
323 IF X NOT IN 4.0 .. 4.0625 THEN
|
|
|
324 FAILED ("B_SMALL - A_MIN NOT IN RANGE");
|
|
|
325 END IF;
|
|
|
326
|
|
|
327
|
|
|
328 X := B_SMALL - A_MAX;
|
|
|
329 IF X NOT IN -3.0 .. -2.75 THEN
|
|
|
330 FAILED ("B_SMALL - A_MAX NOT IN RANGE");
|
|
|
331 END IF;
|
|
|
332
|
|
|
333 X := B_MAX - A_MIN;
|
|
|
334 IF X NOT IN 9.0 .. 9.25 THEN
|
|
|
335 FAILED ("5.0625 - (-4.0) NOT IN RANGE");
|
|
|
336 END IF;
|
|
|
337
|
|
|
338 X := B_MAX - A_SMALL;
|
|
|
339 IF X NOT IN 4.56 .. 5.0625 THEN
|
|
|
340 FAILED ("5.0625 - 0.5 NOT IN RANGE");
|
|
|
341 END IF;
|
|
|
342
|
|
|
343 X := B_MAX - A_MAX;
|
|
|
344 IF X NOT IN 2.0 .. 2.25 THEN
|
|
|
345 FAILED ("5.0625 - 3.0 NOT IN RANGE");
|
|
|
346 END IF;
|
|
|
347
|
|
|
348 EXCEPTION
|
|
|
349 WHEN OTHERS =>
|
|
|
350 FAILED ("EXCEPTION RAISED - C");
|
|
|
351 END C;
|
|
|
352
|
|
|
353 -------------------------------------------------------------------
|
|
|
354
|
|
|
355 RESULT;
|
|
|
356
|
|
|
357 END C45331A;
|
