1-- CA13A02.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 subunits declared in generic child units of a public 28-- parent have the same visibility into its parent, its siblings 29-- (public and private), and packages on which its parent depends 30-- as is available at the point of their declaration. 31-- 32-- TEST DESCRIPTION: 33-- Declare an outside elevator button operation as a subunit in a 34-- generic child package of the basic operation package (FA13A00.A). 35-- This procedure has visibility into its parent ancestor and its 36-- private sibling. 37-- 38-- In the main program, instantiate the child package. Check that 39-- subunits perform as expected. 40-- 41-- TEST FILES: 42-- The following files comprise this test: 43-- 44-- FA13A00.A 45-- CA13A02.A 46-- 47-- 48-- CHANGE HISTORY: 49-- 06 Dec 94 SAIC ACVC 2.0 50-- 51--! 52 53-- Public generic child package of an elevator application. This package 54-- provides outside elevator button operations. 55 56generic -- Instantiate once for each floor. 57 Our_Floor : in Floor; -- Reference type declared in parent. 58 59package FA13A00_1.CA13A02_4 is -- Outside Elevator Button Operations 60 61 type Light is (Up, Down, Express, Off); 62 63 type Direction is (Up, Down, Express); 64 65 function Call_Elevator (D : Direction) return Light; 66 67 -- other type definitions and procedure declarations in real application. 68 69end FA13A00_1.CA13A02_4; 70 71 --==================================================================-- 72 73-- Context clauses required for visibility needed by separate subunit. 74 75with FA13A00_0; -- Building Manager 76 77with FA13A00_1.FA13A00_2; -- Floor Calculation (private) 78 79with FA13A00_1.FA13A00_3; -- Move Elevator 80 81use FA13A00_0; 82 83package body FA13A00_1.CA13A02_4 is 84 85 function Call_Elevator (D : Direction) return Light is separate; 86 87end FA13A00_1.CA13A02_4; 88 89 --==================================================================-- 90 91separate (FA13A00_1.CA13A02_4) 92 93-- Subunit Call_Elevator declared in Outside Elevator Button Operations. 94 95function Call_Elevator (D : Direction) return Light is 96 Elevator_Button : Light; 97 98begin 99 -- See if power is on. 100 101 if Power = Off then -- Reference package with'ed by 102 Elevator_Button := Off; -- the subunit parent's body. 103 104 else 105 case D is 106 when Express => 107 FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of 108 (Penthouse, Call_Waiting); -- the subunit parent's body. 109 110 Elevator_Button := Express; 111 112 when Up => 113 if Current_Floor < Our_Floor then 114 FA13A00_1.FA13A00_2.Up -- Reference private sibling of 115 (Floor'pos (Our_Floor) -- the subunit parent's body. 116 - Floor'pos (Current_Floor)); 117 else 118 FA13A00_1.FA13A00_2.Down -- Reference private sibling of 119 (Floor'pos (Current_Floor) -- the subunit parent's body. 120 - Floor'pos (Our_Floor)); 121 end if; 122 123 -- Call elevator. 124 125 Call 126 (Current_Floor, Call_Waiting); -- Reference subprogram declared 127 -- in the parent of the subunit 128 -- parent's body. 129 Elevator_Button := Up; 130 131 when Down => 132 if Current_Floor > Our_Floor then 133 FA13A00_1.FA13A00_2.Down -- Reference private sibling of 134 (Floor'pos (Current_Floor) -- the subunit parent's body. 135 - Floor'pos (Our_Floor)); 136 else 137 FA13A00_1.FA13A00_2.Up -- Reference private sibling of 138 (Floor'pos (Our_Floor) -- the subunit parent's body. 139 - Floor'pos (Current_Floor)); 140 end if; 141 142 Elevator_Button := Down; 143 144 -- Call elevator. 145 146 Call 147 (Current_Floor, Call_Waiting); -- Reference subprogram declared 148 -- in the parent of the subunit 149 -- parent's body. 150 end case; 151 152 if not Call_Waiting (Current_Floor) -- Reference private part of the 153 then -- parent of the subunit parent's 154 -- body. 155 TC_Operation := false; 156 end if; 157 158 end if; 159 160 return Elevator_Button; 161 162end Call_Elevator; 163 164 --==================================================================-- 165 166with FA13A00_1.CA13A02_4; -- Outside Elevator Button Operations 167 -- implicitly with Basic Elevator 168 -- Operations 169with Report; 170 171procedure CA13A02 is 172 173begin 174 175 Report.Test ("CA13A02", "Check that subunits declared in generic child " & 176 "units of a public parent have the same visibility into " & 177 "its parent, its parent's siblings, and packages on " & 178 "which its parent depends"); 179 180-- Going from floor one to penthouse. 181 182 Going_To_Penthouse: 183 declare 184 -- Declare instance of the child generic elevator package for penthouse. 185 186 package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 187 (FA13A00_1.Penthouse); 188 189 use Call_Elevator_Pkg; 190 191 Call_Button_Light : Light; 192 193 begin 194 195 Call_Button_Light := Call_Elevator (Express); 196 197 if not FA13A00_1.TC_Operation or Call_Button_Light /= Express then 198 Report.Failed ("Incorrect elevator operation going to penthouse"); 199 end if; 200 201 end Going_To_Penthouse; 202 203-- Going from penthouse to basement. 204 205 Going_To_Basement: 206 declare 207 -- Declare instance of the child generic elevator package for basement. 208 209 package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 210 (FA13A00_1.Basement); 211 212 use Call_Elevator_Pkg; 213 214 Call_Button_Light : Light; 215 216 begin 217 218 Call_Button_Light := Call_Elevator (Down); 219 220 if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then 221 Report.Failed ("Incorrect elevator operation going to basement"); 222 end if; 223 224 end Going_To_Basement; 225 226-- Going from basement to floor three. 227 228 Going_To_Floor3: 229 declare 230 -- Declare instance of the child generic elevator package for floor 231 -- three. 232 233 package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 234 (FA13A00_1.Floor3); 235 236 use Call_Elevator_Pkg; 237 238 Call_Button_Light : Light; 239 240 begin 241 242 Call_Button_Light := Call_Elevator (Up); 243 244 if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then 245 Report.Failed ("Incorrect elevator operation going to floor 3"); 246 end if; 247 248 end Going_To_Floor3; 249 250-- Going from floor three to floor two. 251 252 Going_To_Floor2: 253 declare 254 -- Declare instance of the child generic elevator package for floor two. 255 256 package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 257 (FA13A00_1.Floor2); 258 259 use Call_Elevator_Pkg; 260 261 Call_Button_Light : Light; 262 263 begin 264 265 Call_Button_Light := Call_Elevator (Up); 266 267 if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then 268 Report.Failed ("Incorrect elevator operation going to floor 2"); 269 end if; 270 271 end Going_To_Floor2; 272 273-- Going to floor one. 274 275 Going_To_Floor1: 276 declare 277 -- Declare instance of the child generic elevator package for floor one. 278 279 package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 280 (FA13A00_1.Floor1); 281 282 use Call_Elevator_Pkg; 283 284 Call_Button_Light : Light; 285 286 begin 287 -- Calling elevator from floor one. 288 289 FA13A00_1.Current_Floor := FA13A00_1.Floor1; 290 291 Call_Button_Light := Call_Elevator (Down); 292 293 if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then 294 Report.Failed ("Incorrect elevator operation going to floor 1"); 295 end if; 296 297 end Going_To_Floor1; 298 299 Report.Result; 300 301end CA13A02; 302