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/] [c3900010.a] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C3900010.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
--      See C3900011.AM.
28
--
29
-- TEST DESCRIPTION:
30
--      See C3900011.AM.
31
--
32
-- TEST FILES:
33
--      This test consists of the following files:
34
--
35
--      => C3900010.A
36
--         C3900011.AM
37
--
38
-- CHANGE HISTORY:
39
--      06 Dec 94   SAIC    ACVC 2.0
40
--      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
41
--                          for Ada.Calendar.
42
--
43
--!
44
 
45
with Ada.Calendar;
46
pragma Elaborate (Ada.Calendar);
47
 
48
package C3900010 is
49
 
50
 
51
   -- Declarations used by component Display_On and procedure Display.
52
 
53
   type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
54
   type Display_Counters is array (Device_Enum) of Natural;
55
 
56
   Display_Count_For : Display_Counters := (others => 0);
57
 
58
 
59
   -- Declarations required for component Arrival_Time.
60
 
61
   Default_Time : constant Ada.Calendar.Time :=
62
                    Ada.Calendar.Time_Of (1901, 1, 1);
63
   Alert_Time   : constant Ada.Calendar.Time :=
64
                    Ada.Calendar.Time_Of (1991, 6, 15);
65
 
66
 
67
   type Alert_Type is tagged record                    -- Root tagged type.
68
      Arrival_Time : Ada.Calendar.Time := Default_Time;
69
      Display_On   : Device_Enum       := Null_Device;
70
   end record;
71
 
72
 
73
   procedure Display (A : in Alert_Type);             -- To be inherited by
74
                                                      -- all derivatives.
75
 
76
   procedure Handle (A : in out Alert_Type);          -- To be inherited by
77
                                                      -- all derivatives.
78
 
79
 
80
 
81
   type Low_Alert_Type is new Alert_Type with record  -- Record extension of
82
      Level : Integer := 0;                           -- root tagged type.
83
   end record;
84
 
85
   -- Inherits procedure Display from Alert.
86
   -- Inherits procedure Handle  from Alert.
87
 
88
   function Level_Of (LA : in Low_Alert_Type)         -- To be inherited by
89
     return Integer;                                  -- all derivatives.
90
 
91
 
92
 
93
   -- Declarations required for component Action_Officer;
94
 
95
   type Person_Enum is (Nobody,          Duty_Officer,
96
                        Watch_Commander, Commanding_Officer);
97
 
98
 
99
 
100
   type Medium_Alert_Type is new Low_Alert_Type with record
101
      Action_Officer : Person_Enum := Nobody;         -- Record extension of
102
   end record;                                        -- record extension.
103
 
104
   -- Inherits (inherited) procedure Display from Low_Alert_Type.
105
   -- Inherits (inherited) procedure Handle  from Low_Alert_Type.
106
 
107
   -- Inherits function Level_Of from Low_Alert_Type.
108
 
109
   procedure Assign_Officer (MA : in out Medium_Alert_Type;
110
                             To : in     Person_Enum);
111
 
112
 
113
end C3900010;
114
 
115
 
116
     --==================================================================--
117
 
118
 
119
package body C3900010 is
120
 
121
 
122
   procedure Display (A : in Alert_Type) is
123
   begin
124
      Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
125
   end Display;
126
 
127
 
128
   procedure Handle (A : in out Alert_Type) is
129
   begin
130
      A.Arrival_Time := Alert_Time;
131
   end Handle;
132
 
133
 
134
   function Level_Of (LA : in Low_Alert_Type) return Integer is
135
   begin
136
      return (LA.Level + 1);
137
   end Level_Of;
138
 
139
 
140
   procedure Assign_Officer (MA : in out Medium_Alert_Type;
141
                             To : in     Person_Enum) is
142
   begin
143
      MA.Action_Officer := To;
144
   end Assign_Officer;
145
 
146
 
147
end C3900010;

powered by: WebSVN 2.1.0

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