1-- C390A011.AM 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-- Check that a nonprivate tagged type declared in a package specification 28-- may be extended with a record extension in a different package 29-- specification, and that this record extension may in turn be extended 30-- by a record extension. 31-- 32-- Check that each derivative inherits the user-defined primitive 33-- subprograms of its parent (including those that its parent inherited), 34-- that it may override these inherited primitive subprograms, and that it 35-- may also declare its own primitive subprograms. 36-- 37-- Check that predefined equality operators are defined for the tagged 38-- type and its derivatives. 39-- 40-- Check that type conversion is defined from a type extension to its 41-- parent, and that this parent itself may be a type extension. 42-- 43-- TEST DESCRIPTION: 44-- Declare a root tagged type and two associated primitive subprograms 45-- in a package specification (foundation code). 46-- 47-- Extend the root type with a record extension in a different package 48-- specification. Declare a new primitive subprogram for the extension, 49-- and override one of the two inherited subprograms. Within the 50-- overriding subprogram, utilize type conversion to call the parent's 51-- implementation of the same subprogram. Also within the overriding 52-- subprogram, call the new primitive subprogram and each inherited 53-- subprogram. 54-- 55-- Extend the extension with a record extension in the same package 56-- specification. Declare a new primitive subprogram for this second 57-- extension, and override one of the three inherited subprograms. 58-- Within the overriding subprogram, utilize type conversion to call the 59-- parent's implementation of the same subprogram. Also within the 60-- overriding subprogram, call the new primitive subprogram and each 61-- inherited subprogram. 62-- 63-- In the main program, declare objects of the root tagged type 64-- and the two type extensions. For each object, call the overriding 65-- subprogram, and verify the correctness of the components by using 66-- aggregates and equality operators, or by checking the components 67-- directly. 68-- 69-- TEST FILES: 70-- This test consists of the following files: 71-- 72-- F390A00.A 73-- C390A010.A 74-- => C390A011.AM 75-- 76-- 77-- CHANGE HISTORY: 78-- 06 Dec 94 SAIC ACVC 2.0 79-- 04 Jun 96 SAIC ACVC 2.1: Modified prologue. 80-- 81--! 82 83with Report; 84 85with F390A00; -- Basic alert abstraction. 86with C390A010; -- Extended alert abstraction. 87 88use F390A00; -- Primitive operations of Alert_Type directly visible. 89 90with Ada.Calendar; 91 92procedure C390A011 is 93 use type Ada.Calendar.Time; -- Equality/inequality ops directly visible. 94begin 95 96 Report.Test ("C390A01", "Primitive operation inheritance by type " & 97 "extensions: all extensions declared in same package, " & 98 "but a different package from that of root type"); 99 100 101 ALERT_SUBTEST: ------------------------------------------------------------- 102 103 declare 104 Alarm : F390A00.Alert_Type; -- Root tagged type. 105 begin 106 107 -- Check "/=" operator availability. Aggregate with positional 108 -- associations: 109 if Alarm /= (Default_Time, Null_Device) then 110 Report.Failed ("Wrong initial values for Alert_Type"); 111 end if; 112 113 Handle (Alarm); 114 115 -- Check "=" operator availability. Aggregate with named 116 -- associations: 117 if not (Alarm = (Arrival_Time => Alert_Time, 118 Display_On => Null_Device)) 119 then 120 Report.Failed ("Wrong values for Alert_Type after Handle"); 121 end if; 122 123 end Alert_Subtest; 124 125 126 -- Check intermediate display counts: 127 128 if F390A00.Display_Count_For (Null_Device) /= 1 or 129 F390A00.Display_Count_For (Teletype) /= 0 or 130 F390A00.Display_Count_For (Console) /= 0 or 131 F390A00.Display_Count_For (Big_Screen) /= 0 132 then 133 Report.Failed ("Wrong display counts after Alert_Type"); 134 end if; 135 136 137 LOW_ALERT_SUBTEST: --------------------------------------------------------- 138 139 declare 140 Low_Alarm : C390A010.Low_Alert_Type; -- Extension of tagged type. 141 use C390A010; -- Primitive operations of extension directly visible. 142 begin 143 144 -- Check "=" operator availability. Aggregate with positional 145 -- associations: 146 if not (Low_Alarm = (Default_Time, Null_Device, 0)) then 147 Report.Failed ("Wrong initial values for Low_Alert_Type"); 148 end if; 149 150 Handle (Low_Alarm); 151 152 -- Check component availability: 153 if Low_Alarm.Arrival_Time /= Alert_Time or 154 Low_Alarm.Display_On /= Teletype or 155 Low_Alarm.Level /= 1 156 then 157 Report.Failed ("Wrong values for Low_Alert_Type after Handle"); 158 end if; 159 160 end Low_Alert_Subtest; 161 162 163 -- Check intermediate display counts: 164 165 if F390A00.Display_Count_For /= (Null_Device => 2, 166 Teletype => 1, 167 Console => 0, 168 Big_Screen => 0) 169 then 170 Report.Failed ("Wrong display counts after Low_Alert_Type"); 171 end if; 172 173 174 MEDIUM_ALERT_SUBTEST: ------------------------------------------------------ 175 176 declare 177 Medium_Alarm : C390A010.Medium_Alert_Type; -- Extension of extension. 178 use C390A010; -- Primitive operations of extension directly visible. 179 begin 180 181 -- Check component availability: 182 if Medium_Alarm.Level /= 0 or 183 Medium_Alarm.Arrival_Time /= Default_Time or 184 Medium_Alarm.Action_Officer /= Nobody or 185 Medium_Alarm.Display_On /= Null_Device 186 then 187 Report.Failed ("Wrong initial values for Medium_Alert_Type"); 188 end if; 189 190 Handle (Medium_Alarm); 191 192 -- Check "/=" operator availability. Aggregate with named 193 -- associations: 194 if Medium_Alarm /= (Arrival_Time => Alert_Time, 195 Display_On => Console, 196 Level => 2, 197 Action_Officer => Duty_Officer) 198 then 199 Report.Failed ("Wrong values for Medium_Alert_Type after Handle"); 200 end if; 201 202 end Medium_Alert_Subtest; 203 204 205 -- Check final display counts: 206 207 if F390A00.Display_Count_For /= (Null_Device => 3, 208 Teletype => 2, 209 Console => 1, 210 Big_Screen => 0) 211 then 212 Report.Failed ("Wrong display counts after Medium_Alert_Type"); 213 end if; 214 215 216 Report.Result; 217 218end C390A011; 219