1-- C393011.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-- TEST OBJECTIVE: 27-- Check that an abstract extended type can be derived from an abstract 28-- type, and that a a non-abstract type may then be derived from the 29-- second abstract type. 30-- 31-- TEST DESCRIPTION: 32-- Define an abstract type with three primitive operations, two of them 33-- abstract. Derive an extended type from it, inheriting the non- 34-- abstract operation, overriding one of the abstract operations with 35-- a non-abstract operation, and overriding the other abstract operation 36-- with an abstract operation. The extended type is therefore abstract; 37-- derive an extended type from it. Override the abstract operation with 38-- a non-abstract operation; inherit one operation from the original 39-- abstract type, and inherit one operation from the intermediate 40-- abstract type. 41-- 42-- 43-- CHANGE HISTORY: 44-- 06 Dec 94 SAIC ACVC 2.0 45-- 46--! 47 48 Package C393011_0 is 49 -- Definitions 50 51 type Status_Enum is (None, Unhandled, Pending, Handled); 52 type Serial_Type is new Integer range 0 .. Integer'Last; 53 subtype Priority_Type is Integer range 0..10; 54 55 type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen); 56 57 Next : Serial_Type := 1; 58 Display_Device : Display_Enum := Bit_Bucket; 59 60 end C393011_0; 61 -- Definitions; 62 63 --=======================================================================-- 64 65 with C393011_0; 66 -- Definitions 67 68 Package C393011_1 is 69 -- Alert 70 71 package Definitions renames C393011_0; 72 73 type Alert_Type is abstract tagged record 74 Status : Definitions.Status_Enum := Definitions.None; 75 Serial_Num : Definitions.Serial_Type := 0; 76 Priority : Definitions.Priority_Type; 77 end record; 78 -- Alert_Type is an abstract type with 79 -- two operations to be overridden 80 81 procedure Set_Status ( A : in out Alert_Type; -- not abstract 82 To : Definitions.Status_Enum); 83 84 procedure Set_Serial ( A : in out Alert_Type) is abstract; 85 procedure Display ( A : Alert_Type) is abstract; 86 87 end C393011_1; 88 -- Alert 89 90 --=======================================================================-- 91 92 with C393011_0; 93 package body C393011_1 is 94 -- Alert 95 procedure Set_Status ( A : in out Alert_Type; 96 To : Definitions.Status_Enum) is 97 begin 98 A.Status := To; 99 end Set_Status; 100 101 end C393011_1; 102 -- Alert; 103 104 --=======================================================================-- 105 106 with C393011_0, 107 -- Definitions, 108 C393011_1, 109 -- Alert, 110 Calendar; 111 112 Package C393011_3 is 113 -- New_Alert 114 115 type New_Alert_Type is abstract new C393011_1.Alert_Type with record 116 Display_Dev : C393011_0.Display_Enum := C393011_0.TTY; 117 end record; 118 119 -- procedure Set_Status is inherited 120 121 procedure Set_Serial ( A : in out New_Alert_Type); -- override/see body 122 123 procedure Display ( A : New_Alert_Type) is abstract; 124 -- override is abstract 125 -- still can't declare objects of New_Alert_Type 126 127 end C393011_3; 128 -- New_Alert 129 130 --=======================================================================-- 131 132 with C393011_0; 133 Package Body C393011_3 is 134 -- New_Alert 135 136 package Definitions renames C393011_0; 137 138 procedure Set_Serial (A : in out New_Alert_Type) is 139 use type Definitions.Serial_Type; 140 begin 141 A.Serial_Num := Definitions.Next; 142 Definitions.Next := Definitions."+"( Definitions.Next, 1); 143 end Set_Serial; 144 145 End C393011_3; 146 -- New_Alert; 147 148 --=======================================================================-- 149 150 with C393011_0, 151 -- Definitions 152 C393011_3; 153 -- New_Alert -- package Alert is not visible 154 package C393011_4 is 155 156 package New_Alert renames C393011_3; 157 package Definitions renames C393011_0; 158 159 type Final_Alert_Type is new New_Alert.New_Alert_Type with null record; 160 -- inherits Set_Status including body 161 -- inherits Set_Serial including body 162 -- must override Display since inherited Display is abstract 163 procedure Display(FA : in Final_Alert_Type); 164 procedure Handle (FA : in out Final_Alert_Type); 165 166 end C393011_4; 167 168 package body C393011_4 is 169 170 procedure Display (FA : in Final_Alert_Type) is 171 begin 172 Definitions.Display_Device := FA.Display_Dev; 173 end Display; 174 175 procedure Handle (FA : in out Final_Alert_Type) is 176 begin 177 Set_Status (FA, Definitions.Handled); 178 Set_Serial (FA); 179 Display (FA); 180 end Handle; 181 end C393011_4; 182 183 with C393011_0, 184 -- Definitions 185 C393011_3; 186 -- New_Alert -- package Alert is not visible 187 with C393011_4; 188 with Report; 189 procedure C393011 is 190 use C393011_4; 191 use Definitions; 192 193 FA : Final_Alert_Type; 194 195 begin 196 197 Report.Test ("C393011", "Check that an extended type can be derived " & 198 "from an abstract type"); 199 200 if (Definitions.Display_Device /= Definitions.Bit_Bucket) 201 or (Definitions.Next /= 1) 202 or (FA.Status /= Definitions.None) 203 or (FA.Serial_Num /= 0) 204 or (FA.Display_Dev /= TTY) then 205 Report.Failed ("Incorrect initial conditions"); 206 end if; 207 208 Handle (FA); 209 if (Definitions.Display_Device /= Definitions.TTY) 210 or (Definitions.Next /= 2) 211 or (FA.Status /= Definitions.Handled) 212 or (FA.Serial_Num /= 1) 213 or (FA.Display_Dev /= TTY) then 214 Report.Failed ("Incorrect results from Handle"); 215 end if; 216 217 Report.Result; 218 219 end C393011; 220 221