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