1-- C41307D.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 L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
26-- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
27-- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
28
29-- TBN 12/15/86
30
31WITH REPORT; USE REPORT;
32PROCEDURE C41307D IS
33
34BEGIN
35     TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
36                      "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
37                      "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
38                      "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
39                      "THE UNIT");
40     DECLARE
41          PACKAGE L IS
42               R : INTEGER := 5;
43               A : INTEGER := L.R;
44          END L;
45
46          PACKAGE BODY L IS
47               B : INTEGER := L.R + 1;
48          BEGIN
49               IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
50                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
51               END IF;
52          END L;
53
54          GENERIC
55               S : INTEGER;
56          PACKAGE M IS
57               X : INTEGER := M.S;
58          END M;
59
60          PACKAGE BODY M IS
61               Y : INTEGER := M.S + 1;
62          BEGIN
63               IF IDENT_INT(X) /= 2 OR
64                  IDENT_INT(Y) /= 3 OR
65                  IDENT_INT(M.X) /= 2 THEN
66                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
67               END IF;
68          END M;
69
70          PACKAGE Q IS NEW M(2);
71     BEGIN
72          IF IDENT_INT(Q.X) /= 2 THEN
73               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
74          END IF;
75     END;
76     -------------------------------------------------------------------
77
78     DECLARE
79          CH : CHARACTER := '6';
80
81          PROCEDURE L (R : IN OUT CHARACTER) IS
82               A : CHARACTER := L.R;
83          BEGIN
84               IF IDENT_CHAR(L.A) /= '6' THEN
85                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
86               END IF;
87               L.R := IDENT_CHAR('7');
88          END L;
89
90          GENERIC
91               S : CHARACTER;
92          PROCEDURE M;
93
94          PROCEDURE M IS
95               T : CHARACTER := M.S;
96          BEGIN
97               IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
98                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
99               END IF;
100          END M;
101
102          PROCEDURE P1 IS NEW M('3');
103
104     BEGIN
105          L (CH);
106          IF CH /= IDENT_CHAR('7') THEN
107               FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
108          END IF;
109          P1;
110     END;
111     -------------------------------------------------------------------
112
113     DECLARE
114          INT : INTEGER := 3;
115
116          FUNCTION L (R : INTEGER) RETURN INTEGER IS
117               A : INTEGER := L.R;
118          BEGIN
119               IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
120                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
121               END IF;
122               RETURN IDENT_INT(4);
123          END L;
124
125          GENERIC
126               S : INTEGER;
127          FUNCTION M RETURN INTEGER;
128
129          FUNCTION M RETURN INTEGER IS
130               T : INTEGER := M.S;
131          BEGIN
132               IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
133                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
134               END IF;
135               RETURN IDENT_INT(1);
136          END M;
137
138          FUNCTION F1 IS NEW M(4);
139
140     BEGIN
141          IF L(INT) /= 4 OR F1 /= 1 THEN
142               FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
143          END IF;
144     END;
145     -------------------------------------------------------------------
146
147     DECLARE
148          TASK L IS
149               ENTRY E (A : INTEGER);
150          END L;
151
152          TASK TYPE M IS
153               ENTRY E1 (A : INTEGER);
154          END M;
155
156          T1 : M;
157
158          TASK BODY L IS
159               X : INTEGER := IDENT_INT(1);
160               R : INTEGER RENAMES X;
161               Y : INTEGER := L.R;
162          BEGIN
163               X := X + L.R;
164               IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
165                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
166                            "10");
167               END IF;
168          END L;
169
170          TASK BODY M IS
171               X : INTEGER := IDENT_INT(2);
172               R : INTEGER RENAMES X;
173               Y : INTEGER := M.R;
174          BEGIN
175               ACCEPT E1 (A : INTEGER) DO
176                    X := X + M.R;
177                    IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
178                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
179                                 "NAME - 11");
180                    END IF;
181                    IF E1.A /= IDENT_INT(3) THEN
182                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
183                                 "NAME - 12");
184                    END IF;
185               END E1;
186          END M;
187     BEGIN
188          T1.E1 (3);
189     END;
190     -------------------------------------------------------------------
191
192     DECLARE
193          TASK T IS
194               ENTRY G (1..2) (A : INTEGER);
195          END T;
196
197          TASK BODY T IS
198          BEGIN
199               ACCEPT G (1) (A : INTEGER) DO
200                    IF G.A /= IDENT_INT(2) THEN
201                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
202                                 "NAME - 13");
203                    END IF;
204                    BLK:
205                         DECLARE
206                              B : INTEGER := 7;
207                         BEGIN
208                              IF T.BLK.B /= IDENT_INT(7) THEN
209                                   FAILED ("INCORRECT RESULTS FROM " &
210                                           "EXPANDED NAME - 14");
211                              END IF;
212                         END BLK;
213               END G;
214               ACCEPT G (2) (A : INTEGER) DO
215                    IF G.A /= IDENT_INT(1) THEN
216                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
217                                 "NAME - 15");
218                    END IF;
219               END G;
220          END T;
221     BEGIN
222          T.G (1) (2);
223          T.G (2) (1);
224     END;
225     -------------------------------------------------------------------
226
227     SWAP:
228          DECLARE
229               VAR : CHARACTER := '*';
230               RENAME_VAR : CHARACTER RENAMES VAR;
231               NEW_VAR : CHARACTER;
232          BEGIN
233               IF EQUAL (3, 3) THEN
234                    NEW_VAR := SWAP.RENAME_VAR;
235               END IF;
236               IF NEW_VAR /= IDENT_CHAR('*') THEN
237                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
238                            "16");
239               END IF;
240               LP:  FOR I IN 1..2 LOOP
241                         IF SWAP.LP.I = IDENT_INT(2) OR
242                            LP.I = IDENT_INT(1) THEN
243                              GOTO SWAP.LAB1;
244                         END IF;
245                         NEW_VAR := IDENT_CHAR('+');
246                         <<LAB1>>
247                         NEW_VAR := IDENT_CHAR('-');
248                    END LOOP LP;
249               IF NEW_VAR /= IDENT_CHAR('-') THEN
250                    FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
251               END IF;
252          END SWAP;
253
254     RESULT;
255END C41307D;
256