1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
-- C3A1002.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that the full type completing a type with no discriminant part
-- or an unknown discriminant part may have explicitly declared or
-- inherited discriminants.
-- Check for cases where the types are tagged records and task types.
--
-- TEST DESCRIPTION:
-- Declare two groups of incomplete types: one group with no discriminant
-- part and one group with unknown discriminant part. Both groups of
-- incomplete types are completed with both explicit and inherited
-- discriminants. Discriminants for task types are declared with both
-- default and non default values. Discriminants for tagged types are
-- only declared without default values.
-- In the main program, verify that objects of both groups of incomplete
-- types can be created by default values or by assignments.
--
--
-- CHANGE HISTORY:
-- 23 Oct 95 SAIC Initial prerelease version.
-- 19 Oct 96 SAIC ACVC 2.1: modified test description. Initialized
-- Int_Val.
--
--!
package C3A1002_0 is
subtype Small_Int is Integer range 1 .. 15;
type Enu_Type is (M, F);
type Tag_Type is tagged
record
I : Small_Int := 1;
end record;
type NTag_Type (D : Small_Int) is new Tag_Type with
record
S : String (1 .. D) := "Aloha";
end record;
type Incomplete1; -- no discriminant
type Incomplete2 (<>); -- unknown discriminant
type Incomplete3; -- no discriminant
type Incomplete4 (<>); -- unknown discriminant
type Incomplete5; -- no discriminant
type Incomplete6 (<>); -- unknown discriminant
type Incomplete1 (D1 : Enu_Type) is tagged -- no discriminant/
record -- explicit discriminant
case D1 is
when M => MInteger : Small_Int := 9;
when F => FInteger : Small_Int := 8;
end case;
end record;
type Incomplete2 (D2 : Small_Int) is new -- unknown discriminant/
Incomplete1 (D1 => F) with record -- explicit discriminant
ID : String (1 .. D2) := "ACVC95";
end record;
type Incomplete3 is new -- no discriminant/
NTag_Type with record -- inherited discriminant
E : Enu_Type := M;
end record;
type Incomplete4 is new -- unknown discriminant/
NTag_Type (D => 3) with record -- inherited discriminant
E : Enu_Type := F;
end record;
task type Incomplete5 (D5 : Enu_Type) is -- no discriminant/
entry Read_Disc (P : out Enu_Type); -- explicit discriminant
end Incomplete5;
task type Incomplete6
(D6 : Small_Int := 4) is -- unknown discriminant/
entry Read_Int (P : out Small_Int); -- explicit discriminant
end Incomplete6;
end C3A1002_0;
--==================================================================--
package body C3A1002_0 is
task body Incomplete5 is
begin
select
accept Read_Disc (P : out Enu_Type) do
P := D5;
end Read_Disc;
or
terminate;
end select;
end Incomplete5;
----------------------------------------------------------------------
task body Incomplete6 is
begin
select
accept Read_Int (P : out Small_Int) do
P := D6;
end Read_Int;
or
terminate;
end select;
end Incomplete6;
end C3A1002_0;
--==================================================================--
with Report;
with C3A1002_0;
use C3A1002_0;
procedure C3A1002 is
Enum_Val : Enu_Type := M;
Int_Val : Small_Int := 15;
-- Discriminant value comes from default.
Incomplete6_Obj_1 : Incomplete6;
-- Discriminant value comes from explicit constraint.
Incomplete1_Obj_1 : Incomplete1 (M);
Incomplete2_Obj_1 : Incomplete2 (6);
Incomplete5_Obj_1 : Incomplete5 (F);
Incomplete6_Obj_2 : Incomplete6 (7);
-- Discriminant value comes from assignment.
Incomplete1_Obj_2 : Incomplete1
:= (F, 12);
Incomplete3_Obj_1 : Incomplete3
:= (D => 2, S => "Hi", I => 10, E => F);
Incomplete4_Obj_1 : Incomplete4
:= (E => M, D => 3, S => "Bye", I => 14);
begin
Report.Test ("C3A1002", "Check that the full type completing a type " &
"with no discriminant part or an unknown discriminant " &
"part may have explicitly declared or inherited " &
"discriminants. Check for cases where the types are " &
"tagged records and task types");
-- Check the initial values.
if (Incomplete6_Obj_1.D6 /= 4) then
Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
end if;
-- Check the explicit values.
if (Incomplete1_Obj_1.D1 /= M) or
(Incomplete1_Obj_1.MInteger /= 9) then
Report.Failed ("Wrong values for Incomplete1_Obj_1");
end if;
if (Incomplete2_Obj_1.D2 /= 6) or
(Incomplete2_Obj_1.FInteger /= 8) or
(Incomplete2_Obj_1.ID /= "ACVC95") then
Report.Failed ("Wrong values for Incomplete2_Obj_1");
end if;
if (Incomplete5_Obj_1.D5 /= F) then
Report.Failed ("Wrong value for Incomplete5_Obj_1");
end if;
Incomplete5_Obj_1.Read_Disc (Enum_Val);
if (Enum_Val /= F) then
Report.Failed ("Wrong value for Enum_Val");
end if;
if (Incomplete6_Obj_2.D6 /= 7) then
Report.Failed ("Wrong value for Incomplete6_Obj_2");
end if;
Incomplete6_Obj_1.Read_Int (Int_Val);
if (Int_Val /= 4) then
Report.Failed ("Wrong value for Int_Val");
end if;
-- Check the assigned values.
if (Incomplete1_Obj_2.D1 /= F) or
(Incomplete1_Obj_2.FInteger /= 12) then
Report.Failed ("Wrong values for Incomplete1_Obj_2");
end if;
if (Incomplete3_Obj_1.D /= 2 ) or
(Incomplete3_Obj_1.I /= 10) or
(Incomplete3_Obj_1.E /= F ) or
(Incomplete3_Obj_1.S /= "Hi") then
Report.Failed ("Wrong values for Incomplete3_Obj_1");
end if;
if (Incomplete4_Obj_1.E /= M ) or
(Incomplete4_Obj_1.D /= 3) or
(Incomplete4_Obj_1.S /= "Bye") or
(Incomplete4_Obj_1.I /= 14) then
Report.Failed ("Wrong values for Incomplete4_Obj_1");
end if;
Report.Result;
end C3A1002;
|
