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
48package 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
110end C3A1001_0;
111
112     --==================================================================--
113
114with Report;
115
116package 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
147end C3A1001_0;
148
149     --==================================================================--
150
151with Report;
152
153with C3A1001_0;
154use  C3A1001_0;
155
156procedure 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
182begin
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
315end C3A1001;
316