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 THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
26 -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
27 -- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A
30 -- PART (A). TESTS FOR IMAGE.
31 -- PART (B). TESTS FOR VALUE.
35 WITH REPORT
; USE REPORT
;
39 TYPE ENUM
IS (A
, BC
, ABC
, A_B_C
, abcd
);
40 SUBTYPE SUBENUM
IS ENUM
RANGE A
.. BC
;
42 TYPE NEWENUM
IS NEW ENUM
;
46 TEST
( "C35502E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
47 "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
48 "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
49 "ACTUAL PARAMETER IS AN ENUMERATION TYPE " &
50 "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
57 PROCEDURE P
( E1
: E
; STR2
: STRING );
59 PROCEDURE P
( E1
: E
; STR2
: STRING ) IS
60 SUBTYPE SE
IS E
RANGE E
'VAL(0) .. E
'VAL(1);
62 IF SE
'IMAGE ( E1
) /= STR2
THEN
63 FAILED
( "INCORRECT SE'IMAGE FOR " & STR2
& " IN "
66 IF SE
'IMAGE ( E1
)'FIRST /= 1 THEN
67 FAILED
( "INCORRECT LOWER BOUND FOR " & STR2
72 PROCEDURE PE
IS NEW P
( ENUM
, "ENUM" );
73 PROCEDURE PS
IS NEW P
( SUBENUM
, "SUBENUM" );
74 PROCEDURE PN
IS NEW P
( NEWENUM
, "NEWENUM" );
78 PE
( A_B_C
, "A_B_C" );
84 -----------------------------------------------------------------------
92 PROCEDURE P
( STR2
: STRING ; E1
: E
);
94 PROCEDURE P
( STR2
: STRING ; E1
: E
) IS
95 SUBTYPE SE
IS E
RANGE E
'VAL(0) .. E
'VAL(1);
97 IF E
'VALUE ( STR2
) /= E1
THEN
98 FAILED
( "INCORRECT " & STR1
& "'VALUE FOR """ &
103 FAILED
( "EXCEPTION RAISED - " & STR1
& "'VALUE " &
104 "FOR """ & STR2
& """" );
107 PROCEDURE PE
IS NEW P
( ENUM
, "ENUM" );
108 PROCEDURE PN
IS NEW P
( NEWENUM
, "NEWENUM" );
114 PE
(" A_B_C", A_B_C
);
121 PROCEDURE P
( STR
: STRING );
123 PROCEDURE P
( STR
: STRING ) IS
124 SUBTYPE SE
IS E
RANGE E
'VAL(0) .. E
'VAL(1);
126 IF SE
'VALUE (STR
) = SE
'VAL (0) THEN
127 FAILED
( "NO EXCEPTION RAISED - " & STR
& " - 1" );
129 FAILED
( "NO EXCEPTION RAISED - " & STR
& " - 2" );
132 WHEN CONSTRAINT_ERROR
=>
135 FAILED
( "WRONG EXCEPTION RAISED - " & STR
);
138 PROCEDURE PE
IS NEW P
( ENUM
);
139 PROCEDURE PS
IS NEW P
( SUBENUM
);
140 PROCEDURE PN
IS NEW P
( NEWENUM
);
145 PE
(ASCII
.HT
& "BC");