1-- CA11B01.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-- Check that a type derived in a public child inherits primitive 28-- operations from parent. 29-- 30-- TEST DESCRIPTION: 31-- Declare a root record type with discriminant in a package 32-- specification. Declare a primitive subprogram for the type 33-- (foundation code). 34-- 35-- Add a public child to the above package. Derive a new type 36-- with constraint to the discriminant record type from the parent 37-- package. Declare a new primitive subprogram to write to the child 38-- derived type. 39-- 40-- Add a new public child to the above package. This grandchild package 41-- derives a new type using the record type from the above package. 42-- Declare a new primitive subprogram to write to the grandchild derived 43-- type. 44-- 45-- In the main program, "with" the grandchild. Access the inherited 46-- operations from grandparent, parent, and grandchild packages. 47-- 48-- TEST FILES: 49-- This test depends on the following foundation code: 50-- 51-- FA11B00.A 52-- 53-- 54-- CHANGE HISTORY: 55-- 06 Dec 94 SAIC ACVC 2.0 56-- 57--! 58 59-- Child package of FA11B00. 60package FA11B00.CA11B01_0 is -- Application_Two_Widget 61-- This public child declares a derived type from its parent. It 62-- represents processing of widgets in a window system. 63 64 type App2_Widget is new App1_Widget (Maximum_Size => 5000); 65 -- Inherits procedure Create_Widget from parent. 66 67 -- Primitive operation of type App2_Widget. 68 -- To be inherited by its children derivatives. 69 procedure App2_Widget_Specific_Oper (The_Widget : in out App2_Widget; 70 Loc : in Widget_Location); 71 72end FA11B00.CA11B01_0; -- Application_Two_Widget 73 74--=======================================================================-- 75 76package body FA11B00.CA11B01_0 is -- Application_Two_Widget 77 78 procedure App2_Widget_Specific_Oper 79 (The_Widget : in out App2_Widget; 80 Loc : in Widget_Location) is 81 begin 82 The_Widget.Location := Loc; 83 end App2_Widget_Specific_Oper; 84 85end FA11B00.CA11B01_0; -- Application_Two_Widget 86 87--=======================================================================-- 88 89-- Grandchild package of FA11B00, child package of FA11B00.CA11B01_0. 90package FA11B00.CA11B01_0.CA11B01_1 is -- Application_Three_Widget 91-- This public grandchild declares a derived type from its parent. It 92-- represents processing of widgets in a window system. 93 94 type App3_Widget is new App2_Widget; -- Derived record of App2_Widget. 95 96 -- Inherits (inherited) procedure Create_Widget from Application_One_Widget. 97 -- Inherits procedure App2_Widget_Specific_Oper from App2_Widget. 98 99 -- Primitive operation of type App3_Widget. 100 procedure App3_Widget_Specific_Oper (The_Widget : in out App3_Widget; 101 S : in Widget_Size); 102 103end FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget 104 105--=======================================================================-- 106 107package body FA11B00.CA11B01_0.CA11B01_1 is -- Application_Three_Widget 108 109 procedure App3_Widget_Specific_Oper 110 (The_Widget : in out App3_Widget; 111 S : in Widget_Size) is 112 begin 113 The_Widget.Size := S; 114 end App3_Widget_Specific_Oper; 115 116end FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget 117 118--=======================================================================-- 119 120with FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget, 121 -- implicitly with Application_Two_Widget, 122 -- implicitly with Application_Three_Widget. 123with Report; 124 125procedure CA11B01 is 126 127 package Application_One_Widget renames FA11B00; 128 package Application_Two_Widget renames FA11B00.CA11B01_0; 129 package Application_Three_Widget renames FA11B00.CA11B01_0.CA11B01_1; 130 131 use Application_One_Widget; 132 use Application_Two_Widget; 133 use Application_Three_Widget; 134 135begin 136 137 Report.Test ("CA11B01", "Check that a type derived in a public " & 138 "child inherits primitive operations from parent"); 139 140 Application_One_Subtest: 141 declare 142 White_Widget : App1_Widget; 143 144 begin 145 -- perform an App1_Widget specific operation. 146 App1_Widget_Specific_Oper (C => White, L => "Line Editor ", 147 The_Widget => White_Widget, I => 10); 148 149 If White_Widget.Color /= White or 150 White_Widget.Id /= Widget_ID 151 (Report.Ident_Int (10)) or 152 White_Widget.Label /= "Line Editor " then 153 Report.Failed ("Incorrect result for White_Widget"); 154 end if; 155 156 end Application_One_Subtest; 157 --------------------------------------------------------------- 158 Application_Two_Subtest: 159 declare 160 Amber_Widget : App2_Widget; 161 162 begin 163 App1_Widget_Specific_Oper (Amber_Widget, I => 11, 164 C => Amber, L => "Alarm_Clock "); 165 -- Inherited from Application_One_Widget. 166 167 -- perform an App2_Widget specific operation. 168 App2_Widget_Specific_Oper (The_Widget => Amber_Widget, Loc => (380,512)); 169 170 If Amber_Widget.Color /= Amber or 171 Amber_Widget.Id /= Widget_ID (Report.Ident_Int (11)) or 172 Amber_Widget.Label /= "Alarm_Clock " or 173 Amber_Widget.Location /= (380,512) then 174 Report.Failed ("Incorrect result for Amber_Widget"); 175 end if; 176 177 end Application_Two_Subtest; 178 --------------------------------------------------------------- 179 Application_Three_Subtest: 180 declare 181 Green_Widget : App3_Widget; 182 183 begin 184 App1_Widget_Specific_Oper (Green_Widget, 100, Green, 185 "Screen Editor "); 186 -- Inherited (inherited) from Basic_Widget. 187 188 -- perform an App2_Widget specific operation. 189 App2_Widget_Specific_Oper (Loc => (1024,760), 190 The_Widget => Green_Widget); 191 -- Inherited from App_1_Widget. 192 193 -- perform an App3_Widget specific operation. 194 App3_Widget_Specific_Oper (Green_Widget, S => (100,100)); 195 196 If Green_Widget.Color /= Green or 197 Green_Widget.Id /= Widget_ID (Report.Ident_Int (100)) or 198 Green_Widget.Label /= "Screen Editor " or 199 Green_Widget.Location /= (1024,760) or 200 Green_Widget.Size /= (100,100) then 201 Report.Failed ("Incorrect result for Green_Widget"); 202 end if; 203 204 end Application_Three_Subtest; 205 206 Report.Result; 207 208end CA11B01; 209