1-- C45231B.DEP
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--     CHECK THAT THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
27--     CORRECT RESULTS FOR PREDEFINED TYPE SHORT_INTEGER (INCLUDING
28--     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
29
30--     SUBTESTS ARE:
31--       (A). TESTS FOR RELATIONAL OPERATORS.
32--       (B). TESTS FOR MEMBERSHIP OPERATORS.
33--       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
34--            RELATIONAL OPERATORS ARE REDEFINED.
35
36-- APPLICABILITY CRITERIA:
37--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH
38--     SUPPORT SHORT_INTEGER.
39
40--     IF "SHORT_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
41--     "CHECK_SHORT" MUST BE REJECTED.
42
43-- HISTORY:
44--     RJW 02/04/86 CREATED ORIGINAL TEST.
45--     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
46
47WITH REPORT; USE REPORT;
48
49PROCEDURE C45231B IS
50
51     CHECK_SHORT : SHORT_INTEGER;                       -- N/A => ERROR.
52
53     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
54     BEGIN
55          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
56     END IDENT;
57
58BEGIN
59
60     TEST ( "C45231B", "CHECK THAT THE RELATIONAL AND " &
61                       "MEMBERSHIP OPERATIONS YIELD CORRECT " &
62                       "RESULTS FOR PREDEFINED TYPE SHORT_INTEGER " &
63                       "(INCLUDING THE CASE IN WHICH THE " &
64                       "RELATIONAL OPERATORS ARE REDEFINED)" );
65
66     DECLARE -- (A)
67
68          I1A, I1B   : SHORT_INTEGER          := IDENT (1);
69          I2         : SHORT_INTEGER          := IDENT (2);
70          CI2        : CONSTANT SHORT_INTEGER := 2;
71
72
73     BEGIN -- (A)
74
75          IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
76               NULL;
77          ELSE
78               FAILED ( "RELATIONAL TEST - 1" );
79          END IF;
80
81          IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
82               NULL;
83          ELSE
84               FAILED ( "RELATIONAL TEST - 2" );
85          END IF;
86
87          IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
88               NULL;
89          ELSE
90               FAILED ( "RELATIONAL TEST - 3" );
91          END IF;
92
93          IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
94               NULL;
95          ELSE
96               FAILED ( "RELATIONAL TEST - 4");
97          END IF;
98
99          IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
100               NULL;
101          ELSE
102               FAILED ( "RELATIONAL TEST - 5" );
103          END IF;
104
105          IF (I1A >= I1B) AND (I1A <= I1B) THEN
106               NULL;
107          ELSE
108               FAILED ( "RELATIONAL TEST - 6" );
109          END IF;
110
111          IF ">" (LEFT => CI2, RIGHT => I1A) THEN
112               NULL;
113          ELSE
114               FAILED ( "RELATIONAL TEST - 7" );
115          END IF;
116
117          IF "<" (LEFT => I1A, RIGHT => I2) THEN
118               NULL;
119          ELSE
120               FAILED ( "RELATIONAL TEST - 8" );
121          END IF;
122
123          IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
124               NULL;
125          ELSE
126               FAILED ( "RELATIONAL TEST - 9 ");
127          END IF;
128
129          IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
130               NULL;
131          ELSE
132               FAILED ( "RELATIONAL TEST - 10 ");
133          END IF;
134
135          IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
136               NULL;
137          ELSE
138               FAILED ( "RELATIONAL TEST - 11 ");
139          END IF;
140
141          IF "/=" (LEFT => CI2, RIGHT => 4) THEN
142               NULL;
143          ELSE
144               FAILED ( "RELATIONAL TEST - 12 ");
145          END IF;
146
147     END; -- (A)
148
149     ----------------------------------------------------------------
150
151     DECLARE -- (B)
152
153          SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
154
155          I1 : SHORT_INTEGER := IDENT (1);
156          I5 : SHORT_INTEGER := IDENT (5);
157
158          CI2  : CONSTANT SHORT_INTEGER := 2;
159          CI10 : CONSTANT SHORT_INTEGER := 10;
160
161
162     BEGIN -- (B)
163
164          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
165               NULL;
166          ELSE
167               FAILED ( "MEMBERSHIP TEST - B.1" );
168          END IF;
169
170          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
171               NULL;
172          ELSE
173               FAILED ( "MEMBERSHIP TEST - B.2" );
174          END IF;
175
176          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
177               NULL;
178          ELSE
179               FAILED ( "MEMBERSHIP TEST - B.3" );
180          END IF;
181
182          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
183               NULL;
184          ELSE
185               FAILED ( "MEMBERSHIP TEST - B.4" );
186          END IF;
187
188          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
189               NULL;
190          ELSE
191               FAILED ( "MEMBERSHIP TEST - B.5" );
192          END IF;
193
194     END; -- (B)
195
196     -------------------------------------------------------------
197
198     DECLARE -- (C)
199
200          SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
201
202          I1 : SHORT_INTEGER := IDENT (1);
203          I5 : SHORT_INTEGER := IDENT (5);
204
205          CI2  : CONSTANT SHORT_INTEGER := 2;
206          CI10 : CONSTANT SHORT_INTEGER := 10;
207
208
209          FUNCTION ">" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
210          BEGIN
211               RETURN SHORT_INTEGER'POS (L) <= SHORT_INTEGER'POS (R);
212          END;
213
214          FUNCTION ">=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
215          BEGIN
216               RETURN SHORT_INTEGER'POS (L) < SHORT_INTEGER'POS (R);
217          END;
218
219          FUNCTION "<" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
220          BEGIN
221               RETURN  SHORT_INTEGER'POS (L) >= SHORT_INTEGER'POS (R);
222          END;
223
224          FUNCTION "<=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
225          BEGIN
226               RETURN SHORT_INTEGER'POS (L) > SHORT_INTEGER'POS (R);
227          END;
228
229     BEGIN -- (C)
230
231          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
232               NULL;
233          ELSE
234               FAILED ( "MEMBERSHIP TEST - C.1" );
235          END IF;
236
237          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
238               NULL;
239          ELSE
240               FAILED ( "MEMBERSHIP TEST - C.2" );
241          END IF;
242
243          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
244               NULL;
245          ELSE
246               FAILED ( "MEMBERSHIP TEST - C.3" );
247          END IF;
248
249          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
250               NULL;
251          ELSE
252               FAILED ( "MEMBERSHIP TEST - C.4" );
253          END IF;
254
255          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
256               NULL;
257          ELSE
258               FAILED ( "MEMBERSHIP TEST - C.5" );
259          END IF;
260
261     END; -- (C)
262
263     RESULT;
264
265END C45231B;
266