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 -- FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
28 -- CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR
29 -- THE DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS
31 -- CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO
32 -- IMPOSED ON THE DERIVED SUBTYPE.
35 -- JRK 9/15/86 CREATED ORIGINAL TEST.
37 WITH REPORT
; USE REPORT
;
41 TYPE COMPONENT
IS NEW CHARACTER;
45 FIRST
: CONSTANT := 0;
46 LAST
: CONSTANT := 100;
48 SUBTYPE INDEX
IS INTEGER RANGE FIRST
.. LAST
;
50 TYPE PARENT
IS ARRAY (INDEX
RANGE <>) OF COMPONENT
;
52 FUNCTION CREATE
( F
, L
: INDEX
;
54 DUMMY
: PARENT
-- TO RESOLVE OVERLOADING.
61 TYPE T
IS NEW PARENT
(IDENT_INT
(5) .. IDENT_INT
(7));
63 SUBTYPE SUBPARENT
IS PARENT
(5 .. 7);
65 TYPE S
IS NEW SUBPARENT
;
67 X
: T
:= (OTHERS => 'B');
68 Y
: S
:= (OTHERS => 'B');
83 B
:= COMPONENT
'SUCC (B
);
91 TEST
("C34005I", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " &
92 "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " &
93 "WHEN THE DERIVED TYPE DEFINITION IS " &
94 "CONSTRAINED. ALSO CHECK THAT ANY CONSTRAINT " &
95 "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " &
96 "ON THE DERIVED SUBTYPE. CHECK FOR DERIVED " &
97 "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
98 "TYPE IS A CHARACTER TYPE");
100 -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
103 IF CREATE
(2, 3, 'D', X
) /= "DE" OR
104 CREATE
(2, 3, 'D', Y
) /= "DE" THEN
105 FAILED
("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
109 WHEN CONSTRAINT_ERROR
=>
110 FAILED
("CALL TO CREATE RAISED CONSTRAINT_ERROR");
112 FAILED
("CALL TO CREATE RAISED EXCEPTION");
115 IF X
& "CD" /= "BBBCD" OR
116 Y
& "CD" /= "BBBCD" THEN
117 FAILED
("INCORRECT &");
120 -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
122 IF T
'FIRST /= 5 OR T
'LAST /= 7 OR
123 S
'FIRST /= 5 OR S
'LAST /= 7 THEN
124 FAILED
("INCORRECT 'FIRST OR 'LAST");
130 IF PARENT
(X
) /= PARENT
(Y
) THEN -- USE X AND Y.
131 FAILED
("INCORRECT CONVERSION TO PARENT");
135 FAILED
("EXCEPTION RAISED BY OK ASSIGNMENT");
140 FAILED
("CONSTRAINT_ERROR NOT RAISED -- X := ""AB""");
141 IF X
= "AB" THEN -- USE X.
142 COMMENT
("X ALTERED -- X := ""AB""");
145 WHEN CONSTRAINT_ERROR
=>
148 FAILED
("WRONG EXCEPTION RAISED -- X := ""AB""");
153 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
155 IF X
= "ABCD" THEN -- USE X.
156 COMMENT
("X ALTERED -- X := ""ABCD""");
159 WHEN CONSTRAINT_ERROR
=>
162 FAILED
("WRONG EXCEPTION RAISED -- " &
168 FAILED
("CONSTRAINT_ERROR NOT RAISED -- Y := ""AB""");
169 IF Y
= "AB" THEN -- USE Y.
170 COMMENT
("Y ALTERED -- Y := ""AB""");
173 WHEN CONSTRAINT_ERROR
=>
176 FAILED
("WRONG EXCEPTION RAISED -- Y := ""AB""");
181 FAILED
("CONSTRAINT_ERROR NOT RAISED -- " &
183 IF Y
= "ABCD" THEN -- USE Y.
184 COMMENT
("Y ALTERED -- Y := ""ABCD""");
187 WHEN CONSTRAINT_ERROR
=>
190 FAILED
("WRONG EXCEPTION RAISED -- " &