1-- CA13A01.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 non-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 check system procedure as a subunit in a private child 34-- package of the basic operation package (FA13A00.A). This procedure 35-- has visibility into its parent ancestor and its private sibling. 36-- 37-- Declare an emergency procedure as a subunit in a public child package 38-- of the basic operation package (FA13A00.A). This procedure has 39-- visibility into its parent ancestor and its private sibling. 40-- 41-- Declare an express procedure as a subunit in a public child subprogram 42-- of the basic operation package (FA13A00.A). This procedure has 43-- visibility into its parent ancestor and its public sibling. 44-- 45-- In the main program, "with"s the child package and subprogram. Check 46-- that subunits perform as expected. 47-- 48-- TEST FILES: 49-- The following files comprise this test: 50-- 51-- FA13A00.A 52-- CA13A01.A 53-- 54-- 55-- CHANGE HISTORY: 56-- 06 Dec 94 SAIC ACVC 2.0 57-- 58--! 59 60-- Private child package of an elevator application. This package 61-- provides maintenance operations. 62 63private package FA13A00_1.CA13A01_4 is -- Maintenance operation 64 65 One_Floor : Floor_No := 1; -- Type declared in parent. 66 67 procedure Check_System; 68 69 -- other type definitions and procedure declarations in real application. 70 71end FA13A00_1.CA13A01_4; 72 73 --==================================================================-- 74 75-- Context clauses required for visibility needed by separate subunit. 76 77with FA13A00_0; -- Building Manager 78 79with FA13A00_1.FA13A00_2; -- Floor Calculation (private) 80 81with FA13A00_1.FA13A00_3; -- Move Elevator 82 83use FA13A00_0; 84 85package body FA13A00_1.CA13A01_4 is 86 87 procedure Check_System is separate; 88 89end FA13A00_1.CA13A01_4; 90 91 --==================================================================-- 92 93separate (FA13A00_1.CA13A01_4) 94 95-- Subunit Check_System declared in Maintenance Operation. 96 97procedure Check_System is 98begin 99 -- See if regular power is on. 100 101 if Power /= V120 then -- Reference package with'ed by 102 TC_Operation := false; -- the subunit parent's body. 103 end if; 104 105 -- Test elevator function. 106 107 FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of 108 (Penthouse, Call_Waiting); -- the subunit parent's body. 109 110 if not Call_Waiting (Penthouse) then -- Reference private part of the 111 TC_Operation := false; -- parent of the subunit package's 112 -- body. 113 end if; 114 115 FA13A00_1.FA13A00_2.Down (One_Floor); -- Reference private sibling of 116 -- the subunit parent's body. 117 118 if Current_Floor /= Floor'pred (Penthouse) then 119 TC_Operation := false; -- Reference type declared in the 120 end if; -- parent of the subunit parent's 121 -- body. 122 123end Check_System; 124 125 --==================================================================-- 126 127-- Public child package of an elevator application. This package provides 128-- an emergency operation. 129 130package FA13A00_1.CA13A01_5 is -- Emergency Operation 131 132 -- Other type definitions in real application. 133 134 procedure Emergency; 135 136private 137 type Bell_Type is (Inactive, Active); 138 139end FA13A00_1.CA13A01_5; 140 141 --==================================================================-- 142 143-- Context clauses required for visibility needed by separate subunit. 144 145with FA13A00_0; -- Building Manager 146 147with FA13A00_1.FA13A00_3; -- Move Elevator 148 149with FA13A00_1.CA13A01_4; -- Maintenance Operation (private) 150 151use FA13A00_0; 152 153package body FA13A00_1.CA13A01_5 is 154 155 procedure Emergency is separate; 156 157end FA13A00_1.CA13A01_5; 158 159 --==================================================================-- 160 161separate (FA13A00_1.CA13A01_5) 162 163-- Subunit Emergency declared in Maintenance Operation. 164 165procedure Emergency is 166 Bell : Bell_Type; -- Reference type declared in the 167 -- subunit parent's body. 168 169begin 170 -- Calls maintenance operation. 171 172 FA13A00_1.CA13A01_4.Check_System; -- Reference private sibling of the 173 -- subunit parent 's body. 174 175 -- Clear all calls to the elevator. 176 177 Clear_Calls (Call_Waiting); -- Reference subprogram declared 178 -- in the parent of the subunit 179 -- parent's body. 180 for I in Floor loop 181 if Call_Waiting (I) then -- Reference private part of the 182 TC_Operation := false; -- parent of the subunit parent's 183 end if; -- body. 184 end loop; 185 186 -- Move elevator to the basement. 187 188 FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the 189 (Basement, Call_Waiting); -- subunit parent's body. 190 191 if Current_Floor /= Basement then -- Reference type declared in the 192 TC_Operation := false; -- parent of the subunit parent's 193 end if; -- body. 194 195 -- Shut off power. 196 197 Power := Off; -- Reference package with'ed by 198 -- the subunit parent's body. 199 200 -- Activate bell. 201 202 Bell := Active; -- Reference type declared in the 203 -- subunit parent's body. 204 205end Emergency; 206 207 --==================================================================-- 208 209-- Public child subprogram of an elevator application. This subprogram 210-- provides an express operation. 211 212procedure FA13A00_1.CA13A01_6; 213 214 --==================================================================-- 215 216-- Context clauses required for visibility needed by separate subunit. 217 218with FA13A00_0; -- Building Manager 219 220with FA13A00_1.FA13A00_2; -- Floor Calculation (private) 221 222with FA13A00_1.FA13A00_3; -- Move Elevator 223 224use FA13A00_0; 225 226procedure FA13A00_1.CA13A01_6 is -- Express Operation 227 228 -- Other type definitions in real application. 229 230 procedure GoTo_Penthouse is separate; 231 232begin 233 GoTo_Penthouse; 234 235end FA13A00_1.CA13A01_6; 236 237 --==================================================================-- 238 239separate (FA13A00_1.CA13A01_6) 240 241-- Subunit GoTo_Penthouse declared in Express Operation. 242 243procedure GoTo_Penthouse is 244begin 245 -- Go faster. 246 247 Power := V240; -- Reference package with'ed by 248 -- the subunit parent's body. 249 250 -- Call elevator. 251 252 Call (Penthouse, Call_Waiting); -- Reference subprogram declared in 253 -- the parent of the subunit 254 -- parent's body. 255 256 if not Call_Waiting (Penthouse) then -- Reference private part of the 257 TC_Operation := false; -- parent of the subunit parent's 258 end if; -- body. 259 260 -- Move elevator to Penthouse. 261 262 FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of the 263 (Penthouse, Call_Waiting); -- subunit parent's body. 264 265 if Current_Floor /= Penthouse then -- Reference type declared in the 266 TC_Operation := false; -- parent of the subunit parent's 267 end if; -- body. 268 269 -- Return slowly 270 271 while Current_Floor /= Floor1 loop -- Reference type, subprogram 272 FA13A00_1.FA13A00_2.Down (1); -- declared in the parent of the 273 -- subunit parent's body. 274 end loop; 275 276 if Current_Floor /= Floor1 then -- Reference type declared in 277 TC_Operation := false; -- the parent of the subunit 278 end if; -- parent's body. 279 280 -- Back to normal. 281 282 Power := V120; -- Reference package with'ed by 283 -- the subunit parent's body. 284 285end GoTo_Penthouse; 286 287 --==================================================================-- 288 289with FA13A00_1.CA13A01_5; -- Emergency Operation 290 -- implicitly with Basic Elevator 291 -- Operations 292 293with FA13A00_1.CA13A01_6; -- Express Operation 294 295with Report; 296 297procedure CA13A01 is 298 299begin 300 301 Report.Test ("CA13A01", "Check that subunits declared in non-generic " & 302 "child units of a public parent have the same visibility " & 303 "into its parent, its parent's siblings, and packages on " & 304 "which its parent depends"); 305 306 -- Go to Penthouse. 307 308 FA13A00_1.CA13A01_6; 309 310 -- Call emergency operation. 311 312 FA13A00_1.CA13A01_5.Emergency; 313 314 if not FA13A00_1.TC_Operation then 315 Report.Failed ("Incorrect elevator operation"); 316 end if; 317 318 Report.Result; 319 320end CA13A01; 321