OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c391002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C391002.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 structures nesting discriminated records as
28
--      components in record extension are correctly supported.
29
--      Check that record extensions inherit all the visible components
30
--      of their ancestor types.
31
--      Check that discriminants are correctly inherited.
32
--
33
-- TEST DESCRIPTION:
34
--      This test defines a simple class hierarchy, where the final
35
--      derivations exercise the different possible "permissions" available
36
--      to a designer.  Extension aggregates for discriminated types are used
37
--      to set values of these final types.  The key difference between
38
--      this test and C391001 is that the types are visible, and allow the
39
--      creation of complex discriminated extension aggregates.  Another
40
--      layer of derivation is present to more robustly check that the
41
--      inheritance is correctly supported.
42
--
43
--
44
-- CHANGE HISTORY:
45
--      06 Dec 94   SAIC    ACVC 2.0
46
--      16 Dec 94   SAIC    Removed offending parenthesis in aggregate
47
--                          extensions, corrected typo: TC_MC SB TC_PC,
48
--                          corrected visibility errors for literals,
49
--                          added qualification for aggregate expressions
50
--                          used in extension aggregates, corrected parameter
51
--                          order in call to Communications.Creator
52
--     01 MAY 95    SAIC    Removed "limited" from the definition of Mil_Comm
53
--     14 OCT 95    SAIC    Fixed some value bugs for ACVC 2.0.1
54
--     04 MAR 96    SAIC    Altered 3 overambitious extension aggregates
55
--     11 APR 96    SAIC    Updated documentation for 2.1
56
--     27 FEB 97    PWB.CTA Deleted extra (illegal) component association
57
--!
58
 
59
----------------------------------------------------------------- C391002_1
60
 
61
package C391002_1 is
62
 
63
  type Object is tagged private;
64
 
65
  -- Constructor operation
66
  procedure Create( The_Plaque : in out Object );
67
 
68
  -- Selector operations
69
  function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
70
    return Boolean;
71
 
72
  function Serial_Number( A_Plaque : Object ) return Natural;
73
 
74
  Unserialized : exception;  -- Serial_Number called before Create
75
  Reserialized : exception;  -- Create called twice
76
 
77
private
78
  type Object is tagged record
79
    Serial_Number : Natural := 0;
80
  end record;
81
end C391002_1;
82
 
83
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
84
 
85
package body C391002_1 is
86
 
87
  Counter : Natural := 0;
88
 
89
  procedure Create( The_Plaque : in out Object ) is
90
  begin
91
    if The_Plaque.Serial_Number = 0 then
92
      Counter := Counter +1;
93
      The_Plaque.Serial_Number := Counter;
94
    else
95
      raise Reserialized;
96
    end if;
97
  end Create;
98
 
99
  function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
100
    return Boolean is
101
  begin
102
    return (Left_Plaque.Serial_Number = Right_Natural);
103
  end TC_Match;
104
 
105
  function Serial_Number( A_Plaque : Object ) return Natural is
106
  begin
107
    if A_Plaque.Serial_Number = 0 then
108
      raise Unserialized;
109
    end if;
110
    return A_Plaque.Serial_Number;
111
  end Serial_Number;
112
end C391002_1;
113
 
114
----------------------------------------------------------------- C391002_2
115
 
116
with C391002_1;
117
package C391002_2 is -- package Boards is
118
 
119
  package Plaque renames C391002_1;
120
 
121
  type Modes is (Receiving, Transmitting, Standby);
122
  type Link(Mode: Modes := Standby) is record
123
    case Mode is
124
      when Receiving    => TC_R : Integer := 100;
125
      when Transmitting => TC_T : Integer := 200;
126
      when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
127
    end case;
128
  end record;
129
 
130
  type Data_Formats is (S_Band, KU_Band, UHF);
131
 
132
  type Transceiver(Band: Data_Formats) is tagged record
133
    ID : Plaque.Object;
134
    The_Link: Link;
135
    case Band is
136
      when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA, Milnet
137
      when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA, Usenet
138
      when UHF     => TC_UHF_Data     : Integer := 3; -- Gossip
139
    end case;
140
  end record;
141
end C391002_2;
142
 
143
----------------------------------------------------------------- C391002_3
144
 
145
with C391002_1;
146
with C391002_2;
147
package C391002_3 is -- package Modules
148
 
149
  package Plaque renames C391002_1;
150
  package Boards renames C391002_2;
151
  use type Boards.Modes;
152
  use type Boards.Data_Formats;
153
 
154
  type Command_Formats is ( Set_Compression_Code,
155
                            Set_Data_Rate,
156
                            Set_Power_State );
157
 
158
  type Electronics_Module(EBand       : Boards.Data_Formats;
159
                          The_Command : Command_Formats)
