1-- C46052A.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 CONSTRAINT_ERROR IS RAISED FOR CONVERSION TO AN
26-- ENUMERATION TYPE IF THE VALUE OF THE OPERAND DOES NOT BELONG TO THE
27-- RANGE OF ENUMERATION VALUES FOR THE TARGET SUBTYPE.
28
29-- R.WILLIAMS 9/9/86
30
31WITH REPORT; USE REPORT;
32PROCEDURE C46052A IS
33
34     TYPE ENUM IS (A, AB, ABC, ABCD);
35     E : ENUM := ENUM'VAL (IDENT_INT (0));
36
37     FUNCTION IDENT (E : ENUM) RETURN ENUM IS
38     BEGIN
39          RETURN ENUM'VAL (IDENT_INT (ENUM'POS (E)));
40     END IDENT;
41
42BEGIN
43     TEST ( "C46052A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
44                       "CONVERSION TO AN ENUMERATION TYPE IF THE " &
45                       "VALUE OF THE OPERAND DOES NOT BELONG TO " &
46                       "THE RANGE OF ENUMERATION VALUES FOR THE " &
47                       "TARGET SUBTYPE" );
48
49     DECLARE
50          SUBTYPE SENUM IS ENUM RANGE AB .. ABCD;
51     BEGIN
52          E := IDENT (SENUM (E));
53          FAILED ( "NO EXCEPTION RAISED FOR 'SENUM (E)'" );
54     EXCEPTION
55          WHEN CONSTRAINT_ERROR =>
56               NULL;
57          WHEN OTHERS =>
58               FAILED ( "WRONG EXCEPTION RAISED FOR 'SENUM (E)'" );
59     END;
60
61     DECLARE
62          SUBTYPE NOENUM IS ENUM RANGE ABCD .. AB;
63     BEGIN
64          E := IDENT (NOENUM (E));
65          FAILED ( "NO EXCEPTION RAISED FOR 'NOENUM (E)'" );
66     EXCEPTION
67          WHEN CONSTRAINT_ERROR =>
68               NULL;
69          WHEN OTHERS =>
70               FAILED ( "WRONG EXCEPTION RAISED FOR 'NOENUM (E)'" );
71     END;
72
73     DECLARE
74          SUBTYPE SCHAR IS CHARACTER RANGE 'C' .. 'R';
75          A : CHARACTER := IDENT_CHAR ('A');
76     BEGIN
77          A := IDENT_CHAR (SCHAR (A));
78          FAILED ( "NO EXCEPTION RAISED FOR 'SCHAR (A)'" );
79     EXCEPTION
80          WHEN CONSTRAINT_ERROR =>
81               NULL;
82          WHEN OTHERS =>
83               FAILED ( "WRONG EXCEPTION RAISED FOR 'SCHAR (A)'" );
84     END;
85
86     DECLARE
87          SUBTYPE FRANGE IS BOOLEAN RANGE FALSE .. FALSE;
88          T : BOOLEAN := IDENT_BOOL (TRUE);
89     BEGIN
90          T := IDENT_BOOL (FRANGE (T));
91          FAILED ( "NO EXCEPTION RAISED FOR 'FRANGE (T)'" );
92     EXCEPTION
93          WHEN CONSTRAINT_ERROR =>
94               NULL;
95          WHEN OTHERS =>
96               FAILED ( "WRONG EXCEPTION RAISED FOR 'FRANGE (T)'" );
97     END;
98
99     RESULT;
100END C46052A;
101