|
111
|
1 -- C3A1001.A
|
|
|
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 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that the full type completing a type with no discriminant part
|
|
|
28 -- or an unknown discriminant part may have explicitly declared or
|
|
|
29 -- inherited discriminants.
|
|
|
30 -- Check for cases where the types are records and protected types.
|
|
|
31 --
|
|
|
32 -- TEST DESCRIPTION:
|
|
|
33 -- Declare two groups of incomplete types: one group with no discriminant
|
|
|
34 -- part and one group with unknown discriminant part. Both groups of
|
|
|
35 -- incomplete types are completed with both explicit and inherited
|
|
|
36 -- discriminants. Discriminants for record and protected types are
|
|
|
37 -- declared with default and non default values.
|
|
|
38 -- In the main program, verify that objects of both groups of incomplete
|
|
|
39 -- types can be created by default values or by assignments.
|
|
|
40 --
|
|
|
41 --
|
|
|
42 -- CHANGE HISTORY:
|
|
|
43 -- 11 Oct 95 SAIC Initial prerelease version.
|
|
|
44 -- 11 Nov 96 SAIC Revised for version 2.1.
|
|
|
45 --
|
|
|
46 --!
|
|
|
47
|
|
|
48 package C3A1001_0 is
|
|
|
49
|
|
|
50 type Incomplete1 (<>); -- unknown discriminant
|
|
|
51
|
|
|
52 type Incomplete2; -- no discriminant
|
|
|
53
|
|
|
54 type Incomplete3 (<>); -- unknown discriminant
|
|
|
55
|
|
|
56 type Incomplete4; -- no discriminant
|
|
|
57
|
|
|
58 type Incomplete5 (<>); -- unknown discriminant
|
|
|
59
|
|
|
60 type Incomplete6; -- no discriminant
|
|
|
61
|
|
|
62 type Incomplete8; -- no discriminant
|
|
|
63
|
|
|
64 subtype Small_Int is Integer range 1 .. 10;
|
|
|
65
|
|
|
66 type Enu_Type is (M, F);
|
|
|
67
|
|
|
68 type Incomplete1 (Disc : Enu_Type) is -- unknown discriminant/
|
|
|
69 record -- explicit discriminant
|
|
|
70 case Disc is
|
|
|
71 when M => MInteger : Small_Int := 3;
|
|
|
72 when F => FInteger : Small_Int := 8;
|
|
|
73 end case;
|
|
|
74 end record;
|
|
|
75
|
|
|
76 type Incomplete2 (Disc : Small_Int := 8) is -- no discriminant/
|
|
|
77 record -- explicit discriminant
|
|
|
78 ID : String (1 .. Disc) := "Plymouth";
|
|
|
79 end record;
|
|
|
80
|
|
|
81 type Incomplete3 is new Incomplete2; -- unknown discriminant/
|
|
|
82 -- inherited discriminant
|
|
|
83
|
|
|
84 type Incomplete4 is new Incomplete2; -- no discriminant/
|
|
|
85 -- inherited discriminant
|
|
|
86
|
|
|
87 protected type Incomplete5 -- unknown discriminant/
|
|
|
88 (Disc : Enu_Type) is -- explicit discriminant
|
|
|
89 function Get_Priv_Val return Enu_Type;
|
|
|
90 private
|
|
|
91 Enu_Obj : Enu_Type := Disc;
|
|
|
92 end Incomplete5;
|
|
|
93
|
|
|
94 protected type Incomplete6 -- no discriminant/
|
|
|
95 (Disc : Small_Int := 1) is -- explicit discriminant
|
|
|
96 function Get_Priv_Val return Small_Int; -- with default
|
|
|
97 private
|
|
|
98 Num : Small_Int := Disc;
|
|
|
99 end Incomplete6;
|
|
|
100
|
|
|
101 type Incomplete8 (Disc : Small_Int) is -- no discriminant/
|
|
|
102 record -- explicit discriminant
|
|
|
103 Str : String (1 .. Disc); -- no default
|
|
|
104 end record;
|
|
|
105
|
|
|
106 type Incomplete9 is new Incomplete8;
|
|
|
107
|
|
|
108 function Return_String (S : String) return String;
|
|
|
109
|
|
|
110 end C3A1001_0;
|
|
|
111
|
|
|
112 --==================================================================--
|
|
|
113
|
|
|
114 with Report;
|
|
|
115
|
|
|
116 package body C3A1001_0 is
|
|
|
117
|
|
|
118 protected body Incomplete5 is
|
|
|
119
|
|
|
120 function Get_Priv_Val return Enu_Type is
|
|
|
121 begin
|
|
|
122 return Enu_Obj;
|
|
|
123 end Get_Priv_Val;
|
|
|
124
|
|
|
125 end Incomplete5;
|
|
|
126
|
|
|
127 ----------------------------------------------------------------------
|
|
|
128 protected body Incomplete6 is
|
|
|
129
|
|
|
130 function Get_Priv_Val return Small_Int is
|
|
|
131 begin
|
|
|
132 return Num;
|
|
|
133 end Get_Priv_Val;
|
|
|
134
|
|
|
135 end Incomplete6;
|
|
|
136
|
|
|
137 ----------------------------------------------------------------------
|
|
|
138 function Return_String (S : String) return String is
|
|
|
139 begin
|
|
|
140 if Report.Ident_Bool(True) = True then
|
|
|
141 return S;
|
|
|
142 end if;
|
|
|
143
|
|
|
144 return S;
|
|
|
145 end Return_String;
|
|
|
146
|
|
|
147 end C3A1001_0;
|
|
|
148
|
|
|
149 --==================================================================--
|
|
|
150
|
|
|
151 with Report;
|
|
|
152
|
|
|
153 with C3A1001_0;
|
|
|
154 use C3A1001_0;
|
|
|
155
|
|
|
156 procedure C3A1001 is
|
|
|
157
|
|
|
158 -- Discriminant value comes from default.
|
|
|
159
|
|
|
160 Incomplete2_Obj_1 : Incomplete2;
|
|
|
161
|
|
|
162 Incomplete4_Obj_1 : Incomplete4;
|
|
|
163
|
|
|
164 Incomplete6_Obj_1 : Incomplete6;
|
|
|
165
|
|
|
166 -- Discriminant value comes from explicit constraint.
|
|
|
167
|
|
|
168 Incomplete1_Obj_1 : Incomplete1 (F);
|
|
|
169
|
|
|
170 Incomplete5_Obj_1 : Incomplete5 (M);
|
|
|
171
|
|
|
172 Incomplete6_Obj_2 : Incomplete6 (2);
|
|
|
173
|
|
|
174 -- Discriminant value comes from assignment.
|
|
|
175
|
|
|
176 Incomplete3_Obj_1 : Incomplete3 := (Disc => 6, ID => "Sentra");
|
|
|
177
|
|
|
178 Incomplete1_Obj_2 : Incomplete1 := (Disc => M, MInteger => 9);
|
|
|
179
|
|
|
180 Incomplete2_Obj_2 : Incomplete2 := (Disc => 5, ID => "Buick");
|
|
|
181
|
|
|
182 begin
|
|
|
183
|
|
|
184 Report.Test ("C3A1001", "Check that the full type completing a type " &
|
|
|
185 "with no discriminant part or an unknown discriminant " &
|
|
|
186 "part may have explicitly declared or inherited " &
|
|
|
187 "discriminants. Check for cases where the types are " &
|
|
|
188 "records and protected types");
|
|
|
189
|
|
|
190 -- Check the initial values.
|
|
|
191
|
|
|
192 if (Incomplete2_Obj_1.Disc /= 8) or
|
|
|
193 (Incomplete2_Obj_1.ID /= "Plymouth") then
|
|
|
194 Report.Failed ("Wrong initial values for Incomplete2_Obj_1");
|
|
|
195 end if;
|
|
|
196
|
|
|
197 if (Incomplete4_Obj_1.Disc /= 8) or
|
|
|
198 (Incomplete4_Obj_1.ID /= "Plymouth") then
|
|
|
199 Report.Failed ("Wrong initial values for Incomplete4_Obj_1");
|
|
|
200 end if;
|
|
|
201
|
|
|
202 if (Incomplete6_Obj_1.Disc /= 1) or
|
|
|
203 (Incomplete6_Obj_1.Get_Priv_Val /= 1) then
|
|
|
204 Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
|
|
|
205 end if;
|
|
|
206
|
|
|
207 -- Check the explicit values.
|
|
|
208
|
|
|
209 if (Incomplete1_Obj_1.Disc /= F) or
|
|
|
210 (Incomplete1_Obj_1.FInteger /= 8) then
|
|
|
211 Report.Failed ("Wrong values for Incomplete1_Obj_1");
|
|
|
212 end if;
|
|
|
213
|
|
|
214 if (Incomplete5_Obj_1.Disc /= M) or
|
|
|
215 (Incomplete5_Obj_1.Get_Priv_Val /= M) then
|
|
|
216 Report.Failed ("Wrong value for Incomplete5_Obj_1");
|
|
|
217 end if;
|
|
|
218
|
|
|
219 if (Incomplete6_Obj_2.Disc /= 2) or
|
|
|
220 (Incomplete6_Obj_2.Get_Priv_Val /= 2) then
|
|
|
221 Report.Failed ("Wrong value for Incomplete6_Obj_2");
|
|
|
222 end if;
|
|
|
223
|
|
|
224 -- Check the assigned values.
|
|
|
225
|
|
|
226 if (Incomplete3_Obj_1.Disc /= 6) or
|
|
|
227 (Incomplete3_Obj_1.ID /= "Sentra") then
|
|
|
228 Report.Failed ("Wrong values for Incomplete3_Obj_1");
|
|
|
229 end if;
|
|
|
230
|
|
|
231 if (Incomplete1_Obj_2.Disc /= M) or
|
|
|
232 (Incomplete1_Obj_2.MInteger /= 9) then
|
|
|
233 Report.Failed ("Wrong values for Incomplete1_Obj_2");
|
|
|
234 end if;
|
|
|
235
|
|
|
236 if (Incomplete2_Obj_2.Disc /= 5) or
|
|
|
237 (Incomplete2_Obj_2.ID /= "Buick") then
|
|
|
238 Report.Failed ("Wrong values for Incomplete2_Obj_2");
|
|
|
239 end if;
|
|
|
240
|
|
|
241 -- Make sure that assignments work without problems.
|
|
|
242
|
|
|
243 Incomplete1_Obj_1.FInteger := 1;
|
|
|
244
|
|
|
245 -- Avoid optimization (dead variable removal of FInteger):
|
|
|
246
|
|
|
247 if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1)
|
|
|
248 then
|
|
|
249 Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger");
|
|
|
250 end if;
|
|
|
251
|
|
|
252 Incomplete2_Obj_1.ID := Return_String ("12345678");
|
|
|
253
|
|
|
254 -- Avoid optimization (dead variable removal of ID)
|
|
|
255
|
|
|
256 if Incomplete2_Obj_1.ID /= Return_String ("12345678")
|
|
|
257 then
|
|
|
258 Report.Failed ("Wrong values for Incomplete8_Obj_1.ID");
|
|
|
259 end if;
|
|
|
260
|
|
|
261 Incomplete4_Obj_1.ID := Return_String ("87654321");
|
|
|
262
|
|
|
263 -- Avoid optimization (dead variable removal of ID)
|
|
|
264
|
|
|
265 if Incomplete4_Obj_1.ID /= Return_String ("87654321")
|
|
|
266 then
|
|
|
267 Report.Failed ("Wrong values for Incomplete4_Obj_1.ID");
|
|
|
268 end if;
|
|
|
269
|
|
|
270
|
|
|
271 Test1:
|
|
|
272 declare
|
|
|
273
|
|
|
274 Incomplete8_Obj_1 : Incomplete8 (10);
|
|
|
275
|
|
|
276 begin
|
|
|
277 Incomplete8_Obj_1.Str := "Merry Xmas";
|
|
|
278
|
|
|
279 -- Avoid optimization (dead variable removal of Str):
|
|
|
280
|
|
|
281 if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas"
|
|
|
282 then
|
|
|
283 Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
|
|
|
284 end if;
|
|
|
285
|
|
|
286 exception
|
|
|
287 when Constraint_Error =>
|
|
|
288 Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1");
|
|
|
289
|
|
|
290 end Test1;
|
|
|
291
|
|
|
292 Test2:
|
|
|
293 declare
|
|
|
294
|
|
|
295 Incomplete8_Obj_2 : Incomplete8 (5);
|
|
|
296
|
|
|
297 begin
|
|
|
298 Incomplete8_Obj_2.Str := "Happy";
|
|
|
299
|
|
|
300 -- Avoid optimization (dead variable removal of Str):
|
|
|
301
|
|
|
302 if Return_String (Incomplete8_Obj_2.Str) /= "Happy"
|
|
|
303 then
|
|
|
304 Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
|
|
|
305 end if;
|
|
|
306
|
|
|
307 exception
|
|
|
308 when Constraint_Error =>
|
|
|
309 Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2");
|
|
|
310
|
|
|
311 end Test2;
|
|
|
312
|
|
|
313 Report.Result;
|
|
|
314
|
|
|
315 end C3A1001;
|
