1-- CC1226B.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, FOR A FORMAL NONLIMITED PRIVATE TYPE, THAT ALL ALLOWABLE
27--     OPERATIONS ARE IMPLICITLY DECLARED.
28
29-- HISTORY:
30--     BCB 04/04/88  CREATED ORIGINAL TEST.
31--     RJW 03/28/90  INITIALIZED PREVIOUSLY UNINITIALIZED VARIABLES.
32--     LDC 09/19/90  INITALIZED NLPVAR & NLPVAR2 TO DIFFERENT VALUES,
33--                   REMOVED USE CLAUSE.
34--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
35
36WITH REPORT; USE REPORT;
37WITH SYSTEM; USE SYSTEM;
38
39PROCEDURE CC1226B IS
40
41     TYPE DISCREC(DISC1 : INTEGER := 1;
42                  DISC2 : BOOLEAN := FALSE) IS RECORD
43          NULL;
44     END RECORD;
45
46     GENERIC
47          TYPE NLP IS PRIVATE;
48          TYPE NLPDISC(DISC1 : INTEGER;
49                       DISC2 : BOOLEAN) IS PRIVATE;
50          WITH PROCEDURE INITIALIZE (N : OUT NLPDISC);
51          WITH FUNCTION INITIALIZE RETURN NLP;
52          WITH FUNCTION INITIALIZE_2 RETURN NLP;
53     PACKAGE P IS
54          FUNCTION IDENT(X : NLP) RETURN NLP;
55          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
56     END P;
57
58     PACKAGE BODY P IS
59          TYPE DER_NLP IS NEW NLP;
60          NLPVAR : NLP := INITIALIZE_2;
61          NLPVAR2, NLPVAR3 : NLP := INITIALIZE;
62          DERNLP : DER_NLP := DER_NLP (INITIALIZE);
63          NDVAR : NLPDISC(DISC1 => 5, DISC2 => TRUE);
64          NLPVARADDRESS : ADDRESS;
65          NLPSIZE : INTEGER;
66          NLPBASESIZE : INTEGER;
67
68          FUNCTION IDENT(X : NLP) RETURN NLP IS
69               Z : NLP := INITIALIZE;
70          BEGIN
71               IF EQUAL(3,3) THEN
72                    RETURN X;
73               END IF;
74               RETURN Z;
75          END IDENT;
76
77          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
78               I : INTEGER;
79               Z : ADDRESS := I'ADDRESS;
80          BEGIN
81               IF EQUAL(3,3) THEN
82                    RETURN Y;
83               END IF;
84               RETURN Z;
85          END IDENT_ADR;
86
87     BEGIN
88          TEST ("CC1226B", "CHECK, FOR A FORMAL NONLIMITED PRIVATE " &
89                           "TYPE THAT ALL ALLOWABLE OPERATIONS ARE " &
90                           "IMPLICITLY DECLARED");
91
92          INITIALIZE (NDVAR);
93
94          NLPVAR := NLPVAR2;
95
96          IF NLPVAR /= NLPVAR2 THEN
97               FAILED ("IMPROPER VALUE FROM ASSIGNMENT");
98          END IF;
99
100          IF NLPVAR NOT IN NLP THEN
101               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
102          END IF;
103
104          NLPVAR := NLP'(NLPVAR2);
105
106          IF NLPVAR /= NLPVAR2 THEN
107               FAILED ("IMPROPER RESULT FROM QUALIFICATION");
108          END IF;
109
110          NLPVAR := NLP(DERNLP);
111
112          IF NLPVAR /= IDENT(NLP(DERNLP)) THEN
113               FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION");
114          END IF;
115
116          NLPSIZE := IDENT_INT(NLP'SIZE);
117
118          IF NLPSIZE /= INTEGER(NLP'SIZE) THEN
119               FAILED ("IMPROPER VALUE FOR NLP'SIZE");
120          END IF;
121
122          NLPVARADDRESS := NLPVAR'ADDRESS;
123
124          IF NLPVAR'ADDRESS /= IDENT_ADR(NLPVARADDRESS) THEN
125               FAILED ("IMPROPER VALUE FOR NLPVAR'ADDRESS");
126          END IF;
127
128          IF NDVAR.DISC1 /= IDENT_INT(5) THEN
129               FAILED ("IMPROPER DISCRIMINANT VALUE - 1");
130          END IF;
131
132          IF NOT NDVAR.DISC2 THEN
133               FAILED ("IMPROPER DISCRIMINANT VALUE - 2");
134          END IF;
135
136          IF NOT NDVAR'CONSTRAINED THEN
137               FAILED ("IMPROPER VALUE FOR NDVAR'CONSTRAINED");
138          END IF;
139
140          NLPVAR := NLPVAR3;
141
142          IF NOT (NLPVAR = IDENT(NLPVAR3)) THEN
143               FAILED ("IMPROPER VALUE FROM EQUALITY OPERATION");
144          END IF;
145
146          IF NLPVAR /= IDENT(NLPVAR3) THEN
147               FAILED ("IMPROPER VALUE FROM INEQUALITY OPERATION");
148          END IF;
149
150          RESULT;
151     END P;
152
153     PROCEDURE INITIALIZE (I : OUT DISCREC) IS
154     BEGIN
155          I := (5, TRUE);
156     END INITIALIZE;
157
158     FUNCTION INITIALIZE RETURN INTEGER IS
159     BEGIN
160          RETURN 5;
161     END INITIALIZE;
162
163     FUNCTION INITIALIZE_OTHER RETURN INTEGER IS
164     BEGIN
165          RETURN 3;
166     END INITIALIZE_OTHER;
167
168     PACKAGE PACK IS NEW P(INTEGER,
169                           DISCREC,
170                           INITIALIZE,
171                           INITIALIZE,
172                           INITIALIZE_OTHER);
173
174BEGIN
175     NULL;
176END CC1226B;
177