1-- C35502K.ADA
2
3--                             Grant of Unlimited Rights
4--
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
14--     to do so.
15--
16--                                    DISCLAIMER
17--
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.
24--*
25-- CHECK THAT 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
26-- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A
27-- CHARACTER TYPE.
28
29-- RJW 5/27/86
30-- GMT 7/02/87  ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
31
32
33WITH REPORT; USE REPORT;
34
35PROCEDURE C35502K IS
36
37     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
38     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
39
40     TYPE NEWENUM IS NEW ENUM;
41     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
42
43BEGIN
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" );
48
49     DECLARE
50          POSITION : INTEGER;
51     BEGIN
52          POSITION := 0;
53
54          FOR E IN ENUM LOOP
55               IF SUBENUM'POS (E) /= POSITION THEN
56                    FAILED ( "INCORRECT SUBENUM'POS (" &
57                              ENUM'IMAGE (E) & ")" );
58               END IF;
59
60               IF SUBENUM'VAL (POSITION) /= E THEN
61                    FAILED ( "INCORRECT SUBENUM'VAL (" &
62                              INTEGER'IMAGE (POSITION) &
63                             ")" );
64               END IF;
65
66               POSITION := POSITION + 1;
67          END LOOP;
68
69          POSITION := 0;
70          FOR E IN NEWENUM LOOP
71               IF SUBNEW'POS (E) /= POSITION THEN
72                    FAILED ( "INCORRECT SUBNEW'POS (" &
73                              NEWENUM'IMAGE (E) & ")" );
74               END IF;
75
76               IF SUBNEW'VAL (POSITION) /= E THEN
77                    FAILED ( "INCORRECT SUBNEW'VAL (" &
78                              INTEGER'IMAGE (POSITION) &
79                             ")" );
80               END IF;
81
82               POSITION := POSITION + 1;
83          END LOOP;
84     END;
85
86     DECLARE
87          FUNCTION A_B_C RETURN ENUM IS
88          BEGIN
89               RETURN ENUM'VAL (IDENT_INT (0));
90          END A_B_C;
91
92     BEGIN
93          IF ENUM'VAL (0) /= A_B_C THEN
94               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
95                        "BY FUNCTION - 1" );
96          END IF;
97
98          IF ENUM'VAL (0) = C35502K.A_B_C THEN
99               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
100                        "BY FUNCTION - 2" );
101          END IF;
102
103          IF ENUM'VAL (3) /= C35502K.A_B_C THEN
104               FAILED ( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
105                        "BY FUNCTION - 3" );
106          END IF;
107     END;
108
109     BEGIN
110          IF ENUM'VAL (IDENT_INT (-1)) = A THEN
111               FAILED ( "NO EXCEPTION RAISED " &
112                        "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
113          ELSE
114               FAILED ( "NO EXCEPTION RAISED " &
115                        "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
116          END IF;
117     EXCEPTION
118          WHEN CONSTRAINT_ERROR =>
119               NULL;
120          WHEN OTHERS =>
121               FAILED ( "WRONG EXCEPTION RAISED " &
122                        "FOR ENUM'VAL (IDENT_INT (-1))" );
123     END;
124
125     BEGIN
126          IF NEWENUM'VAL (IDENT_INT (-1)) = A THEN
127               FAILED ( "NO EXCEPTION RAISED FOR " &
128                        "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
129          ELSE
130               FAILED ( "NO EXCEPTION RAISED FOR " &
131                        "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
132          END IF;
133     EXCEPTION
134          WHEN CONSTRAINT_ERROR =>
135               NULL;
136          WHEN OTHERS =>
137               FAILED ( "WRONG EXCEPTION RAISED FOR " &
138                        "NEWENUM'VAL (IDENT_INT (-1))" );
139     END;
140
141     BEGIN
142          IF ENUM'VAL (IDENT_INT (5)) = A THEN
143               FAILED ( "NO EXCEPTION RAISED " &
144                        "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
145          ELSE
146               FAILED ( "NO EXCEPTION RAISED " &
147                        "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
148          END IF;
149     EXCEPTION
150          WHEN CONSTRAINT_ERROR =>
151               NULL;
152          WHEN OTHERS =>
153               FAILED ( "WRONG EXCEPTION RAISED " &
154                        "FOR ENUM'VAL (IDENT_INT (5))" );
155     END;
156
157     BEGIN
158          IF NEWENUM'VAL (IDENT_INT (5)) = A THEN
159               FAILED ( "NO EXCEPTION RAISED FOR " &
160                        "NEWENUM'VAL (IDENT_INT (5)) - 1" );
161          ELSE
162               FAILED ( "NO EXCEPTION RAISED FOR " &
163                        "NEWENUM'VAL (IDENT_INT (5)) - 2" );
164          END IF;
165     EXCEPTION
166          WHEN CONSTRAINT_ERROR =>
167               NULL;
168          WHEN OTHERS =>
169               FAILED ( "WRONG EXCEPTION RAISED FOR " &
170                        "NEWENUM'VAL (IDENT_INT (5))" );
171     END;
172
173     RESULT;
174END C35502K;
175