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/] [c3900060.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
-- C3900060.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 C3900063.AM.
28
--
29
-- TEST DESCRIPTION:
30
--      See C3900063.AM.
31
--
32
-- TEST FILES:
33
--      This test consists of the following files:
34
--
35
--      => C3900060.A
36
--         C3900061.A
37
--         C3900062.A
38
--         C3900063.AM
39
--
40
--
41
-- CHANGE HISTORY:
42
--      06 Dec 94   SAIC    ACVC 2.0
43
--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
44
--                          for Ada.Calendar.
45
--
46
--!
47
 
48
with Ada.Calendar;
49
pragma Elaborate (Ada.Calendar);
50
 
51
package C3900060 is  -- Alert system abstraction.
52
 
53
 
54
   -- Declarations used by component Arrival_Time.
55
 
56
   Default_Time : constant Ada.Calendar.Time :=
57
                    Ada.Calendar.Time_Of (1901, 1, 1);
58
   Alert_Time   : constant Ada.Calendar.Time :=
59
                    Ada.Calendar.Time_Of (1991, 6, 15);
60
 
61
 
62
   -- Declarations used by component Display_On and procedure Display.
63
 
64
   type Device_Enum      is (Null_Device, Teletype, Console, Big_Screen);
65
   type Display_Counters is array (Device_Enum) of Natural;
66
 
67
   Display_Count_For : Display_Counters := (others => 0);
68
 
69
 
70
 
71
   type Alert_Type is tagged private;                 -- Root tagged type.
72
 
73
   procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
74
                          D : in     Device_Enum);    -- all derivatives.
75
 
76
   procedure Display (A : in Alert_Type);             -- To be inherited by
77
                                                      -- all derivatives.
78
 
79
   procedure Handle (A : in out Alert_Type);          -- To be overridden by
80
                                                      -- all derivatives.
81
 
82
 
83
   -- The following functions are needed to verify the values of the
84
   -- root tagged type's private components.
85
 
86
   function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
87
 
88
   function Get_Display (A: Alert_Type) return Device_Enum;
89
 
90
   function Initial_Values_Okay (A : in Alert_Type)
91
     return Boolean;
92
 
93
   function Bad_Final_Values (A : in Alert_Type)
94
     return Boolean;
95
 
96
private
97
 
98
   type Alert_Type is tagged record                    -- Root tagged type.
99
      Arrival_Time : Ada.Calendar.Time := Default_Time;
100
      Display_On   : Device_Enum   := Null_Device;
101
   end record;
102
 
103
 
104
end C3900060;
105
 
106
 
107
     --==================================================================--
108
 
109
 
110
package body C3900060 is
111
 
112
 
113
   procedure Set_Display (A : in out Alert_Type;
114
                          D : in     Device_Enum) is
115
   begin
116
      A.Display_On := D;
117
   end Set_Display;
118
 
119
 
120
   procedure Display (A : in Alert_Type) is
121
   begin
122
      Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
123
   end Display;
124
 
125
 
126
   procedure Handle (A : in out Alert_Type) is
127
   begin
128
      A.Arrival_Time := Alert_Time;
129
      Display (A);
130
   end Handle;
131
 
132
 
133
   function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
134
   begin
135
      return A.Arrival_Time;
136
   end Get_Time;
137
 
138
 
139
   function Get_Display (A: Alert_Type) return Device_Enum is
140
   begin
141
      return A.Display_On;
142
   end Get_Display;
143
 
144
 
145
   function Initial_Values_Okay (A : in Alert_Type) return Boolean is
146
   begin
147
      return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
148
                   Display_On   => Null_Device));        -- availability.
149
   end Initial_Values_Okay;                              -- Aggregate with
150
                                                         -- named associations.
151
 
152
   function Bad_Final_Values (A : in Alert_Type) return Boolean is
153
   begin
154
      return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
155
                                                         -- availability.
156
   end Bad_Final_Values;                                 -- Aggregate with
157
                                                         -- positional assoc.
158
 
159
end C3900060;

powered by: WebSVN 2.1.0

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