1-- C3900053.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 private tagged type declared in a package specification 28-- may be extended with a private extension in a different package 29-- specification, and that this private extension may in turn be extended 30-- by a private extension in a third package. 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 type conversion is defined from a type extension to its 38-- parent, and that this parent itself may be a type extension. 39-- 40-- TEST DESCRIPTION: 41-- Declare a root tagged private type and two associated primitive 42-- subprograms in a package specification. Declare operations to verify 43-- the correctness of the components. Declare operations which return 44-- values of the type's private components, and which will be 45-- inherited by later derivatives. 46-- 47-- Extend the root type with a private extension in a second 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. Declare operations of the private extension which 54-- override the verification operations of its parent. Declare operations 55-- of the private extension which return values of the extension's 56-- private components, and which will be inherited by later derivatives. 57-- 58-- Extend the extension with a private extension in a third package 59-- specification. Declare a new primitive subprogram for this private 60-- extension, and override one of the three inherited subprograms. 61-- Within the overriding subprogram, utilize type conversion to call the 62-- parent's implementation of the same subprogram. Also within the 63-- overriding subprogram, call the new primitive subprogram and each 64-- inherited subprogram. Declare operations of the private extension 65-- which override the verification operations of its parent. 66-- 67-- In the main program, declare objects of the root tagged type and 68-- the two type extensions. For each object, call the overriding 69-- subprogram, and verify the correctness of the components by calling 70-- the verification operations. 71-- 72-- TEST FILES: 73-- This test consists of the following files: 74-- 75-- C3900050.A 76-- C3900051.A 77-- C3900052.A 78-- => C3900053.AM 79-- 80-- 81-- CHANGE HISTORY: 82-- 06 Dec 94 SAIC ACVC 2.0 83-- 15 May 96 SAIC ACVC 2.1: Modified prologue. 84-- 85--! 86 87with Report; 88 89with C3900050; -- Basic alert abstraction. 90with C3900051; -- Extended alert abstraction. 91with C3900052; -- Further extended alert abstraction. 92 93use C3900050; -- Primitive operations of Alert_Type directly visible. 94 95procedure C3900053 is 96begin 97 98 Report.Test ("C390005", "Primitive operation inheritance by type " & 99 "extensions: root type is private; all extensions are " & 100 "private and declared in different packages"); 101 102 103 ALERT_SUBTEST: ------------------------------------------------------------- 104 105 declare 106 Alarm : C3900050.Alert_Type; -- Root tagged private type. 107 begin 108 if not Initial_Values_Okay (Alarm) then 109 Report.Failed ("Wrong initial values for Alert_Type"); 110 end if; 111 112 Handle (Alarm); 113 114 if Bad_Final_Values (Alarm) then 115 Report.Failed ("Wrong values for Alert_Type after Handle"); 116 end if; 117 end Alert_Subtest; 118 119 120 -- Check intermediate display counts: 121 122 if C3900050.Display_Count_For (Null_Device) /= 1 or 123 C3900050.Display_Count_For (Teletype) /= 0 or 124 C3900050.Display_Count_For (Console) /= 0 or 125 C3900050.Display_Count_For (Big_Screen) /= 0 126 then 127 Report.Failed ("Wrong display counts after Alert_Type"); 128 end if; 129 130 131 LOW_ALERT_SUBTEST: --------------------------------------------------------- 132 133 declare 134 Low_Alarm : C3900051.Low_Alert_Type; -- Priv. ext. of tagged type. 135 use C3900051; -- Primitive operations of extension directly visible. 136 begin 137 if not Initial_Values_Okay (Low_Alarm) then 138 Report.Failed ("Wrong initial values for Low_Alert_Type"); 139 end if; 140 141 Handle (Low_Alarm); 142 143 if Bad_Final_Values (Low_Alarm) then 144 Report.Failed ("Wrong values for Low_Alert_Type after Handle"); 145 end if; 146 end Low_Alert_Subtest; 147 148 149 -- Check intermediate display counts: 150 151 if C3900050.Display_Count_For /= (Null_Device => 2, 152 Teletype => 1, 153 Console => 0, 154 Big_Screen => 0) 155 then 156 Report.Failed ("Wrong display counts after Low_Alert_Type"); 157 end if; 158 159 160 MEDIUM_ALERT_SUBTEST: ------------------------------------------------------ 161 162 declare 163 Medium_Alarm : C3900052.Medium_Alert_Type; -- Priv. ext. of extension. 164 use C3900052; -- Primitive operations of extension directly visible. 165 begin 166 if not Initial_Values_Okay (Medium_Alarm) then 167 Report.Failed ("Wrong initial values for Medium_Alert_Type"); 168 end if; 169 170 Handle (Medium_Alarm); 171 172 if Bad_Final_Values (Medium_Alarm) then 173 Report.Failed ("Wrong values for Medium_Alert_Type after Handle"); 174 end if; 175 end Medium_Alert_Subtest; 176 177 178 -- Check final display counts: 179 180 if C3900050.Display_Count_For /= (Null_Device => 3, 181 Teletype => 2, 182 Console => 1, 183 Big_Screen => 0) 184 then 185 Report.Failed ("Wrong display counts after Medium_Alert_Type"); 186 end if; 187 188 189 Report.Result; 190 191end C3900053; 192