1-- C3A1002.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 tagged records and task 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 task types are declared with both
37--      default and non default values.  Discriminants for tagged types are
38--      only declared without default values.
39--      In the main program, verify that objects of both groups of incomplete
40--      types can be created by default values or by assignments.
41--
42--
43-- CHANGE HISTORY:
44--      23 Oct 95   SAIC    Initial prerelease version.
45--      19 Oct 96   SAIC    ACVC 2.1: modified test description.  Initialized
46--                          Int_Val.
47--
48--!
49
50package C3A1002_0 is
51
52   subtype Small_Int is Integer range 1 .. 15;
53
54   type Enu_Type is (M, F);
55
56   type Tag_Type is tagged
57     record
58        I : Small_Int := 1;
59     end record;
60
61   type NTag_Type (D : Small_Int) is new Tag_Type with
62     record
63        S : String (1 .. D) := "Aloha";
64     end record;
65
66   type Incomplete1;                               -- no discriminant
67
68   type Incomplete2 (<>);                          -- unknown discriminant
69
70   type Incomplete3;                               -- no discriminant
71
72   type Incomplete4 (<>);                          -- unknown discriminant
73
74   type Incomplete5;                               -- no discriminant
75
76   type Incomplete6 (<>);                          -- unknown discriminant
77
78   type Incomplete1 (D1 : Enu_Type) is tagged      -- no discriminant/
79     record                                        -- explicit discriminant
80        case D1 is
81           when M => MInteger : Small_Int := 9;
82           when F => FInteger : Small_Int := 8;
83        end case;
84     end record;
85
86   type Incomplete2 (D2 : Small_Int) is new       -- unknown discriminant/
87     Incomplete1 (D1 => F) with record            -- explicit discriminant
88        ID : String (1 .. D2) := "ACVC95";
89     end record;
90
91   type Incomplete3 is new                         -- no discriminant/
92     NTag_Type with record                         -- inherited discriminant
93        E : Enu_Type := M;
94     end record;
95
96   type Incomplete4 is new                         -- unknown discriminant/
97     NTag_Type (D => 3) with record                -- inherited discriminant
98        E : Enu_Type := F;
99     end record;
100
101   task type Incomplete5 (D5 : Enu_Type) is      -- no discriminant/
102      entry Read_Disc (P : out Enu_Type);        -- explicit discriminant
103   end Incomplete5;
104
105   task type Incomplete6
106     (D6 : Small_Int := 4) is                    -- unknown discriminant/
107      entry Read_Int (P : out Small_Int);        -- explicit discriminant
108   end Incomplete6;
109
110end C3A1002_0;
111
112     --==================================================================--
113
114package body C3A1002_0 is
115
116   task body Incomplete5 is
117   begin
118      select
119         accept Read_Disc (P : out Enu_Type) do
120            P := D5;
121         end Read_Disc;
122      or
123         terminate;
124      end select;
125
126   end Incomplete5;
127
128   ----------------------------------------------------------------------
129   task body Incomplete6 is
130   begin
131      select
132         accept Read_Int (P : out Small_Int) do
133            P := D6;
134         end Read_Int;
135      or
136         terminate;
137      end select;
138
139   end Incomplete6;
140
141end C3A1002_0;
142
143     --==================================================================--
144
145with Report;
146
147with C3A1002_0;
148use  C3A1002_0;
149
150procedure C3A1002 is
151
152   Enum_Val : Enu_Type := M;
153
154   Int_Val  : Small_Int := 15;
155
156   -- Discriminant value comes from default.
157
158   Incomplete6_Obj_1  :  Incomplete6;
159
160   -- Discriminant value comes from explicit constraint.
161
162   Incomplete1_Obj_1  :  Incomplete1 (M);
163
164   Incomplete2_Obj_1  :  Incomplete2 (6);
165
166   Incomplete5_Obj_1  :  Incomplete5 (F);
167
168   Incomplete6_Obj_2  :  Incomplete6 (7);
169
170   -- Discriminant value comes from assignment.
171
172   Incomplete1_Obj_2  :  Incomplete1
173                      := (F, 12);
174
175   Incomplete3_Obj_1  :  Incomplete3
176                      := (D => 2, S => "Hi", I => 10, E => F);
177
178   Incomplete4_Obj_1  :  Incomplete4
179                      := (E => M, D => 3, S => "Bye", I => 14);
180
181begin
182
183   Report.Test ("C3A1002", "Check that the full type completing a type " &
184                "with no discriminant part or an unknown discriminant "  &
185                "part may have explicitly declared or inherited "        &
186                "discriminants.  Check for cases where the types are "   &
187                "tagged records and task types");
188
189   -- Check the initial values.
190
191   if (Incomplete6_Obj_1.D6 /= 4) then
192      Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
193   end if;
194
195   -- Check the explicit values.
196
197   if (Incomplete1_Obj_1.D1       /= M) or
198      (Incomplete1_Obj_1.MInteger /= 9) then
199        Report.Failed ("Wrong values for Incomplete1_Obj_1");
200   end if;
201
202   if (Incomplete2_Obj_1.D2       /= 6) or
203      (Incomplete2_Obj_1.FInteger /= 8) or
204      (Incomplete2_Obj_1.ID       /= "ACVC95") then
205         Report.Failed ("Wrong values for Incomplete2_Obj_1");
206   end if;
207
208   if (Incomplete5_Obj_1.D5 /= F) then
209      Report.Failed ("Wrong value for Incomplete5_Obj_1");
210   end if;
211
212   Incomplete5_Obj_1.Read_Disc (Enum_Val);
213
214   if (Enum_Val /= F) then
215      Report.Failed ("Wrong value for Enum_Val");
216   end if;
217
218   if (Incomplete6_Obj_2.D6 /= 7) then
219      Report.Failed ("Wrong value for Incomplete6_Obj_2");
220   end if;
221
222   Incomplete6_Obj_1.Read_Int (Int_Val);
223
224   if (Int_Val /= 4) then
225      Report.Failed ("Wrong value for Int_Val");
226   end if;
227
228   -- Check the assigned values.
229
230   if (Incomplete1_Obj_2.D1       /= F)  or
231      (Incomplete1_Obj_2.FInteger /= 12) then
232         Report.Failed ("Wrong values for Incomplete1_Obj_2");
233   end if;
234
235   if (Incomplete3_Obj_1.D /= 2 ) or
236      (Incomplete3_Obj_1.I /= 10) or
237      (Incomplete3_Obj_1.E /= F ) or
238      (Incomplete3_Obj_1.S /= "Hi") then
239         Report.Failed ("Wrong values for Incomplete3_Obj_1");
240   end if;
241
242   if (Incomplete4_Obj_1.E /= M )      or
243      (Incomplete4_Obj_1.D /= 3)       or
244      (Incomplete4_Obj_1.S /= "Bye")   or
245      (Incomplete4_Obj_1.I /= 14)      then
246         Report.Failed ("Wrong values for Incomplete4_Obj_1");
247   end if;
248
249   Report.Result;
250
251end C3A1002;
252