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