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 A
28 -- ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS PART 2 OF 2 TESTS
29 -- WHICH COVER THE OBJECTIVE. THE FIRST PART IS IN TEST C34007D.
32 -- BCB 04/12/90 CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA.
33 -- THS 09/18/90 REMOVED DECLARATION OF B, DELETED PROCEDURE A,
34 -- AND REMOVED ALL REFERENCES TO B.
36 WITH SYSTEM
; USE SYSTEM
;
37 WITH REPORT
; USE REPORT
;
41 SUBTYPE COMPONENT
IS INTEGER;
43 TYPE DESIGNATED
IS ARRAY (NATURAL RANGE <>) OF COMPONENT
;
45 SUBTYPE SUBDESIGNATED
IS DESIGNATED
(IDENT_INT
(5) ..
50 TYPE PARENT
IS ACCESS DESIGNATED
;
52 FUNCTION CREATE
( F
, L
: NATURAL;
54 DUMMY
: PARENT
-- TO RESOLVE OVERLOADING.
61 TYPE T
IS NEW PARENT
(IDENT_INT
(5) .. IDENT_INT
(7));
63 X
: T
:= NEW SUBDESIGNATED
'(OTHERS => 2);
64 K : INTEGER := X'SIZE;
65 Y : T := NEW SUBDESIGNATED'(1, 2, 3);
66 W
: PARENT
:= NEW SUBDESIGNATED
'(OTHERS => 2);
70 FUNCTION V RETURN T IS
72 RETURN NEW SUBDESIGNATED'(OTHERS => C
);
83 A
: PARENT
:= NEW DESIGNATED
(F
.. L
);
95 FUNCTION IDENT
(X
: T
) RETURN T
IS
98 EQUAL
(X
'LENGTH, X
'LENGTH) THEN
99 RETURN X
; -- ALWAYS EXECUTED.
101 RETURN NEW SUBDESIGNATED
;
105 TEST
("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
106 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
107 "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
108 "ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS " &
109 "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE. " &
110 "THE FIRST PART IS IN TEST C34007V");
112 W
:= PARENT
(CREATE
(2, 3, 4, X
));
113 IF W
= NULL OR ELSE W
.ALL /= (4, 5) THEN
114 FAILED
("INCORRECT CONVERSION TO PARENT - 2");
118 IF X
.ALL /= (1, 2, 3) OR CREATE
(2, 3, 4, X
) . ALL /= (4, 5) THEN
119 FAILED
("INCORRECT .ALL (VALUE)");
122 X
.ALL := (10, 11, 12);
123 IF X
/= Y
OR Y
.ALL /= (10, 11, 12) THEN
124 FAILED
("INCORRECT .ALL (ASSIGNMENT)");
129 CREATE
(2, 3, 4, X
) . ALL := (10, 11);
132 FAILED
("EXCEPTION FOR .ALL (ASSIGNMENT)");
137 IF X
(IDENT_INT
(5)) /= 1 OR
138 CREATE
(2, 3, 4, X
) (3) /= 5 THEN
139 FAILED
("INCORRECT INDEX (VALUE)");
145 CREATE
(2, 3, 4, X
) (2) := 10;
148 FAILED
("EXCEPTION FOR INDEX (ASSIGNMENT)");
151 IF X
(IDENT_INT
(6) .. IDENT_INT
(7)) /= (2, 3) OR
152 CREATE
(1, 4, 4, X
) (1 .. 3) /= (4, 5, 6) THEN
153 FAILED
("INCORRECT SLICE (VALUE)");
159 CREATE
(1, 4, 4, X
) (2 .. 4) := (10, 11, 12);
162 FAILED
("EXCEPTION FOR SLICE (ASSIGNMENT)");
165 IF X
= NULL OR X
= NEW SUBDESIGNATED
OR NOT (X
= Y
) OR
166 X
= CREATE
(2, 3, 4, X
) THEN
167 FAILED
("INCORRECT =");
170 IF X
/= Y
OR NOT (X
/= NULL) OR NOT (X
/= CREATE
(2, 3, 4, X
)) THEN
171 FAILED
("INCORRECT /=");
174 IF NOT (X
IN T
) OR CREATE
(2, 3, 4, X
) IN T
THEN
175 FAILED
("INCORRECT ""IN""");
178 IF X
NOT IN T
OR NOT (CREATE
(2, 3, 4, X
) NOT IN T
) THEN
179 FAILED
("INCORRECT ""NOT IN""");