1-- C37402A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR
26-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT
27-- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL
28-- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER
29-- FOR THE OTHER MODES.
30
31-- R.WILLIAMS 9/1/86
32
33WITH REPORT; USE REPORT;
34PROCEDURE C37402A IS
35
36BEGIN
37     TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
38                       "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
39                       "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
40                       "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
41                       "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
42                       "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
43                       "FOR THE OTHER MODES" );
44
45
46     DECLARE
47
48          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
49
50          TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>)
51               OF INTEGER;
52
53          TYPE SQUARE (SIDE : INT := 1) IS
54               RECORD
55                    MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
56               END RECORD;
57
58          SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));
59
60          AC : SQUARE (2) := (2, ((1, 2), (3, 4)));
61          AU : SQUARE     := (SIDE => 1, MAT => (1 => (1 => 1)));
62
63          BC : SQUARE (2) := AC;
64          BU : SQUARE     := AU;
65
66          CC : SQUARE (2);
67          CU : SQUARE;
68
69          PROCEDURE P (CON, IN_CON : IN     SQUARE;
70                       INOUT_CON   : IN OUT SQUARE;
71                       OUT_CON     : OUT    SQUARE;
72                       IN_UNC      : IN     SQUARE;
73                       INOUT_UNC   : IN OUT SQUARE;
74                       OUT_UNC     : OUT    SQUARE) IS
75
76          BEGIN
77               IF CON'CONSTRAINED THEN
78                    NULL;
79               ELSE
80                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
81                             "OF IN MODE - 1" );
82               END IF;
83
84               IF IN_CON'CONSTRAINED THEN
85                    NULL;
86               ELSE
87                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
88                             "OF IN MODE - 2" );
89               END IF;
90
91               IF IN_UNC'CONSTRAINED THEN
92                    NULL;
93               ELSE
94                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
95                             "OF IN MODE - 3" );
96               END IF;
97
98               IF INOUT_CON'CONSTRAINED THEN
99                    NULL;
100               ELSE
101                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
102                             "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
103               END IF;
104
105               IF OUT_CON'CONSTRAINED THEN
106                    NULL;
107               ELSE
108                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
109                             "CONSTRAINED OBJECT OF OUT MODE - 1" );
110               END IF;
111
112               IF INOUT_UNC'CONSTRAINED THEN
113                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
114                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
115                             "- 1" );
116               END IF;
117
118               IF OUT_UNC'CONSTRAINED THEN
119                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
120                             "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
121               END IF;
122
123               OUT_CON := (2, ((1, 2), (3, 4)));
124               OUT_UNC := (2, ((1, 2), (3, 4)));
125          END P;
126
127          TASK T IS
128               ENTRY Q (CON, IN_CON : IN     SQUARE;
129                        INOUT_CON   : IN OUT SQUARE;
130                        OUT_CON     : OUT    SQUARE;
131                        IN_UNC      : IN     SQUARE;
132                        INOUT_UNC   : IN OUT SQUARE;
133                        OUT_UNC     : OUT    SQUARE);
134          END T;
135
136          TASK BODY T IS
137          BEGIN
138               ACCEPT Q (CON, IN_CON : IN     SQUARE;
139                         INOUT_CON   : IN OUT SQUARE;
140                         OUT_CON     : OUT    SQUARE;
141                         IN_UNC      : IN     SQUARE;
142                         INOUT_UNC   : IN OUT SQUARE;
143                         OUT_UNC     : OUT    SQUARE) DO
144                    BEGIN
145                         IF CON'CONSTRAINED THEN
146                              NULL;
147                         ELSE
148                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
149                                       "OBJECT OF IN MODE - 4" );
150                         END IF;
151
152                         IF IN_CON'CONSTRAINED THEN
153                              NULL;
154                         ELSE
155                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
156                                       "OBJECT OF IN MODE - 5" );
157                         END IF;
158
159                         IF IN_UNC'CONSTRAINED THEN
160                              NULL;
161                         ELSE
162                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
163                                       "OBJECT OF IN MODE - 6" );
164                         END IF;
165
166                         IF INOUT_CON'CONSTRAINED THEN
167                              NULL;
168                         ELSE
169                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
170                                       "CONSTRAINED OBJECT OF " &
171                                       "IN OUT MODE - 2" );
172                         END IF;
173
174                         IF OUT_CON'CONSTRAINED THEN
175                              NULL;
176                         ELSE
177                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
178                                       "CONSTRAINED OBJECT OF " &
179                                       "OUT MODE - 2" );
180                         END IF;
181
182                         IF INOUT_UNC'CONSTRAINED THEN
183                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
184                                       "UNCONSTRAINED OBJECT OF " &
185                                       "IN OUT MODE - 2" );
186                         END IF;
187
188                         IF OUT_UNC'CONSTRAINED THEN
189                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
190                                       "UNCONSTRAINED OBJECT OF " &
191                                       "OUT MODE - 2" );
192                         END IF;
193
194                         OUT_CON := (2, ((1, 2), (3, 4)));
195                         OUT_UNC := (2, ((1, 2), (3, 4)));
196                    END;
197               END Q;
198          END T;
199
200          GENERIC
201               CON, IN_CON : IN     SQUARE;
202               INOUT_CON   : IN OUT SQUARE;
203               IN_UNC      : IN     SQUARE;
204               INOUT_UNC   : IN OUT SQUARE;
205          PACKAGE R IS END R;
206
207          PACKAGE BODY R IS
208          BEGIN
209               IF CON'CONSTRAINED THEN
210                    NULL;
211               ELSE
212                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
213                             "OF IN MODE - 7" );
214               END IF;
215
216               IF IN_CON'CONSTRAINED THEN
217                    NULL;
218               ELSE
219                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
220                             "OF IN MODE - 8" );
221               END IF;
222
223               IF IN_UNC'CONSTRAINED THEN
224                    NULL;
225               ELSE
226                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
227                             "OF IN MODE - 9" );
228               END IF;
229
230               IF INOUT_CON'CONSTRAINED THEN
231                    NULL;
232               ELSE
233                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
234                             "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
235               END IF;
236
237               IF INOUT_UNC'CONSTRAINED THEN
238                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
239                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
240                             "- 3" );
241               END IF;
242
243          END R;
244
245          PACKAGE S IS NEW R (SC, AC, BC, AU, BU);
246
247     BEGIN
248          P (SC, AC, BC, CC, AU, BU, CU);
249          T.Q (SC, AC, BC, CC, AU, BU, CU);
250     END;
251
252     RESULT;
253END C37402A;
254