160
    is new Boards.Transceiver(EBand) with record
161
      case The_Command is
162
        when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA, Gossip
163
        when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA, Usenet
164
        when Set_Power_State      => TC_SPS : Integer := 30; -- TSA, Milnet
165
      end case;
166
    end record;
167
end C391002_3;
168
 
169
----------------------------------------------------------------- C391002_4
170
 
171
with C391002_3;
172
package C391002_4 is -- Communications
173
  package Modules renames C391002_3;
174
 
175
  type Public_Comm is new Modules.Electronics_Module with
176
    record
177
      TC_VC : Integer;
178
    end record;
179
 
180
  type Private_Comm is new Modules.Electronics_Module with private;
181
 
182
  type Mil_Comm is new Modules.Electronics_Module with private;
183
 
184
  procedure Creator( Plugs : in Modules.Electronics_Module;
185
                     Gives : out Mil_Comm);
186
 
187
  function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
188
            return Private_Comm;
189
 
190
  procedure Setup( It : in out Public_Comm;  Value : in Integer );
191
  procedure Setup( It : in out Private_Comm; Value : in Integer );
192
  procedure Setup( It : in out Mil_Comm;     Value : in Integer );
193
 
194
  function  Selector( It : Public_Comm )  return Integer;
195
  function  Selector( It : Private_Comm ) return Integer;
196
  function  Selector( It : Mil_Comm )     return Integer;
197
 
198
private
199
  type Private_Comm is new Modules.Electronics_Module with
200
    record
201
      TC_PC : Integer;
202
    end record;
203
 
204
  type Mil_Comm is new Modules.Electronics_Module with
205
    record
206
      TC_MC : Integer;
207
    end record;
208
end C391002_4; -- Communications
209
 
210
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
211
 
212
with Report;
213
with TCTouch;
214
package body C391002_4 is -- Communications
215
 
216
  procedure Creator( Plugs : in Modules.Electronics_Module;
217
                     Gives : out Mil_Comm) is
218
  begin
219
    Gives := ( Plugs with TC_MC => -1 );
220
  end Creator;
221
 
222
  function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
223
            return Private_Comm is
224
  begin
225
    return ( Plugs with TC_PC => Key );
226
  end Creator;
227
 
228
  procedure Setup( It : in out Public_Comm; Value : in Integer ) is
229
  begin
230
    It.TC_VC := Value;
231
    TCTouch.Assert( Value = 1, "Public_Comm");
232
  end Setup;
233
 
234
  procedure Setup( It : in out Private_Comm; Value : in Integer ) is
235
  begin
236
    It.TC_PC := Value;
237
    TCTouch.Assert( Value = 2, "Private_Comm");
238
  end Setup;
239
 
240
  procedure Setup( It : in out Mil_Comm; Value : in Integer ) is
241
  begin
242
    It.TC_MC := Value;
243
    TCTouch.Assert( Value = 3, "Private_Comm");
244
  end Setup;
245
 
246
  function  Selector( It : Public_Comm )  return Integer is
247
  begin
248
    return It.TC_VC;
249
  end Selector;
250
 
251
  function  Selector( It : Private_Comm ) return Integer is
252
  begin
253
    return It.TC_PC;
254
  end Selector;
255
 
256
  function  Selector( It : Mil_Comm )     return Integer is
257
  begin
258
    return It.TC_MC;
259
  end Selector;
260
 
261
end C391002_4; -- Communications
262
 
263
------------------------------------------------------------------- C391002
264
 
265
with Report;
266
with TCTouch;
267
with C391002_1;
268
with C391002_2;
269
with C391002_3;
270
with C391002_4;
271
procedure C391002 is
272
 
273
  package Plaque  renames C391002_1;
274
  package Boards  renames C391002_2;
275
  package Modules renames C391002_3;
276
  package Communications renames C391002_4;
277
 
278
  procedure Assert( Condition: Boolean; Message: String )
279
    renames TCTouch.Assert;
280
 
281
  use type Boards.Modes;
282
  use type Boards.Data_Formats;
283
  use type Modules.Command_Formats;
284
 
285
  type Azimuth is range 0..359;
286
 
287
  type Ground_Antenna(The_Band    : Boards.Data_Formats;
288
                      The_Command : Modules.Command_Formats) is
289
    record
290
      ID          : Plaque.Object;
291
      Electronics : Modules.Electronics_Module(The_Band,The_Command);
292
      Pointing    : Azimuth;
293
    end record;
294
 
295
  type Space_Antenna(The_Band    : Boards.Data_Formats    := Boards.KU_Band;
296
                     The_Command : Modules.Command_Formats
297
                                   := Modules.Set_Power_State)
298
  is
299
    record
300
      ID          : Plaque.Object;
