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.
25 -- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
26 -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A
30 -- GMT 7/02/87 ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
33 WITH REPORT
; USE REPORT
;
37 TYPE ENUM
IS (A
, BC
, ABC
, A_B_C
, ABCD
);
38 SUBTYPE SUBENUM
IS ENUM
RANGE A
.. BC
;
40 TYPE NEWENUM
IS NEW ENUM
;
41 SUBTYPE SUBNEW
IS NEWENUM
RANGE A
.. BC
;
44 TEST
("C35502K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
45 "CORRECT RESULTS WHEN THE PREFIX IS AN " &
46 "ENUMERATION TYPE OTHER THAN A CHARACTER " &
47 "OR A BOOLEAN TYPE" );
55 IF SUBENUM
'POS (E
) /= POSITION
THEN
56 FAILED
( "INCORRECT SUBENUM'POS (" &
57 ENUM
'IMAGE (E
) & ")" );
60 IF SUBENUM
'VAL (POSITION
) /= E
THEN
61 FAILED
( "INCORRECT SUBENUM'VAL (" &
62 INTEGER'IMAGE (POSITION
) &
66 POSITION
:= POSITION
+ 1;
71 IF SUBNEW
'POS (E
) /= POSITION
THEN
72 FAILED
( "INCORRECT SUBNEW'POS (" &
73 NEWENUM
'IMAGE (E
) & ")" );
76 IF SUBNEW
'VAL (POSITION
) /= E
THEN
77 FAILED
( "INCORRECT SUBNEW'VAL (" &
78 INTEGER'IMAGE (POSITION
) &
82 POSITION
:= POSITION
+ 1;
87 FUNCTION A_B_C
RETURN ENUM
IS
89 RETURN ENUM
'VAL (IDENT_INT
(0));
93 IF ENUM
'VAL (0) /= A_B_C
THEN
94 FAILED
( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
98 IF ENUM
'VAL (0) = C35502K
.A_B_C
THEN
99 FAILED
( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
103 IF ENUM
'VAL (3) /= C35502K
.A_B_C
THEN
104 FAILED
( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
110 IF ENUM
'VAL (IDENT_INT
(-1)) = A
THEN
111 FAILED
( "NO EXCEPTION RAISED " &
112 "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
114 FAILED
( "NO EXCEPTION RAISED " &
115 "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
118 WHEN CONSTRAINT_ERROR
=>
121 FAILED
( "WRONG EXCEPTION RAISED " &
122 "FOR ENUM'VAL (IDENT_INT (-1))" );
126 IF NEWENUM
'VAL (IDENT_INT
(-1)) = A
THEN
127 FAILED
( "NO EXCEPTION RAISED FOR " &
128 "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
130 FAILED
( "NO EXCEPTION RAISED FOR " &
131 "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
134 WHEN CONSTRAINT_ERROR
=>
137 FAILED
( "WRONG EXCEPTION RAISED FOR " &
138 "NEWENUM'VAL (IDENT_INT (-1))" );
142 IF ENUM
'VAL (IDENT_INT
(5)) = A
THEN
143 FAILED
( "NO EXCEPTION RAISED " &
144 "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
146 FAILED
( "NO EXCEPTION RAISED " &
147 "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
150 WHEN CONSTRAINT_ERROR
=>
153 FAILED
( "WRONG EXCEPTION RAISED " &
154 "FOR ENUM'VAL (IDENT_INT (5))" );
158 IF NEWENUM
'VAL (IDENT_INT
(5)) = A
THEN
159 FAILED
( "NO EXCEPTION RAISED FOR " &
160 "NEWENUM'VAL (IDENT_INT (5)) - 1" );
162 FAILED
( "NO EXCEPTION RAISED FOR " &
163 "NEWENUM'VAL (IDENT_INT (5)) - 2" );
166 WHEN CONSTRAINT_ERROR
=>
169 FAILED
( "WRONG EXCEPTION RAISED FOR " &
170 "NEWENUM'VAL (IDENT_INT (5))" );