1-- C45651A.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-- OBJECTIVE:
26--     FOR FIXED POINT TYPES, CHECK:
27--          (A) FOR MODEL NUMBERS A >= 0.0, THAT ABS A = A.
28--          (B) FOR MODEL NUMBERS A <= 0.0. THAT ABS A = -A.
29--          (C) FOR NON-MODEL NUMBERS A > 0.0, THAT ABS A VALUES ARE
30--              WITHIN THE APPROPRIATE MODEL INTERVAL.
31--          (D) FOR NON-MODEL NUMBERS A < 0.0, THAT ABS A VALUES ARE
32--              WITHIN THE APPROPRIATE MODEL INTERVAL.
33
34--     CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF
35--     DURATION'BASE.
36
37-- HISTORY:
38--     WRG 9/11/86
39--     PWB 3/31/88  CHANGED RANGE FOR MEMBERSHIP TEST INVOLVING
40--                  ABS (DECIMAL_M4'FIRST + DECIMAL_M4'SMALL / 2).
41--     RJW 8/21/89  REMOVED CHECKS INVOLVING HARD-CODED FIXED-POINT
42--                  UPPER BOUNDS WHICH WERE INCORRECT FOR SOME
43--                  IMPLEMENTATIONS.  REVISED HEADER.
44--     PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.
45--     KAS 11/14/95 REMOVED CASES THAT DEPEND ON SPECIFIC VALUE FOR 'SMALL
46--     TMB 11/19/94 REMOVED CASES RELATING TO 3.5.9(8) RULES - SMALL
47--                  MAY BE LESS THAN OR EQUAL TO DELTA FOR FIXED POINT.
48
49WITH REPORT; USE REPORT;
50PROCEDURE C45651A IS
51
52     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
53     -- 'MANTISSA VALUE.
54
55BEGIN
56
57     TEST ("C45651A", "CHECK THAT, FOR FIXED POINT TYPES, THE ABS " &
58                      "OPERATOR PRODUCES CORRECT RESULTS - BASIC " &
59                      "TYPES");
60
61     -------------------------------------------------------------------
62
63A:   DECLARE
64          TYPE LIKE_DURATION_M23 IS DELTA 0.020
65               RANGE -86_400.0 .. 86_400.0;
66
67          NON_MODEL_CONST : CONSTANT          := 2.0 / 3;
68          NON_MODEL_VAR   : LIKE_DURATION_M23 := 0.0;
69
70          SMALL, MAX, MIN, ZERO : LIKE_DURATION_M23 := 0.5;
71          X                     : LIKE_DURATION_M23 := 1.0;
72     BEGIN
73          -- INITIALIZE "CONSTANTS":
74          IF EQUAL (3, 3) THEN
75               SMALL         := LIKE_DURATION_M23'SMALL;
76               MAX           := LIKE_DURATION_M23'LAST;
77               MIN           := LIKE_DURATION_M23'FIRST;
78               ZERO          := 0.0;
79               NON_MODEL_VAR := NON_MODEL_CONST;
80          END IF;
81
82          -- (A)
83          IF EQUAL (3, 3) THEN
84               X := SMALL;
85          END IF;
86          IF ABS X /= SMALL OR X /= ABS LIKE_DURATION_M23'SMALL THEN
87               FAILED ("ABS (1.0 / 64) /= (1.0 / 64)");
88          END IF;
89          IF EQUAL (3, 3) THEN
90               X := MAX;
91          END IF;
92          IF ABS X /= MAX OR X /= ABS LIKE_DURATION_M23'LAST THEN
93               FAILED ("ABS 86_400.0 /= 86_400.0");
94          END IF;
95
96          -- (B)
97          IF EQUAL (3, 3) THEN
98               X := -SMALL;
99          END IF;
100          IF ABS X /= SMALL OR
101             ABS (-LIKE_DURATION_M23'SMALL) /= SMALL THEN
102               FAILED ("ABS -(1.0 / 64) /= (1.0 / 64)");
103          END IF;
104          IF EQUAL (3, 3) THEN
105               X := MIN;
106          END IF;
107          IF ABS X /= MAX OR ABS LIKE_DURATION_M23'FIRST /= MAX THEN
108               FAILED ("ABS -86_400.0 /= 86_400.0");
109          END IF;
110
111          -- (A) AND (B)
112          IF EQUAL (3, 3) THEN
113               X := 0.0;
114          END IF;
115          IF "ABS" (RIGHT => X) /= ZERO OR X /= ABS 0.0 THEN
116               FAILED ("ABS 0.0 /= 0.0 -- (LIKE_DURATION_M23)");
117          END IF;
118
119          -- CHECK THAT VALUE OF NON_MODEL_VAR IS IN THE RANGE
120          -- 42 * 'SMALL .. 43 * 'SMALL:
121          IF NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 THEN
122               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
123                       "- A");
124          END IF;
125
126          -- (C)
127          IF ABS NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 OR
128             ABS LIKE_DURATION_M23'(NON_MODEL_CONST) NOT IN
129                 0.65625 .. 0.671875 THEN
130               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - A");
131          END IF;
132          IF EQUAL (3, 3) THEN
133               X := 86_399.992_187_5;  -- LIKE_DURATION_M23'LAST -
134                                       -- 1.0 / 128.
135          END IF;
136          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
137             ABS (LIKE_DURATION_M23'LAST - LIKE_DURATION_M23'SMALL / 2)
138                 NOT IN 86_399.984_375 .. 86_400.0 THEN
139               FAILED ("ABS (LIKE_DURATION_M23'LAST - " &
140                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
141                       "RANGE");
142          END IF;
143
144          -- (D)
145          IF EQUAL (3, 3) THEN
146               X := -NON_MODEL_CONST;
147          END IF;
148          IF ABS X NOT IN 0.65625 .. 0.671875 OR
149             ABS (-LIKE_DURATION_M23'(NON_MODEL_CONST)) NOT IN
150                 0.65625 .. 0.671875 THEN
151               FAILED ("ABS (-2.0 / 3) NOT IN CORRECT RANGE - A");
152          END IF;
153          IF EQUAL (3, 3) THEN
154               X := -86_399.992_187_5;  -- LIKE_DURATION_M23'FIRST +
155                                        -- 1.0 / 128.
156          END IF;
157          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
158             ABS (LIKE_DURATION_M23'FIRST + LIKE_DURATION_M23'SMALL / 2)
159                 NOT IN 86_399.984_375 .. 86_400.0 THEN
160               FAILED ("ABS (LIKE_DURATION_M23'FIRST +" &
161                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
162                       "RANGE");
163          END IF;
164     END A;
165
166     -------------------------------------------------------------------
167
168B:   DECLARE
169          TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
170
171          NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
172          NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
173
174          SMALL, MAX, MIN, ZERO : DECIMAL_M4 := 128.0;
175          X                     : DECIMAL_M4 :=   0.0;
176     BEGIN
177          -- INITIALIZE "CONSTANTS":
178          IF EQUAL (3, 3) THEN
179               SMALL         :=  DECIMAL_M4'SMALL;
180               ZERO          :=  0.0;
181               NON_MODEL_VAR := NON_MODEL_CONST;
182          END IF;
183
184          -- (A)
185          IF EQUAL (3, 3) THEN
186               X := SMALL;
187          END IF;
188          IF ABS X /= SMALL OR X /= ABS DECIMAL_M4'SMALL THEN
189               FAILED ("ABS 64.0 /= 64.0");
190          END IF;
191
192          -- (B)
193          IF EQUAL (3, 3) THEN
194               X := -SMALL;
195          END IF;
196          IF ABS X /= SMALL OR ABS (-DECIMAL_M4'SMALL) /= SMALL THEN
197               FAILED ("ABS -64.0 /= 64.0");
198          END IF;
199
200          -- (A) AND (B)
201          IF EQUAL (3, 3) THEN
202               X := 0.0;
203          END IF;
204          IF ABS X /= ZERO OR X /= ABS 0.0 THEN
205               FAILED ("ABS 0.0 /= 0.0 -- (DECIMAL_M4)");
206          END IF;
207
208          -- CHECK THE VALUE OF NON_MODEL_VAR:
209          IF NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
210               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
211                       "- B");
212          END IF;
213
214          -- (C)
215          IF ABS NON_MODEL_VAR NOT IN 0.0 .. 64.0 OR
216             ABS DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 THEN
217               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - B");
218          END IF;
219          IF EQUAL (3, 3) THEN
220               X := 37.0;  -- INTERVAL IS 0.0 .. 64.0.
221          END IF;
222          IF EQUAL (3, 3) THEN
223               X := 928.0;
224          END IF;
225
226          -- (D)
227          IF EQUAL (3, 3) THEN
228               X := -NON_MODEL_CONST;
229          END IF;
230          IF ABS X NOT IN 0.0 .. 64.0 OR
231             ABS (-DECIMAL_M4'(NON_MODEL_CONST)) NOT IN 0.0 .. 64.0 THEN
232               FAILED ("ABS -(2.0 / 3) NOT IN CORRECT RANGE - B");
233          END IF;
234          IF EQUAL (3, 3) THEN
235               X := -37.0;  -- INTERVAL IS -SMALL .. 0.0.
236          END IF;
237          IF EQUAL (3, 3) THEN
238               X := -928.0;
239          END IF;
240     END B;
241
242     -------------------------------------------------------------------
243
244     RESULT;
245
246END C45651A;
247