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 ACCESS TYPES WHOSE DESIGNATED TYPE IS
28 -- NOT AN ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A TYPE WITH
32 -- JRK 09/24/86 CREATED ORIGINAL TEST.
33 -- BCB 10/21/87 CHANGED HEADER TO STANDARD FORMAT. REVISED TEST SO
34 -- T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
35 -- BCB 09/26/88 REMOVED COMPARISON INVOLVING OBJECT SIZE.
36 -- BCB 03/07/90 PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
37 -- THS 09/18/90 REMOVED DECLARATION OF B, MADE THE BODY OF
38 -- PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
39 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
41 WITH SYSTEM
; USE SYSTEM
;
42 WITH REPORT
; USE REPORT
;
46 TYPE DESIGNATED
IS RANGE -100 .. 100;
48 SUBTYPE SUBDESIGNATED
IS DESIGNATED
RANGE
49 DESIGNATED
'VAL (IDENT_INT
(-50)) ..
50 DESIGNATED
'VAL (IDENT_INT
( 50));
52 TYPE PARENT
IS ACCESS SUBDESIGNATED
RANGE
53 DESIGNATED
'VAL (IDENT_INT
(-30)) ..
54 DESIGNATED
'VAL (IDENT_INT
( 30));
58 X
: T
:= NEW DESIGNATED
'(-30);
59 K : INTEGER := X'SIZE;
60 Y : T := NEW DESIGNATED'( 30);
61 W
: PARENT
:= NEW DESIGNATED
'( 30);
63 PROCEDURE A (X : ADDRESS) IS
68 FUNCTION IDENT (X : T) RETURN T IS
71 EQUAL (DESIGNATED'POS (X.ALL), DESIGNATED'POS (X.ALL)) THEN
72 RETURN X; -- ALWAYS EXECUTED.
74 RETURN NEW DESIGNATED;
78 TEST ("C34007A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
79 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
80 "ACCESS TYPES WHOSE DESIGNATED TYPE IS NOT AN " &
81 "ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A " &
82 "TYPE WITH DISCRIMINANTS");
84 IF Y = NULL OR ELSE Y.ALL /= 30 THEN
85 FAILED ("INCORRECT INITIALIZATION");
90 FAILED ("INCORRECT :=");
94 FAILED
("INCORRECT QUALIFICATION");
98 FAILED
("INCORRECT SELF CONVERSION");
102 W
:= NEW DESIGNATED
'(-30);
105 IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= -30 THEN
106 FAILED ("INCORRECT CONVERSION FROM PARENT");
111 IF W = NULL OR ELSE W.ALL /= 30 OR ELSE T (W) /= Y THEN
112 FAILED ("INCORRECT CONVERSION TO PARENT");
115 IF IDENT (NULL) /= NULL OR X = NULL THEN
116 FAILED ("INCORRECT NULL");
119 X := IDENT (NEW DESIGNATED'(30));
120 IF X
= NULL OR ELSE X
= Y
OR ELSE X
.ALL /= 30 THEN
121 FAILED
("INCORRECT ALLOCATOR");
126 FAILED
("INCORRECT .ALL (VALUE)");
129 X
.ALL := DESIGNATED
'VAL (IDENT_INT
(10));
130 IF X
/= Y
OR Y
.ALL /= 10 THEN
131 FAILED
("INCORRECT .ALL (ASSIGNMENT)");
138 FAILED
("NO EXCEPTION FOR NULL.ALL - 1");
139 ELSE FAILED
("NO EXCEPTION FOR NULL.ALL - 2");
142 WHEN CONSTRAINT_ERROR
=>
145 FAILED
("WRONG EXCEPTION FOR NULL.ALL");
149 IF X
= NULL OR X
= NEW DESIGNATED
OR NOT (X
= Y
) THEN
150 FAILED
("INCORRECT =");
153 IF X
/= Y
OR NOT (X
/= NULL) THEN
154 FAILED
("INCORRECT /=");
158 FAILED
("INCORRECT ""IN""");
162 FAILED
("INCORRECT ""NOT IN""");
168 IF T
'STORAGE_SIZE /= PARENT
'STORAGE_SIZE THEN
169 FAILED
("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
170 "EQUAL OF COLLECTION SIZE OF PARENT TYPE");
173 WHEN PROGRAM_ERROR
=>
174 COMMENT
("PROGRAM_ERROR RAISED FOR " &
175 "UNDEFINED STORAGE_SIZE (AI-00608)");
177 FAILED
("UNEXPECTED EXCEPTION RAISED");