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 LIMITED PRIVATE TYPES WITH
31 -- JRK 09/01/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
:= 3) IS
49 FUNCTION CREATE
( B
: BOOLEAN;
55 X
: PARENT
-- TO RESOLVE OVERLOADING.
58 FUNCTION CON
( B
: BOOLEAN;
65 FUNCTION CON
( B
: BOOLEAN;
71 FUNCTION EQUAL
(X
, Y
: PARENT
) RETURN BOOLEAN;
73 PROCEDURE ASSIGN
(X
: OUT PARENT
; Y
: PARENT
);
77 TYPE PARENT
(B
: BOOLEAN := TRUE; L
: LENGTH
:= 3) IS
82 S
: STRING (1 .. L
) := (1 .. L
=> 'A');
93 TYPE T
IS NEW PARENT
(IDENT_BOOL
(TRUE), IDENT_INT
(3));
99 PROCEDURE A
(X
: ADDRESS
) IS
101 B
:= IDENT_BOOL
(TRUE);
119 RETURN (TRUE, L
, I
, S
, J
);
121 RETURN (FALSE, L
, I
, F
);
134 RETURN (TRUE, L
, I
, S
, J
);
145 RETURN (FALSE, L
, I
, F
);
148 FUNCTION EQUAL
(X
, Y
: PARENT
) RETURN BOOLEAN IS
153 PROCEDURE ASSIGN
(X
: OUT PARENT
; Y
: PARENT
) IS
161 TEST
("C34009J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
162 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
163 "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
166 ASSIGN
(X
, CON
(TRUE, 3, 1, "ABC", 4));
168 IF NOT EQUAL
(T
'(X), CON (TRUE, 3, 1, "ABC", 4)) THEN
169 FAILED ("INCORRECT QUALIFICATION");
172 IF NOT EQUAL (T (X), CON (TRUE, 3, 1, "ABC", 4)) THEN
173 FAILED ("INCORRECT SELF CONVERSION");
177 ASSIGN (W, CON (TRUE, 3, 1, "ABC", 4));
179 IF NOT EQUAL (T (W), CON (TRUE, 3, 1, "ABC", 4)) THEN
180 FAILED ("INCORRECT CONVERSION FROM PARENT");
183 IF NOT EQUAL (PARENT (X), CON (TRUE, 3, 1, "ABC", 4)) OR
184 NOT EQUAL (PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)),
185 CON (FALSE, 2, 3, 6.0)) THEN
186 FAILED ("INCORRECT CONVERSION TO PARENT");
189 IF X.B /= TRUE OR X.L /= 3 OR
190 CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
191 CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
192 FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
195 IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
196 FAILED ("INCORRECT ""IN""");
199 IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
200 FAILED ("INCORRECT ""NOT IN""");
206 FAILED ("INCORRECT 'ADDRESS
");
210 IF NOT X'CONSTRAINED THEN
211 FAILED ("INCORRECT OBJECT
'CONSTRAINED");
215 FAILED ("INCORRECT
TYPE'SIZE");
218 IF X'SIZE < T'SIZE OR
219 X.B'SIZE < BOOLEAN'SIZE OR
220 X.L'SIZE < LENGTH'SIZE THEN
221 FAILED ("INCORRECT OBJECT
'SIZE");