3 -- Grant of Unlimited Rights
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
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.
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.
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.
43 -- 11 Oct 95 SAIC Initial prerelease version.
44 -- 11 Nov 96 SAIC Revised for version 2.1.
50 type Incomplete1
(<>); -- unknown discriminant
52 type Incomplete2
; -- no discriminant
54 type Incomplete3
(<>); -- unknown discriminant
56 type Incomplete4
; -- no discriminant
58 type Incomplete5
(<>); -- unknown discriminant
60 type Incomplete6
; -- no discriminant
62 type Incomplete8
; -- no discriminant
64 subtype Small_Int
is Integer range 1 .. 10;
66 type Enu_Type
is (M
, F
);
68 type Incomplete1
(Disc
: Enu_Type
) is -- unknown discriminant/
69 record -- explicit discriminant
71 when M
=> MInteger
: Small_Int
:= 3;
72 when F
=> FInteger
: Small_Int
:= 8;
76 type Incomplete2
(Disc
: Small_Int
:= 8) is -- no discriminant/
77 record -- explicit discriminant
78 ID
: String (1 .. Disc
) := "Plymouth";
81 type Incomplete3
is new Incomplete2
; -- unknown discriminant/
82 -- inherited discriminant
84 type Incomplete4
is new Incomplete2
; -- no discriminant/
85 -- inherited discriminant
87 protected type Incomplete5
-- unknown discriminant/
88 (Disc
: Enu_Type
) is -- explicit discriminant
89 function Get_Priv_Val
return Enu_Type
;
91 Enu_Obj
: Enu_Type
:= Disc
;
94 protected type Incomplete6
-- no discriminant/
95 (Disc
: Small_Int
:= 1) is -- explicit discriminant
96 function Get_Priv_Val
return Small_Int
; -- with default
98 Num
: Small_Int
:= Disc
;
101 type Incomplete8
(Disc
: Small_Int
) is -- no discriminant/
102 record -- explicit discriminant
103 Str
: String (1 .. Disc
); -- no default
106 type Incomplete9
is new Incomplete8
;
108 function Return_String
(S
: String) return String;
112 --==================================================================--
116 package body C3A1001_0
is
118 protected body Incomplete5
is
120 function Get_Priv_Val
return Enu_Type
is
127 ----------------------------------------------------------------------
128 protected body Incomplete6
is
130 function Get_Priv_Val
return Small_Int
is
137 ----------------------------------------------------------------------
138 function Return_String
(S
: String) return String is
140 if Report
.Ident_Bool
(True) = True then
149 --==================================================================--
158 -- Discriminant value comes from default.
160 Incomplete2_Obj_1
: Incomplete2
;
162 Incomplete4_Obj_1
: Incomplete4
;
164 Incomplete6_Obj_1
: Incomplete6
;
166 -- Discriminant value comes from explicit constraint.
168 Incomplete1_Obj_1
: Incomplete1
(F
);
170 Incomplete5_Obj_1
: Incomplete5
(M
);
172 Incomplete6_Obj_2
: Incomplete6
(2);
174 -- Discriminant value comes from assignment.
176 Incomplete3_Obj_1
: Incomplete3
:= (Disc
=> 6, ID
=> "Sentra");
178 Incomplete1_Obj_2
: Incomplete1
:= (Disc
=> M
, MInteger
=> 9);
180 Incomplete2_Obj_2
: Incomplete2
:= (Disc
=> 5, ID
=> "Buick");
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");
190 -- Check the initial values.
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");
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");
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");
207 -- Check the explicit values.
209 if (Incomplete1_Obj_1
.Disc
/= F
) or
210 (Incomplete1_Obj_1
.FInteger
/= 8) then
211 Report
.Failed
("Wrong values for Incomplete1_Obj_1");
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");
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");
224 -- Check the assigned values.
226 if (Incomplete3_Obj_1
.Disc
/= 6) or
227 (Incomplete3_Obj_1
.ID
/= "Sentra") then
228 Report
.Failed
("Wrong values for Incomplete3_Obj_1");
231 if (Incomplete1_Obj_2
.Disc
/= M
) or
232 (Incomplete1_Obj_2
.MInteger
/= 9) then
233 Report
.Failed
("Wrong values for Incomplete1_Obj_2");
236 if (Incomplete2_Obj_2
.Disc
/= 5) or
237 (Incomplete2_Obj_2
.ID
/= "Buick") then
238 Report
.Failed
("Wrong values for Incomplete2_Obj_2");
241 -- Make sure that assignments work without problems.
243 Incomplete1_Obj_1
.FInteger
:= 1;
245 -- Avoid optimization (dead variable removal of FInteger):
247 if Incomplete1_Obj_1
.FInteger
/= Report
.Ident_Int
(1)
249 Report
.Failed
("Wrong value stored in Incomplete1_Obj_1.FInteger");
252 Incomplete2_Obj_1
.ID
:= Return_String
("12345678");
254 -- Avoid optimization (dead variable removal of ID)
256 if Incomplete2_Obj_1
.ID
/= Return_String
("12345678")
258 Report
.Failed
("Wrong values for Incomplete8_Obj_1.ID");
261 Incomplete4_Obj_1
.ID
:= Return_String
("87654321");
263 -- Avoid optimization (dead variable removal of ID)
265 if Incomplete4_Obj_1
.ID
/= Return_String
("87654321")
267 Report
.Failed
("Wrong values for Incomplete4_Obj_1.ID");
274 Incomplete8_Obj_1
: Incomplete8
(10);
277 Incomplete8_Obj_1
.Str
:= "Merry Xmas";
279 -- Avoid optimization (dead variable removal of Str):
281 if Return_String
(Incomplete8_Obj_1
.Str
) /= "Merry Xmas"
283 Report
.Failed
("Wrong values for Incomplete8_Obj_1.Str");
287 when Constraint_Error
=>
288 Report
.Failed
("Constraint_Error raised in Incomplete8_Obj_1");
295 Incomplete8_Obj_2
: Incomplete8
(5);
298 Incomplete8_Obj_2
.Str
:= "Happy";
300 -- Avoid optimization (dead variable removal of Str):
302 if Return_String
(Incomplete8_Obj_2
.Str
) /= "Happy"
304 Report
.Failed
("Wrong values for Incomplete8_Obj_1.Str");
308 when Constraint_Error
=>
309 Report
.Failed
("Constraint_Error raised in Incomplete8_Obj_2");