3 -- Grant of Unlimited Rights
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
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.
26 -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27 -- (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITH
31 -- JRK 08/31/87 CREATED ORIGINAL TEST.
32 -- WMC 03/13/92 REVISED TYPE'SIZE CHECKS.
33 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
35 WITH SYSTEM
; USE SYSTEM
;
36 WITH REPORT
; USE REPORT
;
42 MAX_LEN
: CONSTANT := 10;
44 SUBTYPE LENGTH
IS NATURAL RANGE 0 .. MAX_LEN
;
46 TYPE PARENT
(B
: BOOLEAN := TRUE; L
: LENGTH
:= 1) IS PRIVATE;
48 FUNCTION CREATE
( B
: BOOLEAN;
54 X
: PARENT
-- TO RESOLVE OVERLOADING.
57 FUNCTION CON
( B
: BOOLEAN;
64 FUNCTION CON
( B
: BOOLEAN;
72 TYPE PARENT
(B
: BOOLEAN := TRUE; L
: LENGTH
:= 1) IS
88 TYPE T
IS NEW PARENT
(IDENT_BOOL
(TRUE), IDENT_INT
(3));
94 PROCEDURE A
(X
: ADDRESS
) IS
96 B
:= IDENT_BOOL
(TRUE);
114 RETURN (TRUE, L
, I
, S
, J
);
116 RETURN (FALSE, L
, I
, F
);
129 RETURN (TRUE, L
, I
, S
, J
);
140 RETURN (FALSE, L
, I
, F
);
146 TEST
("C34009D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
147 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
148 "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
150 X
:= CON
(TRUE, 3, 2, "AAA", 2);
151 W
:= CON
(TRUE, 3, 2, "AAA", 2);
154 X
:= CON
(TRUE, 3, 1, "ABC", 4);
156 IF X
/= CON
(TRUE, 3, 1, "ABC", 4) THEN
157 FAILED
("INCORRECT :=");
160 IF T
'(X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
161 FAILED ("INCORRECT QUALIFICATION");
164 IF T (X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
165 FAILED ("INCORRECT SELF CONVERSION");
169 W := CON (TRUE, 3, 1, "ABC", 4);
171 IF T (W) /= CON (TRUE, 3, 1, "ABC", 4) THEN
172 FAILED ("INCORRECT CONVERSION FROM PARENT");
175 IF PARENT (X) /= CON (TRUE, 3, 1, "ABC", 4) OR
176 PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
177 CON (FALSE, 2, 3, 6.0) THEN
178 FAILED ("INCORRECT CONVERSION TO PARENT");
181 IF X.B /= TRUE OR X.L /= 3 OR
182 CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
183 CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
184 FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
187 IF X = CON (TRUE, 3, 1, "ABC", 5) OR
188 X = CON (FALSE, 2, 3, 6.0) THEN
189 FAILED ("INCORRECT =");
192 IF X /= CON (TRUE, 3, 1, "ABC", 4) OR
193 NOT (X /= CON (FALSE, 2, 3, 6.0)) THEN
194 FAILED ("INCORRECT /=");
197 IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
198 FAILED ("INCORRECT ""IN""");
201 IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
202 FAILED ("INCORRECT ""NOT IN""");
208 FAILED ("INCORRECT 'ADDRESS
");
211 IF NOT X'CONSTRAINED THEN
212 FAILED ("INCORRECT OBJECT
'CONSTRAINED");
216 FAILED ("INCORRECT
TYPE'SIZE");
219 IF X'SIZE < T'SIZE OR
220 X.B'SIZE < BOOLEAN'SIZE OR
221 X.L'SIZE < LENGTH'SIZE THEN
222 FAILED ("INCORRECT OBJECT
'SIZE");