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 WHEN AN ENTRY FAMILY MEMBER IS RENAMED THE FORMAL
27 -- PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
28 -- FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
31 -- RJW 06/03/86 CREATED ORIGINAL TEST.
32 -- DHH 10/15/87 CORRECTED RANGE ERRORS.
33 -- GJD 11/15/95 REMOVED ADA 95 INCOMPATIBILITY (INDEX CONSTRAINT).
34 -- PWN 10/24/96 RESTORED CHECKS WITH ADA 95 RESULTS NOW EXPECTED.
35 -- PWN 12/11/96 ADJUSTED VALUES FOR ADA 95 COMPATIBILITY.
36 -- PWB.CTA 2/17/97 CHANGED CALL TO ENT2 TO NOT EXPECT EXCEPTION
38 WITH REPORT
; USE REPORT
;
44 TEST
( "C85018B", "CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS " &
45 "RENAMED THE FORMAL PARAMETER CONSTRAINTS " &
46 "FOR THE NEW NAME ARE IGNORED IN FAVOR OF " &
47 "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED " &
51 TYPE INT
IS RANGE 1 .. 10;
52 SUBTYPE INT1
IS INT
RANGE 1 .. 5;
53 SUBTYPE INT2
IS INT
RANGE 6 .. 10;
58 SUBTYPE SHORTCHAR
IS CHARACTER RANGE 'A' .. 'C';
61 ENTRY ENT1
(SHORTCHAR
)
62 (A
: INT1
; OK
: BOOLEAN);
65 PROCEDURE ENT2
(A
: INT2
; OK
: BOOLEAN)
73 (A
: INT1
; OK
: BOOLEAN) DO
75 FAILED
( "WRONG CALL EXECUTED " &
76 "WITH INTEGER TYPE" );
88 WHEN CONSTRAINT_ERROR
=>
89 FAILED
( "CONSTRAINT_ERROR RAISED WITH " &
92 FAILED
( "OTHER EXCEPTION RAISED WITH " &
99 WHEN CONSTRAINT_ERROR
=>
102 FAILED
( "OTHER EXCEPTION RAISED WITH " &
103 "INTEGER TYPE - 2" );
108 TYPE REAL
IS DIGITS 3;
109 SUBTYPE REAL1
IS REAL
RANGE -2.0 .. 0.0;
110 SUBTYPE REAL2
IS REAL
RANGE 0.0 .. 2.0;
112 OBJ1
: REAL1
:= -0.25;
113 OBJ2
: REAL2
:= 0.25;
115 SUBTYPE SHORTINT
IS INTEGER RANGE 9 .. 11;
118 ENTRY ENT1
(SHORTINT
)
119 (A
: REAL1
; OK
: BOOLEAN);
122 PROCEDURE ENT2
(A
: REAL2
; OK
: BOOLEAN)
130 (A
: REAL1
; OK
: BOOLEAN) DO
132 FAILED
( "WRONG CALL EXECUTED " &
133 "WITH FLOATING POINT " &
146 WHEN CONSTRAINT_ERROR
=>
147 FAILED
( "CONSTRAINT_ERROR RAISED WITH " &
151 FAILED
( "OTHER EXCEPTION RAISED WITH " &
159 WHEN CONSTRAINT_ERROR
=>
162 FAILED
( "OTHER EXCEPTION RAISED WITH " &
169 TYPE COLOR
IS (RED
, YELLOW
, BLUE
, GREEN
);
171 TYPE FIXED
IS DELTA 0.125 RANGE -1.0 .. 1.0;
172 SUBTYPE FIXED1
IS FIXED
RANGE 0.0 .. 0.5;
173 SUBTYPE FIXED2
IS FIXED
RANGE -0.5 .. 0.0;
175 OBJ1
: FIXED1
:= 0.125;
176 OBJ2
: FIXED2
:= -0.125;
180 (A
: FIXED1
; OK
: BOOLEAN);
183 PROCEDURE ENT2
(A
: FIXED2
; OK
: BOOLEAN)
184 RENAMES T
.ENT1
(BLUE
);
191 (A
: FIXED1
; OK
: BOOLEAN) DO
193 FAILED
( "WRONG CALL EXECUTED " &
194 "WITH FIXED POINT " &
207 WHEN CONSTRAINT_ERROR
=>
208 FAILED
( "CONSTRAINT_ERROR RAISED WITH " &
212 FAILED
( "OTHER EXCEPTION RAISED WITH " &
220 WHEN CONSTRAINT_ERROR
=>
223 FAILED
( "OTHER EXCEPTION RAISED WITH " &
230 TYPE TA
IS ARRAY (INTEGER RANGE <>) OF INTEGER;
231 SUBTYPE STA1
IS TA
(1 .. 5);
232 SUBTYPE STA2
IS TA
(6 .. 10);
234 OBJ1
: STA1
:= (1, 2, 3, 4, 5);
235 OBJ2
: STA2
:= (6, 7, 8, 9, 10);
239 (A
: STA1
; OK
: BOOLEAN);
242 PROCEDURE ENT2
(A
: STA2
; OK
: BOOLEAN)
243 RENAMES T
.ENT1
(FALSE);
250 (A
: STA1
; OK
: BOOLEAN) DO
252 FAILED
( "WRONG CALL EXECUTED " &
253 "WITH CONSTRAINED " &
266 WHEN CONSTRAINT_ERROR
=>
267 FAILED
( "CONSTRAINT_ERROR RAISED WITH " &
268 "CONSTRAINED ARRAY" );
270 FAILED
( "OTHER EXCEPTION RAISED WITH " &
271 "CONSTRAINED ARRAY - 1" );
277 WHEN CONSTRAINT_ERROR
=>
278 FAILED
( "CONSTRAINT_ERROR RAISED WITH " &
279 "CONSTRAINED ARRAY" );
281 FAILED
( "OTHER EXCEPTION RAISED WITH " &
282 "CONSTRAINED ARRAY - 2" );