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 structures nesting discriminated records as
28 -- components in record extension are correctly supported. Check
29 -- for this using limited private structures.
30 -- Check that record extensions inherit all the visible components
31 -- of their ancestor types.
32 -- Check that discriminants are correctly inherited.
35 -- This test defines a textbook object, a serial number plaque.
36 -- This object is used in each of several other structures modeled
37 -- after those used in an existing antenna modeling software system.
38 -- Record types discriminated and undiscriminated are nested to
39 -- produce a layered design. Some parametrization is programmatic;
40 -- some parametrization is data-driven.
45 -- 06 Dec 94 SAIC ACVC 2.0
46 -- 19 Dec 94 SAIC Removed RM references from objective text.
47 -- 19 Apr 95 SAIC Added "limited" to full type def of "Object"
52 type Object
is tagged limited private;
53 -- Constructor operation
54 procedure Create
( The_Plaque
: in out Object
);
55 -- Selector operations
56 function "="( Left_Plaque
,Right_Plaque
: Object
) return Boolean;
57 function TC_Match
( Left_Plaque
: Object
; Right_Natural
: Natural )
59 function Serial_Number
( A_Plaque
: Object
) return Natural;
60 Unserialized
: exception; -- Serial_Number called before Create
61 Reserialized
: exception; -- Create called twice
63 type Object
is tagged limited record
64 Serial_Number
: Natural := 0;
68 package body C391001_1
is
69 Counter
: Natural := 0;
70 procedure Create
( The_Plaque
: in out Object
) is
72 if The_Plaque
.Serial_Number
= 0 then
73 Counter
:= Counter
+1;
74 The_Plaque
.Serial_Number
:= Counter
;
80 function "="( Left_Plaque
,Right_Plaque
: Object
) return Boolean is
82 return (Left_Plaque
.Serial_Number
= Right_Plaque
.Serial_Number
)
83 and then -- two uninitialized plates are unequal
84 (Left_Plaque
.Serial_Number
/= 0);
87 function TC_Match
( Left_Plaque
: Object
; Right_Natural
: Natural )
90 return (Left_Plaque
.Serial_Number
= Right_Natural
);
93 function Serial_Number
( A_Plaque
: Object
) return Natural is
95 if A_Plaque
.Serial_Number
= 0 then
98 return A_Plaque
.Serial_Number
;
103 package C391001_2
is -- package Boards is
105 package Plaque
renames C391001_1
;
107 type Modes
is (Receiving
, Transmitting
, Standby
);
108 type Link
(Mode
: Modes
:= Standby
) is record
110 when Receiving
=> TC_R
: Integer := 100;
111 when Transmitting
=> TC_T
: Integer := 200;
112 when Standby
=> TC_S
: Integer := 300; -- TGA, TSA, SSA
116 type Data_Formats
is (S_Band
, KU_Band
, UHF
);
119 type Transceiver
(Band
: Data_Formats
) is tagged limited record
123 when S_Band
=> TC_S_Band_Data
: Integer := 1; -- TGA, SSA
124 when KU_Band
=> TC_KU_Band_Data
: Integer := 2; -- TSA
125 when UHF
=> TC_UHF_Data
: Integer := 3;
132 package C391001_3
is -- package Modules
133 package Plaque
renames C391001_1
;
134 package Boards
renames C391001_2
;
135 use type Boards
.Modes
;
136 use type Boards
.Data_Formats
;
138 type Command_Formats
is ( Set_Compression_Code
,
142 type Electronics_Module
(EBand
: Boards
.Data_Formats
;
143 The_Command_Format
: Command_Formats
)
144 is new Boards
.Transceiver
(EBand
) with record
145 case The_Command_Format
is
146 when Set_Compression_Code
=> TC_SCC
: Integer := 10; -- SSA
147 when Set_Data_Rate
=> TC_SDR
: Integer := 20; -- TGA
148 when Set_Power_State
=> TC_SPS
: Integer := 30; -- TSA
158 package Plaque
renames C391001_1
;
159 package Boards
renames C391001_2
;
160 package Modules
renames C391001_3
;
161 use type Boards
.Modes
;
162 use type Boards
.Data_Formats
;
163 use type Modules
.Command_Formats
;
165 type Azimuth
is range 0..359;
167 type Ground_Antenna
(The_Band
: Boards
.Data_Formats
;
168 The_Command_Format
: Modules
.Command_Formats
) is
171 Electronics
: Modules
.Electronics_Module
(The_Band
,The_Command_Format
);
175 type Space_Antenna
(The_Band
: Boards
.Data_Formats
:= Boards
.KU_Band
;
176 The_Command
: Modules
.Command_Formats
177 := Modules
.Set_Power_State
)
181 Electronics
: Modules
.Electronics_Module
(The_Band
,The_Command
);
184 The_Ground_Antenna
: Ground_Antenna
(Boards
.S_Band
,
185 Modules
.Set_Data_Rate
);
186 The_Space_Antenna
: Space_Antenna
;
187 Space_Station_Antenna
: Space_Antenna
(Boards
.S_Band
,
188 Modules
.Set_Compression_Code
);
191 procedure Validate
( Condition
: Boolean; Message
: String ) is
193 if not Condition
then
194 Report
.Failed
("Failed " & Message
);
199 Report
.Test
("C391001", "Check nested tagged discriminated "
200 & "record structures");
202 Plaque
.Create
( The_Ground_Antenna
.ID
); -- 1
203 Plaque
.Create
( The_Ground_Antenna
.Electronics
.ID
); -- 2
204 Plaque
.Create
( The_Space_Antenna
.ID
); -- 3
205 Plaque
.Create
( The_Space_Antenna
.Electronics
.ID
); -- 4
206 Plaque
.Create
( Space_Station_Antenna
.ID
); -- 5
207 Plaque
.Create
( Space_Station_Antenna
.Electronics
.ID
);-- 6
209 The_Ground_Antenna
.Pointing
:= 180;
210 Validate
( The_Ground_Antenna
.The_Band
= Boards
.S_Band
, "TGA discr 1" );
211 Validate
( The_Ground_Antenna
.The_Command_Format
= Modules
.Set_Data_Rate
,
213 Validate
( Plaque
.TC_Match
(The_Ground_Antenna
.ID
,1), "TGA comp 1" );
214 Validate
( The_Ground_Antenna
.Electronics
.EBand
= Boards
.S_Band
,
215 "TGA comp 2.discr 1" );
216 Validate
( The_Ground_Antenna
.Electronics
.The_Command_Format
217 = Modules
.Set_Data_Rate
, "TGA comp 2.discr 2" );
218 Validate
( The_Ground_Antenna
.Electronics
.TC_SDR
= 20,
220 Validate
( Plaque
.TC_Match
( The_Ground_Antenna
.Electronics
.ID
, 2 ),
221 "TGA comp 2.inher.1" );
222 Validate
( The_Ground_Antenna
.Electronics
.The_Link
.Mode
= Boards
.Standby
,
223 "TGA comp 2.inher.2.discr" );
224 Validate
( The_Ground_Antenna
.Electronics
.The_Link
.TC_S
= 300,
225 "TGA comp 2.inher.2.1" );
226 Validate
( The_Ground_Antenna
.Electronics
.TC_S_Band_Data
= 1,
227 "TGA comp 2.inher.3" );
228 Validate
( The_Ground_Antenna
.Pointing
= 180, "TGA comp 3" );
230 Validate
( The_Space_Antenna
.The_Band
= Boards
.KU_Band
, "TSA discr 1");
231 Validate
( The_Space_Antenna
.The_Command
= Modules
.Set_Power_State
,
233 Validate
( Plaque
.TC_Match
(The_Space_Antenna
.ID
,3),
235 Validate
( The_Space_Antenna
.Electronics
.EBand
= Boards
.KU_Band
,
236 "TSA comp 2.discr 1");
237 Validate
( The_Space_Antenna
.Electronics
.The_Command_Format
238 = Modules
.Set_Power_State
, "TSA comp 2.discr 2");
239 Validate
( Plaque
.TC_Match
(The_Space_Antenna
.Electronics
.ID
,4),
240 "TSA comp 2.inher.1");
241 Validate
( The_Space_Antenna
.Electronics
.The_Link
.Mode
= Boards
.Standby
,
242 "TSA comp 2.inher.2.discr");
243 Validate
( The_Space_Antenna
.Electronics
.The_Link
.TC_S
= 300,
244 "TSA comp 2.inher.2.1");
245 Validate
( The_Space_Antenna
.Electronics
.TC_KU_Band_Data
= 2,
246 "TSA comp 2.inher.3");
247 Validate
( The_Space_Antenna
.Electronics
.TC_SPS
= 30,
250 Validate
( Space_Station_Antenna
.The_Band
= Boards
.S_Band
, "SSA discr 1");
251 Validate
( Space_Station_Antenna
.The_Command
= Modules
.Set_Compression_Code
,
253 Validate
( Plaque
.TC_Match
(Space_Station_Antenna
.ID
,5),
255 Validate
( Space_Station_Antenna
.Electronics
.EBand
= Boards
.S_Band
,
256 "SSA comp 2.discr 1");
257 Validate
( Space_Station_Antenna
.Electronics
.The_Command_Format
258 = Modules
.Set_Compression_Code
, "SSA comp 2.discr 2");
259 Validate
( Plaque
.TC_Match
(Space_Station_Antenna
.Electronics
.ID
,6),
260 "SSA comp 2.inher.1");
261 Validate
( Space_Station_Antenna
.Electronics
.The_Link
.Mode
= Boards
.Standby
,
262 "SSA comp 2.inher.2.discr");
263 Validate
( Space_Station_Antenna
.Electronics
.The_Link
.TC_S
= 300,
264 "SSA comp 2.inher.2.1");
265 Validate
( Space_Station_Antenna
.Electronics
.TC_S_Band_Data
= 1,
266 "SSA comp 2.inher.3");
267 Validate
( Space_Station_Antenna
.Electronics
.TC_SCC
= 10,
270 The_Ground_Antenna
.Electronics
.TC_SDR
:= 1001;
271 The_Ground_Antenna
.Electronics
.The_Link
:=
272 (Boards
.Transmitting
,2001);
273 The_Ground_Antenna
.Electronics
.TC_S_Band_Data
:= 3001;
274 The_Ground_Antenna
.Pointing
:= 41;
276 The_Space_Antenna
.Electronics
.The_Link
:= (Boards
.Receiving
,1010);
277 The_Space_Antenna
.Electronics
.TC_KU_Band_Data
:= 2020;
278 The_Space_Antenna
.Electronics
.TC_SPS
:= 3030;
280 Space_Station_Antenna
.Electronics
.The_Link
281 := The_Space_Antenna
.Electronics
.The_Link
;
282 Space_Station_Antenna
.Electronics
.The_Link
.TC_R
:= 111;
283 Space_Station_Antenna
.Electronics
.TC_S_Band_Data
:= 222;
284 Space_Station_Antenna
.Electronics
.TC_SCC
:= 333;
286 ----------------------------------------------------------------------
287 begin -- should fail discriminant check
288 The_Ground_Antenna
.Electronics
.TC_SCC
:= 909;
289 Report
.Failed
("Discriminant check, no exception");
291 when Constraint_Error
=> null;
293 Report
.Failed
("Discriminant check, wrong exception");
296 Validate
( The_Ground_Antenna
.Electronics
.TC_SDR
= 1001,
298 Validate
( The_Ground_Antenna
.Electronics
.The_Link
.Mode
299 = Boards
.Transmitting
,
300 "assigned value 2.1");
301 Validate
( The_Ground_Antenna
.Electronics
.The_Link
.TC_T
= 2001,
302 "assigned value 2.2");
303 Validate
( The_Ground_Antenna
.Electronics
.TC_S_Band_Data
= 3001,
305 Validate
( The_Ground_Antenna
.Pointing
= 41,
308 Validate
( The_Space_Antenna
.Electronics
.The_Link
.Mode
= Boards
.Receiving
,
309 "assigned value 5.1");
310 Validate
( The_Space_Antenna
.Electronics
.The_Link
.TC_R
= 1010,
311 "assigned value 5.2");
312 Validate
( The_Space_Antenna
.Electronics
.TC_KU_Band_Data
= 2020,
314 Validate
( The_Space_Antenna
.Electronics
.TC_SPS
= 3030,
317 Validate
( Space_Station_Antenna
.Electronics
.The_Link
.Mode
319 "assigned value 8.1");
320 Validate
( Space_Station_Antenna
.Electronics
.The_Link
.TC_R
= 111,
321 "assigned value 8.2");
322 Validate
( Space_Station_Antenna
.Electronics
.TC_S_Band_Data
= 222,
324 Validate
( Space_Station_Antenna
.Electronics
.TC_SCC
= 333,
325 "assigned value 10");