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