1-- CD2A24J.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-- OBJECTIVE:
26--     CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE SMALLEST APPROPRIATE
27--     SIZE FOR AN UNSIGNED REPRESENTATION) AND AN ENUMERATION
28--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
29--     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
30--     INSTANTIATION.
31
32-- HISTORY:
33--     JET 08/19/87 CREATED ORIGINAL TEST.
34--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
35--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
36
37WITH REPORT; USE REPORT;
38PROCEDURE CD2A24J IS
39
40     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
41     BASIC_SIZE : CONSTANT := 3;
42
43     FOR BASIC_ENUM USE (ZERO => 3, ONE => 4,
44                         TWO => 5);
45     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
46
47BEGIN
48     TEST ("CD2A24J", "CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE " &
49                      "SMALLEST APPROPRIATE SIZE FOR AN UNSIGNED " &
50                      "REPRESENTATION) AND AN ENUMERATION " &
51                      "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
52                      "ENUMERATION TYPE, THEN THE TYPE CAN BE USED " &
53                      "AS AN ACTUAL PARAMETER IN AN INSTANTIATION");
54
55
56     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
57
58          GENERIC
59               TYPE GPARM IS (<>);
60          PROCEDURE GENPROC (C0, C1, C2: GPARM);
61
62          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
63
64               SUBTYPE CHECK_TYPE IS GPARM;
65
66               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
67               BEGIN
68                    IF EQUAL (3, 3) THEN
69                         RETURN CH;
70                    ELSE
71                         RETURN C1;
72                    END IF;
73               END IDENT;
74
75          BEGIN -- GENPROC.
76
77               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
78                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
79               END IF;
80
81               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
82                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
83               END IF;
84
85               IF NOT ((IDENT (C1) IN C1 .. C2)       AND
86                       (C0 NOT IN IDENT (C1) .. C2)) THEN
87                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
88                            "OPERATORS");
89               END IF;
90
91               IF CHECK_TYPE'LAST /= IDENT (C2) THEN
92                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
93               END IF;
94
95               IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
96                  CHECK_TYPE'VAL (1) /= IDENT (C1) OR
97                  CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
98                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
99               END IF;
100
101               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
102                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
103                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
104               END IF;
105
106               IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
107                  CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
108                  CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
109                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
110               END IF;
111
112          END GENPROC;
113
114          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
115
116     BEGIN
117
118          NEWPROC (ZERO, ONE, TWO);
119
120     END;
121
122     RESULT;
123
124END CD2A24J;
125