1-- C95087B.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
26--   RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT
27--   CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE
28--   THE CONSTRAINT OF THE ACTUAL PARAMETER.
29--   SUBTESTS ARE:
30--        (A) RECORD TYPE.
31--        (B) PRIVATE TYPE.
32--        (C) LIMITED PRIVATE TYPE.
33
34-- RJW  1/10/86
35
36WITH REPORT; USE REPORT;
37PROCEDURE C95087B IS
38
39BEGIN
40
41     TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " &
42                       "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" );
43
44     --------------------------------------------------
45
46     DECLARE  -- (A)
47
48          PACKAGE PKG IS
49
50               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
51                    RECORD
52                         INTFIELD  : INTEGER;
53                         STRFIELD  : STRING (1..CONSTRAINT);
54                    END RECORD;
55
56               TASK T IS
57                    ENTRY E (REC9 : OUT RECTYPE;
58                             REC6 : IN OUT RECTYPE);
59               END T;
60
61          END PKG;
62
63          REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
64                 (IDENT_INT(9), 9, "123456789");
65          REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
66                 (IDENT_INT(6), 5, "AEIOUY");
67
68          PACKAGE BODY PKG IS
69
70               TASK BODY T IS
71
72                    REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
73                           (IDENT_INT(4), 4, "OOPS");
74
75               BEGIN
76                    ACCEPT E (REC9 : OUT RECTYPE;
77                              REC6 : IN OUT RECTYPE) DO
78
79                         BEGIN  -- (A.1)
80                              REC9 := REC6;
81                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
82                                      "- A.1");
83                         EXCEPTION
84                              WHEN CONSTRAINT_ERROR =>
85                                   NULL;
86                              WHEN OTHERS =>
87                                   FAILED ("WRONG EXCEPTION RAISED " &
88                                           "- A.1");
89                         END;   -- (A.1)
90
91                         BEGIN  -- (A.2)
92                              REC6 := REC4;
93                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
94                                      "- A.2");
95                         EXCEPTION
96                              WHEN CONSTRAINT_ERROR =>
97                                   NULL;
98                              WHEN OTHERS =>
99                                   FAILED ("WRONG EXCEPTION RAISED " &
100                                           "- A.2");
101                         END;   -- (A.2)
102
103                         REC9 := (IDENT_INT(9), 9, "987654321");
104
105                    END E;
106               END T;
107          END PKG;
108
109     BEGIN  -- (A)
110
111          PKG.T.E (REC9, REC6);
112
113          IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
114               FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
115          END IF;
116
117     END;   -- (A)
118
119     --------------------------------------------------
120
121     DECLARE  -- (B)
122
123          PACKAGE PKG IS
124
125               TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
126
127               TASK T IS
128                    ENTRY  E (REC9 : OUT RECTYPE;
129                              REC6 : IN OUT RECTYPE);
130               END T;
131
132          PRIVATE
133               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
134                    RECORD
135                         INTFIELD  : INTEGER;
136                         STRFIELD  : STRING (1..CONSTRAINT);
137                    END RECORD;
138          END PKG;
139
140          REC9 : PKG.RECTYPE(9);
141          REC6 : PKG.RECTYPE(6);
142
143          PACKAGE BODY PKG IS
144
145               TASK BODY T IS
146
147                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
148
149               BEGIN
150                    ACCEPT E (REC9 : OUT RECTYPE;
151                              REC6 : IN OUT RECTYPE) DO
152
153                         BEGIN  -- (B.1)
154                              REC9 := REC6;
155                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
156                                      "- B.1");
157                         EXCEPTION
158                              WHEN CONSTRAINT_ERROR =>
159                                   NULL;
160                              WHEN OTHERS =>
161                                   FAILED ("WRONG EXCEPTION RAISED " &
162                                           "- B.1");
163                         END;   -- (B.1)
164
165                         BEGIN  -- (B.2)
166                              REC6 := REC4;
167                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
168                                      "- B.2");
169                         EXCEPTION
170                              WHEN CONSTRAINT_ERROR =>
171                                   NULL;
172                              WHEN OTHERS =>
173                                   FAILED ("WRONG EXCEPTION RAISED " &
174                                           "- B.2");
175                         END;   -- (B.2)
176
177                    END E;
178               END T;
179
180          BEGIN
181               REC9 := (9, 9, "123456789");
182               REC6 := (6, 5, "AEIOUY");
183          END PKG;
184
185     BEGIN  -- (B)
186
187          PKG.T.E (REC9, REC6);
188
189     END;   -- (B)
190
191     --------------------------------------------------
192
193     DECLARE  -- (C)
194
195          PACKAGE PKG IS
196
197               TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
198
199               TASK T IS
200                    ENTRY  E (REC9 : OUT RECTYPE;
201                              REC6 : IN OUT RECTYPE);
202               END T;
203
204          PRIVATE
205               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
206                    RECORD
207                         INTFIELD  : INTEGER;
208                         STRFIELD  : STRING (1..CONSTRAINT);
209                    END RECORD;
210          END PKG;
211
212          REC6 : PKG.RECTYPE(IDENT_INT(6));
213          REC9 : PKG.RECTYPE(IDENT_INT(9));
214
215          PACKAGE BODY PKG IS
216
217               TASK BODY T IS
218
219                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
220
221               BEGIN
222                    ACCEPT E (REC9 : OUT RECTYPE;
223                              REC6 : IN OUT RECTYPE) DO
224
225                         BEGIN  -- (C.1)
226                              REC9 := REC6;
227                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
228                                      "- C.1");
229                         EXCEPTION
230                              WHEN CONSTRAINT_ERROR =>
231                                   NULL;
232                              WHEN OTHERS =>
233                                   FAILED ("WRONG EXCEPTION RAISED " &
234                                           "- C.1");
235                         END;   -- (C.1)
236
237                         BEGIN  -- (C.2)
238                              REC6 := REC4;
239                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
240                                      "- C.2");
241                         EXCEPTION
242                              WHEN CONSTRAINT_ERROR =>
243                                   NULL;
244                              WHEN OTHERS =>
245                                   FAILED ("WRONG EXCEPTION RAISED " &
246                                           "- C.2");
247                         END;   -- (C.2)
248
249                    END E;
250               END T;
251
252          BEGIN
253               REC6 := (6, 5, "AEIOUY");
254               REC9 := (9, 9, "123456789");
255          END PKG;
256
257     BEGIN  -- (C)
258
259          PKG.T.E (REC9, REC6);
260
261     END;   -- (C)
262
263     --------------------------------------------------
264
265     RESULT;
266
267END C95087B;
268