301
      Electronics : Modules.Electronics_Module(The_Band,The_Command);
302
    end record;
303
 
304
  The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
305
                                           Modules.Set_Data_Rate);
306
  The_Space_Antenna      : Space_Antenna;
307
  Space_Station_Antenna  : Space_Antenna  (Boards.UHF,
308
                                           Modules.Set_Compression_Code);
309
 
310
  Gossip : Communications.Public_Comm  (Boards.UHF,
311
                                        Modules.Set_Compression_Code);
312
  Usenet : Communications.Private_Comm (Boards.KU_Band,
313
                                        Modules.Set_Data_Rate);
314
  Milnet : Communications.Mil_Comm     (Boards.S_Band,
315
                                        Modules.Set_Power_State);
316
 
317
 
318
begin
319
 
320
  Report.Test("C391002", "Check nested tagged discriminated"
321
                       & " record structures");
322
 
323
  Plaque.Create( The_Ground_Antenna.ID );               -- 1
324
  Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
325
  Plaque.Create( The_Space_Antenna.ID );                -- 3
326
  Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
327
  Plaque.Create( Space_Station_Antenna.ID );            -- 5
328
  Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
329
 
330
  The_Ground_Antenna := ( The_Band    => Boards.S_Band,
331
                          The_Command => Modules.Set_Data_Rate,
332
                          ID          => The_Ground_Antenna.ID,
333
                          Electronics =>
334
                          ( Boards.Transceiver'(
335
                              Band     => Boards.S_Band,
336
                              ID       => The_Ground_Antenna.Electronics.ID,
337
                              The_Link => ( Mode => Boards.Transmitting,
338
                                            TC_T => 222 ),
339
                              TC_S_Band_Data => 8 )
340
                            with   EBand       => Boards.S_Band,
341
                                   The_Command => Modules.Set_Data_Rate,
342
                                   TC_SDR      => 11 ),
343
                          Pointing    => 270 );
344
 
345
  The_Space_Antenna := ( The_Band    => Boards.S_Band,
346
                         The_Command => Modules.Set_Data_Rate,
347
                         ID          => The_Space_Antenna.ID,
348
                         Electronics =>
349
                         ( Boards.Transceiver'(
350
                             Band     => Boards.S_Band,
351
                             ID       => The_Space_Antenna.Electronics.ID,
352
                             The_Link => ( Mode => Boards.Transmitting,
353
                                           TC_T => 456 ),
354
                             TC_S_Band_Data => 88 )
355
                           with
356
                               EBand       => Boards.S_Band,
357
                               The_Command => Modules.Set_Data_Rate,
358
                               TC_SDR      => 42
359
                        ) );
360
 
361
  Space_Station_Antenna := ( Boards.UHF, Modules.Set_Compression_Code,
362
                             Space_Station_Antenna.ID,
363
                             ( Boards.Transceiver'(
364
                                 Boards.UHF,
365
                                 Space_Station_Antenna.Electronics.ID,
366
                                 ( Boards.Transmitting, 202 ),
367
                                 42 )
368
                                 with Boards.UHF,
369
                                      Modules.Set_Compression_Code,
370
                                      TC_SCC => 101
371
                           ) );
372
 
