1-- 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 48with Ada.Calendar; 49pragma Elaborate (Ada.Calendar); 50 51package 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 96private 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 104end C3900060; 105 106 107 --==================================================================-- 108 109 110package 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 159end C3900060; 160