1-- CC3220A.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 A DISCRETE FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
26-- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
27-- OPERATIONS OF THE ACTUAL TYPE.
28
29-- TBN  10/08/86
30
31WITH REPORT; USE REPORT;
32PROCEDURE CC3220A IS
33
34     GENERIC
35          TYPE T IS (<>);
36     PACKAGE P IS
37          SUBTYPE SUB_T IS T;
38          PAC_VAR : T;
39     END P;
40
41BEGIN
42     TEST ("CC3220A", "CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS " &
43                      "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
44                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
45                      "OPERATIONS OF THE ACTUAL TYPE");
46
47     DECLARE
48          OBJ_INT : INTEGER := 1;
49
50          PACKAGE P1 IS NEW P (INTEGER);
51          USE P1;
52
53          TYPE NEW_T IS NEW SUB_T;
54          OBJ_NEWT : NEW_T;
55     BEGIN
56          PAC_VAR := SUB_T'(1);
57          IF PAC_VAR /= OBJ_INT THEN
58               FAILED ("INCORRECT RESULTS - 1");
59          END IF;
60          OBJ_INT := PAC_VAR + OBJ_INT;
61          IF OBJ_INT <= PAC_VAR THEN
62               FAILED ("INCORRECT RESULTS - 2");
63          END IF;
64          PAC_VAR := PAC_VAR * OBJ_INT;
65          IF PAC_VAR NOT IN INTEGER THEN
66               FAILED ("INCORRECT RESULTS - 3");
67          END IF;
68          IF OBJ_INT NOT IN SUB_T THEN
69               FAILED ("INCORRECT RESULTS - 4");
70          END IF;
71          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
72               FAILED ("INCORRECT RESULTS - 5");
73          END IF;
74          OBJ_NEWT := 1;
75          OBJ_NEWT := OBJ_NEWT + 1;
76          IF OBJ_NEWT NOT IN NEW_T THEN
77               FAILED ("INCORRECT RESULTS - 6");
78          END IF;
79          IF NEW_T'SUCC(2) /= 3 THEN
80               FAILED ("INCORRECT RESULTS - 7");
81          END IF;
82     END;
83
84     DECLARE
85          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
86          OBJ_ENU : ENUM := RED;
87
88          PACKAGE P2 IS NEW P (ENUM);
89          USE P2;
90
91          TYPE NEW_T IS NEW SUB_T;
92          OBJ_NEWT : NEW_T;
93     BEGIN
94          PAC_VAR := SUB_T'(RED);
95          IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
96               FAILED ("INCORRECT RESULTS - 8");
97          END IF;
98          IF PAC_VAR NOT IN ENUM THEN
99               FAILED ("INCORRECT RESULTS - 9");
100          END IF;
101          IF OBJ_ENU NOT IN SUB_T THEN
102               FAILED ("INCORRECT RESULTS - 10");
103          END IF;
104          IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
105               FAILED ("INCORRECT RESULTS - 11");
106          END IF;
107          OBJ_ENU := SUB_T'SUCC(PAC_VAR);
108          IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
109               FAILED ("INCORRECT RESULTS - 12");
110          END IF;
111          OBJ_NEWT := BLUE;
112          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
113          IF OBJ_NEWT NOT IN NEW_T THEN
114               FAILED ("INCORRECT RESULTS - 13");
115          END IF;
116          IF NEW_T'WIDTH /= 6 THEN
117               FAILED ("INCORRECT RESULTS - 14");
118          END IF;
119     END;
120
121     DECLARE
122          OBJ_CHR : CHARACTER := 'A';
123
124          PACKAGE P3 IS NEW P (CHARACTER);
125          USE P3;
126
127          TYPE NEW_T IS NEW SUB_T;
128          OBJ_NEWT : NEW_T;
129          ARA_NEWT : ARRAY (1 .. 5) OF NEW_T;
130     BEGIN
131          PAC_VAR := SUB_T'('A');
132          IF (PAC_VAR < OBJ_CHR) OR (PAC_VAR > OBJ_CHR) THEN
133               FAILED ("INCORRECT RESULTS - 15");
134          END IF;
135          IF PAC_VAR NOT IN CHARACTER THEN
136               FAILED ("INCORRECT RESULTS - 16");
137          END IF;
138          IF OBJ_CHR NOT IN SUB_T THEN
139               FAILED ("INCORRECT RESULTS - 17");
140          END IF;
141          IF CHARACTER'VAL(0) /= SUB_T'VAL(0) THEN
142               FAILED ("INCORRECT RESULTS - 18");
143          END IF;
144          OBJ_CHR := SUB_T'SUCC(PAC_VAR);
145          IF SUB_T'POS('A') /= 65 AND THEN OBJ_CHR /= 'A' THEN
146               FAILED ("INCORRECT RESULTS - 19");
147          END IF;
148          OBJ_NEWT := 'C';
149          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
150          IF OBJ_NEWT NOT IN NEW_T THEN
151               FAILED ("INCORRECT RESULTS - 20");
152          END IF;
153          IF NEW_T'IMAGE('A') /= "'A'" THEN
154               FAILED ("INCORRECT RESULTS - 21");
155          END IF;
156          ARA_NEWT := "HELLO";
157          IF (NEW_T'('H') & NEW_T'('I')) /= "HI" THEN
158               FAILED ("INCORRECT RESULTS - 22");
159          END IF;
160     END;
161
162     RESULT;
163END CC3220A;
164