373
  Assert( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA disc 1" );
374
  Assert( The_Ground_Antenna.The_Command = Modules.Set_Data_Rate,
375
            "TGA disc 2" );
376
  Assert( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 3" );
377
  Assert( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
378
            "TGA comp 2.disc 1" );
379
  Assert( The_Ground_Antenna.Electronics.The_Command
380
             = Modules.Set_Data_Rate,
381
            "TGA comp 2.disc 2" );
382
  Assert( The_Ground_Antenna.Electronics.TC_SDR = 11,
383
            "TGA comp 2.1" );
384
  Assert( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
385
            "TGA comp 2.inher.1" );
386
  Assert( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
387
            "TGA comp 2.inher.2.disc" );
388
  Assert( The_Ground_Antenna.Electronics.The_Link.TC_T = 222,
389
            "TGA comp 2.inher.2.1" );
390
  Assert( The_Ground_Antenna.Electronics.TC_S_Band_Data = 8,
391
            "TGA comp 2.inher.3" );
392
  Assert( The_Ground_Antenna.Pointing = 270, "TGA comp 3" );
393
 
394
  Assert( The_Space_Antenna.The_Band = Boards.S_Band, "TSA disc 1");
395
  Assert( The_Space_Antenna.The_Command = Modules.Set_Data_Rate,
396
            "TSA disc 2");
397
  Assert( Plaque.TC_Match(The_Space_Antenna.ID,3),
398
            "TSA comp 1");
399
  Assert( The_Space_Antenna.Electronics.EBand = Boards.S_Band,
400
            "TSA comp 2.disc 1");
401
  Assert( The_Space_Antenna.Electronics.The_Command = Modules.Set_Data_Rate,
402
            "TSA comp 2.disc 2");
403
  Assert( The_Space_Antenna.Electronics.TC_SDR = 42,
404
            "TSA comp 2.1");
405
  Assert( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
406
            "TSA comp 2.inher.1");
407
  Assert( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
408
            "TSA comp 2.inher.2.disc");
409
  Assert( The_Space_Antenna.Electronics.The_Link.TC_T = 456,
410
            "TSA comp 2.inher.2.1");
411
  Assert( The_Space_Antenna.Electronics.TC_S_Band_Data = 88,
412
            "TSA comp 2.inher.3");
413
 
414
  Assert( Space_Station_Antenna.The_Band = Boards.UHF, "SSA disc 1");
415
  Assert( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
416
            "SSA disc 2");
417
  Assert( Plaque.TC_Match(Space_Station_Antenna.ID,5),
418
            "SSA comp 1");
419
  Assert( Space_Station_Antenna.Electronics.EBand = Boards.UHF,
420
            "SSA comp 2.disc 1");
421
  Assert( Space_Station_Antenna.Electronics.The_Command
422
             = Modules.Set_Compression_Code,
423
            "SSA comp 2.disc 2");
424
  Assert( Space_Station_Antenna.Electronics.TC_SCC = 101,
425
            "SSA comp 2.1");
426
  Assert( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
427
            "SSA comp 2.inher.1");
428
  Assert( Space_Station_Antenna.Electronics.The_Link.Mode
429
            = Boards.Transmitting,
430
            "SSA comp 2.inher.2.disc");
431
  Assert( Space_Station_Antenna.Electronics.The_Link.TC_T = 202,
432
            "SSA comp 2.inher.2.1");
433
  Assert( Space_Station_Antenna.Electronics.TC_UHF_Data = 42,
434
            "SSA comp 2.inher.3");
435
 
436
 
437
  The_Space_Antenna := ( The_Band    => Boards.S_Band,
438
                         The_Command => Modules.Set_Power_State,
439
                         ID          => The_Space_Antenna.ID,
440
                         Electronics =>
441
                         ( Boards.Transceiver'(
442
                             Band     => Boards.S_Band,
443
                             ID       => The_Space_Antenna.Electronics.ID,
444
                             The_Link => ( Mode => Boards.Transmitting,
445
                                           TC_T => 1 ),
446
                             TC_S_Band_Data => 5 )
447
                           with
448
                               EBand       => Boards.S_Band,
449
                               The_Command => Modules.Set_Power_State,
450
                               TC_SPS      => 101
451
                        ) );
452
 
453
  Communications.Creator( The_Space_Antenna.Electronics, Milnet );
454
  Assert( Communications.Selector( Milnet ) = -1, "Milnet creator" );
455
 
456
  Usenet := Communications.Creator( -2,
457
                     ( Boards.Transceiver'(
458
                         Band        => Boards.KU_Band,
459
                         ID          => The_Space_Antenna.Electronics.ID,
460
                         The_Link    => ( Boards.Transmitting, TC_T => 101 ),
461
                         TC_KU_Band_Data => 395 )
462
                    with Boards.KU_Band, Modules.Set_Data_Rate, 66 ) );
463
 
464
  Assert( Communications.Selector( Usenet ) = -2, "Usenet creator" );
465
 
466
  Gossip := (
467
    Modules.Electronics_Module'(
468
      Boards.Transceiver'(
469
         Band        => Boards.UHF,
470
         ID          => The_Space_Antenna.Electronics.ID,
471
         The_Link    => ( Boards.Transmitting, TC_T => 101 ),
472
         TC_UHF_Data => 395 )
473
       with
474
         Boards.UHF, Modules.Set_Compression_Code, 66 )
475
     with
476
       TC_VC => -3 );
477
 
478
  Assert( Gossip.TC_VC = -3, "Gossip Aggregate" );
479
 
480
  Communications.Setup( Gossip, 1 ); -- (Boards.UHF,
481
                                     -- Modules.Set_Compression_Code)
482
  Communications.Setup( Usenet, 2 ); -- (Boards.KU_Band,
483
                                     -- Modules.Set_Data_Rate)
484
  Communications.Setup( Milnet, 3 ); -- (Boards.S_Band,
485
                                     -- Modules.Set_Power_State)
486
 
487
  Assert( Communications.Selector( Gossip ) = 1, "Gossip Setup" );
488
  Assert( Communications.Selector( Usenet ) = 2, "Usenet Setup" );
489
  Assert( Communications.Selector( Milnet ) = 3, "Milnet Setup" );
490
 
491
  Report.Result;
492
 
493
end C391002;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.