1-- C45251A.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 RELATIONAL OPERATIONS ON FIXED POINT TYPES THE
26-- FOLLOWING HOLD:
27--       (A) A /= B IS THE SAME AS NOT (A = B).
28--       (B) A < B IS THE SAME AS NOT (A >= B).
29--       (C) A > B IS THE SAME AS NOT (A <= B).
30--       (D) ADJACENT MODEL NUMBERS GIVE CORRECT RESULTS.
31--       (E) NON-MODEL NUMBERS WITH DISTINCT MODEL INTERVALS GIVE
32--           CORRECT RESULTS.
33--       (F) CASE WHERE MODEL INTERVALS INTERSECT IN A SINGLE MODEL
34--           NUMBER GIVES CORRECT RESULT.
35
36-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
37
38-- WRG 8/26/86
39
40WITH REPORT; USE REPORT;
41PROCEDURE C45251A IS
42
43     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
44     -- 'MANTISSA VALUE.
45
46     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
47     TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
48
49BEGIN
50
51     TEST ("C45251A", "CHECK RELATIONAL OPERATIONS FOR FIXED POINT " &
52                      "TYPES - BASIC TYPES");
53
54     -------------------------------------------------------------------
55
56     DECLARE
57          A, B : LIKE_DURATION_M23 := 0.0;
58          C, D : DECIMAL_M4        := 0.0;
59     BEGIN
60          IF EQUAL (3, 3) THEN
61               A := 2#0.0000_0011#; -- JUST BELOW LIKE_DURATION'SMALL.
62               B := 2#0.0000_0101#; -- JUST ABOVE LIKE_DURATION'SMALL.
63          END IF;
64
65          -- (A)
66          IF A /= B XOR NOT (A = B) THEN
67               FAILED ("A /= B IS NOT THE SAME AS NOT (A = B)");
68          END IF;
69
70          -- (B)
71          IF A < B XOR NOT (A >= B) THEN
72               FAILED ("A < B IS NOT THE SAME AS NOT (A >= B)");
73          END IF;
74
75          -- (C)
76          IF A > B XOR NOT (A <= B) THEN
77               FAILED ("A > B IS NOT THE SAME AS NOT (A <= B)");
78          END IF;
79
80          -- (D)
81          IF EQUAL (3, 3) THEN
82               A := -(16#1_5180.00#); -- (-86_400.0)
83               B := -(16#1_517F.FC#); -- (-86_400.0 + 1.0/64)
84
85               C :=  64.0; -- DECIMAL_M4'SMALL.
86               D := 128.0; -- 2 * DECIMAL_M4'SMALL.
87          END IF;
88          IF "=" (LEFT => A, RIGHT => B) THEN
89               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
90                       "- (A = B)");
91          END IF;
92          IF NOT "/=" (LEFT => C, RIGHT => D) THEN
93               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
94                       "- (C /= D)");
95          END IF;
96          IF "<" (LEFT => B, RIGHT => A) THEN
97               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
98                       "- (B < A)");
99          END IF;
100          IF ">" (LEFT => C, RIGHT => D) THEN
101               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
102                       "- (C > D)");
103          END IF;
104          IF ">=" (LEFT => A, RIGHT => B) THEN
105               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
106                       "- (A >= B)");
107          END IF;
108          IF "<=" (LEFT => D, RIGHT => C) THEN
109               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
110                       "- (D <= C)");
111          END IF;
112
113          -- (E)
114          IF EQUAL (3, 3) THEN
115               A :=  0.02;  -- INTERVAL IS  1.0/64 ..  2.0/64.
116               B := -0.02;  -- INTERVAL IS -2.0/64 .. -1.0/64.
117
118               C :=  800.0; -- INTERVAL IS 768.0 .. 832.0.
119               D :=  900.0; -- INTERVAL IS 896.0 .. 960.0.
120          END IF;
121          IF A = B THEN
122               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
123                       "INTERVALS GIVE INCORRECT RESULT - (A = B)");
124          END IF;
125          IF NOT (C /= D) THEN
126               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
127                       "INTERVALS GIVE INCORRECT RESULT - (C /= D)");
128          END IF;
129          IF A < B THEN
130               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
131                       "INTERVALS GIVE INCORRECT RESULT - (A < B)");
132          END IF;
133          IF C > D THEN
134               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
135                       "INTERVALS GIVE INCORRECT RESULT - (C > D)");
136          END IF;
137          IF B >= A THEN
138               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
139                       "INTERVALS GIVE INCORRECT RESULT - (B >= A)");
140          END IF;
141          IF D <= C THEN
142               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
143                       "INTERVALS GIVE INCORRECT RESULT - (D <= C)");
144          END IF;
145
146          -- (F)
147          IF EQUAL (3, 3) THEN
148               B := 0.035;  -- INTERVAL IS 2.0/64 .. 3.0/64.
149
150               C := 850.0;  -- INTERVAL IS 832.0 .. 896.0.
151          END IF;
152          IF NOT (A <= B) THEN
153               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
154                       "COMMON MODEL INTERVAL END-POINT GIVES " &
155                       "INCORRECT RESULT - (A <= B)");
156          END IF;
157          IF A > B THEN
158               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
159                       "COMMON MODEL INTERVAL END-POINT GIVES " &
160                       "INCORRECT RESULT - (A > B)");
161          END IF;
162          IF NOT (D >= C) THEN
163               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
164                       "COMMON MODEL INTERVAL END-POINT GIVES " &
165                       "INCORRECT RESULT - (D >= C)");
166          END IF;
167          IF D < C THEN
168               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
169                       "COMMON MODEL INTERVAL END-POINT GIVES " &
170                       "INCORRECT RESULT - (D < C)");
171          END IF;
172     END;
173
174     -------------------------------------------------------------------
175
176     RESULT;
177
178END C45251A;
179