1-- C95071A.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 OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
26-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
27-- PARAMETER OF ANY MODE.  SUBTESTS ARE:
28--        (A) INTEGER ACCESS TYPE.
29--        (B) ARRAY ACCESS TYPE.
30--        (C) RECORD ACCESS TYPE.
31
32-- JWC 7/11/85
33
34WITH REPORT; USE REPORT;
35PROCEDURE C95071A IS
36
37BEGIN
38
39     TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
40                      "MAY BE USED IN ASSIGNMENT CONTEXTS");
41
42     --------------------------------------------------
43
44     DECLARE   -- (A)
45
46          TYPE PTRINT IS ACCESS INTEGER;
47          PI : PTRINT;
48
49          TASK TA IS
50               ENTRY EA (PI : IN PTRINT);
51          END TA;
52
53          TASK BODY TA IS
54          BEGIN
55               ACCEPT EA (PI : IN PTRINT) DO
56                    DECLARE
57                         TASK TA1 IS
58                              ENTRY EA1 (I : OUT INTEGER);
59                              ENTRY EA2 (I : IN OUT INTEGER);
60                         END TA1;
61
62                         TASK BODY TA1 IS
63                         BEGIN
64                              ACCEPT EA1 (I : OUT INTEGER) DO
65                                   I := 7;
66                              END EA1;
67
68                              ACCEPT EA2 (I : IN OUT INTEGER) DO
69                                   I := I + 1;
70                              END EA2;
71                         END TA1;
72
73                    BEGIN
74                         TA1.EA1 (PI.ALL);
75                         TA1.EA2 (PI.ALL);
76                         PI.ALL := PI.ALL + 1;
77                         IF (PI.ALL /= 9) THEN
78                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
79                                      "INTEGER ACCESS PARAMETER " &
80                                      "FAILED");
81                         END IF;
82                    END;
83               END EA;
84          END TA;
85
86     BEGIN     -- (A)
87
88          PI := NEW INTEGER'(0);
89          TA.EA (PI);
90
91     END;      -- (A)
92
93     ---------------------------------------------
94
95     DECLARE   -- (B)
96
97          TYPE TBL IS ARRAY (1..3) OF INTEGER;
98          TYPE PTRTBL IS ACCESS TBL;
99          PT : PTRTBL;
100
101          TASK TB IS
102               ENTRY EB (PT : IN PTRTBL);
103          END TB;
104
105          TASK BODY TB IS
106          BEGIN
107               ACCEPT EB (PT : IN PTRTBL) DO
108                    DECLARE
109                         TASK TB1 IS
110                              ENTRY EB1 (T : OUT TBL);
111                              ENTRY EB2 (T : IN OUT TBL);
112                              ENTRY EB3 (I : OUT INTEGER);
113                              ENTRY EB4 (I : IN OUT INTEGER);
114                         END TB1;
115
116                         TASK BODY TB1 IS
117                         BEGIN
118                              ACCEPT EB1 (T : OUT TBL) DO
119                                   T := (1,2,3);
120                              END EB1;
121
122                              ACCEPT EB2 (T : IN OUT TBL) DO
123                                   T(3) := T(3) - 1;
124                              END EB2;
125
126                              ACCEPT EB3 (I : OUT INTEGER) DO
127                                   I := 7;
128                              END EB3;
129
130                              ACCEPT EB4 (I : IN OUT INTEGER) DO
131                                   I := I + 1;
132                              END EB4;
133                         END TB1;
134
135                    BEGIN
136                         TB1.EB1 (PT.ALL);         -- (1,2,3)
137                         TB1.EB2 (PT.ALL);         -- (1,2,2)
138                         TB1.EB3 (PT(2));          -- (1,7,2)
139                         TB1.EB4 (PT(1));          -- (2,7,2)
140                         PT(3) := PT(3) + 7;      -- (2,7,9)
141                         IF (PT.ALL /= (2,7,9)) THEN
142                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
143                                      "ARRAY ACCESS PARAMETER FAILED");
144                         END IF;
145                    END;
146               END EB;
147          END TB;
148
149     BEGIN     -- (B)
150
151          PT := NEW TBL'(0,0,0);
152          TB.EB (PT);
153
154     END;      -- (B)
155
156     ---------------------------------------------
157
158     DECLARE   -- (C)
159
160          TYPE REC IS
161               RECORD
162                    I1   : INTEGER;
163                    I2   : INTEGER;
164                    I3   : INTEGER;
165               END RECORD;
166
167          TYPE PTRREC IS ACCESS REC;
168          PR : PTRREC;
169
170          TASK TC IS
171               ENTRY EC (PR : IN PTRREC);
172          END TC;
173
174          TASK BODY TC IS
175          BEGIN
176               ACCEPT EC (PR : IN PTRREC) DO
177                    DECLARE
178                         TASK TC1 IS
179                              ENTRY EC1 (R : OUT REC);
180                              ENTRY EC2 (R : IN OUT REC);
181                              ENTRY EC3 (I : OUT INTEGER);
182                              ENTRY EC4 (I : IN OUT INTEGER);
183                         END TC1;
184
185                         TASK BODY TC1 IS
186                         BEGIN
187                              ACCEPT EC1 (R : OUT REC) DO
188                                   R := (1,2,3);
189                              END EC1;
190
191                              ACCEPT EC2 (R : IN OUT REC) DO
192                                   R.I3 := R.I3 - 1;
193                              END EC2;
194
195                              ACCEPT EC3 (I : OUT INTEGER) DO
196                                   I := 7;
197                              END  EC3;
198
199                              ACCEPT EC4 (I : IN OUT INTEGER) DO
200                                   I := I + 1;
201                              END EC4;
202                         END TC1;
203
204                    BEGIN
205                         TC1.EC1 (PR.ALL);         -- (1,2,3)
206                         TC1.EC2 (PR.ALL);         -- (1,2,2)
207                         TC1.EC3 (PR.I2);          -- (1,7,2)
208                         TC1.EC4 (PR.I1);          -- (2,7,2)
209                         PR.I3 := PR.I3 + 7;       -- (2,7,9)
210                         IF (PR.ALL /= (2,7,9)) THEN
211                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
212                                      "RECORD ACCESS PARAMETER " &
213                                      "FAILED");
214                         END IF;
215                    END;
216               END EC;
217          END TC;
218
219     BEGIN     -- (C)
220
221          PR := NEW REC'(0,0,0);
222          TC.EC (PR);
223
224     END;      -- (C)
225
226     ---------------------------------------------
227
228     RESULT;
229
230END C95071A;
231