1-- C3900061.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
48with C3900060;       -- Alert system abstraction.
49package C3900061 is  -- Extended alert abstraction.
50
51
52   type Low_Alert_Type is new C3900060.Alert_Type
53     with private;                                      -- Private extension of
54                                                        -- root tagged type.
55
56   -- Inherits procedure Display from Alert_Type.
57
58   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
59                                                        -- primitive subprog.
60
61   procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
62                        L  : in     Integer);           -- all derivatives.
63
64
65   -- The following functions are needed to verify the values of the
66   -- extension's private components.
67
68   function Get_Level (LA: Low_Alert_Type) return Integer;
69
70   function Initial_Values_Okay (LA : in Low_Alert_Type)
71     return Boolean;                                    -- Override parent's
72                                                        -- primitive subprog.
73
74   function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
75     return Boolean;                                    -- primitive subprog.
76
77
78private
79
80   type Low_Alert_Type is new C3900060.Alert_Type with record
81      Level : Integer := 0;
82   end record;
83
84end C3900061;
85
86
87     --==================================================================--
88
89
90with Ada.Calendar;
91pragma Elaborate (Ada.Calendar);
92
93package body C3900061 is
94
95   use C3900060;  -- Alert system abstraction.
96
97
98   procedure Set_Level (LA : in out Low_Alert_Type;
99                        L  : in     Integer) is
100   begin
101      LA.Level := L;
102   end Set_Level;
103
104
105   procedure Handle (LA : in out Low_Alert_Type) is
106   begin
107      Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
108      Set_Level (LA, 1);          -- Call newly declared operation.
109      Set_Display (Alert_Type(LA),
110                   Teletype);     -- Call parent's operation (type conversion).
111      Display (LA);               -- Call inherited operation.
112   end Handle;
113
114
115   function Get_Level (LA: Low_Alert_Type) return Integer is
116   begin
117      return LA.Level;
118   end Get_Level;
119
120
121   function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
122   begin
123      -- Call parent's operation (type conversion).
124      return (Initial_Values_Okay (Alert_Type (LA)) and
125              LA.Level = 0);
126   end Initial_Values_Okay;
127
128
129   function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
130      use type Ada.Calendar.Time;
131   begin
132      return (Get_Time(LA)    /= Alert_Time or
133              Get_Display(LA) /= Teletype or
134              LA.Level        /= 1);
135   end Bad_Final_Values;
136
137
138end C3900061;
139