1-- CA11018.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 body of the parent package may depend on one of its own 28-- public generic children. 29-- 30-- TEST DESCRIPTION: 31-- A scenario is created that demonstrates the potential of adding a 32-- public generic child during code maintenance without distubing a large 33-- subsystem. After child is added to the subsystem, a maintainer 34-- decides to take advantage of the new functionality and rewrites 35-- the parent's body. 36-- 37-- Declare a message application in a package which highlights some 38-- key words. Declare a public generic child of this package which adds 39-- functionality to the original subsystem. In the parent body, 40-- instantiate the child. 41-- 42-- In the main program, check that the operations in the parent, 43-- and instances of the public child package perform as expected. 44-- 45-- 46-- CHANGE HISTORY: 47-- 06 Dec 94 SAIC ACVC 2.0 48-- 14 Dec 94 SAIC Modified Copy_Particularly_Designated_Pkg inst. 49-- 17 Nov 95 SAIC Update and repair for ACVC 2.0.1 50-- 51--! 52 53-- Simulates application which displays messages. 54 55package CA11018_0 is 56 57 type Designated_Num is new Integer range 0 .. 100; 58 59 type Particularly_Designated_Num is new Integer range 0 .. 100; 60 61 type Message is new String; 62 63 type Message_Rec is tagged private; 64 65 type Designated_Msg is new Message_Rec with private; 66 67 type Particularly_Designated_Msg is new Message_Rec with private; 68 69 -- Analyzes message for presence of word in the secret message. If found, 70 -- word is highlighted. 71 72 procedure Highlight_Designated (The_Word : in Message; 73 In_The_Message : in out Designated_Msg); 74 75 76 -- Analyzes message for presence of word in the secret message. If found, 77 -- word is highlighted and do other actions. 78 79 procedure Highlight_Particularly_Designated 80 (The_Word : in Message; 81 In_The_Message : in out Particularly_Designated_Msg); 82 83 84 -- Begin test code declarations: ----------------------- 85 86 TC_Designated_Not_Zero : Boolean := false; 87 88 TC_Particularly_Designated_Not_Zero : Boolean := false; 89 90 -- The following two functions are used to check for function 91 -- calls from the public generic child. 92 93 function TC_Designated_Success return Boolean; 94 95 function TC_Particularly_Designated_Success return Boolean; 96 97 -- End test code declarations. ------------------------- 98 99private 100 type Message_Rec is tagged 101 record 102 The_Length : natural := 0; 103 The_Content : Message (1 .. 60); 104 end record; 105 106 type Designated_Msg is new Message_Rec with null record; 107 -- ... More components in real application. 108 109 type Particularly_Designated_Msg is new Message_Rec with null record; 110 -- ... More components in real application. 111 112end CA11018_0; 113 114 --=================================================================-- 115 116 117-- Public generic child package of message display application. Imagine that 118-- messages of one security level are associated with a type derived from 119-- integer. For overall system security, messages of a different security 120-- level are associated with a different type derived from integer. By 121-- instantiating this package for each security level, the results of Count 122-- applied to one kind of message cannot inadvertently be compared with the 123-- results applied to a different kind. 124 125generic 126 type Msg_Type is new Message_Rec with private; 127 -- Derived from parent's type. 128 type Count is range <>; 129 130package CA11018_0.CA11018_1 is 131 132 TC_Function_Called : Boolean := false; 133 134 function Find_Word (Wrd : in Message; 135 Msg : in Msg_Type) return Count; 136 137end CA11018_0.CA11018_1; 138 139 --=================================================================-- 140 141package body CA11018_0.CA11018_1 is 142 143 function Find_Word (Wrd : in Message; 144 Msg : in Msg_Type) return Count is 145 146 Num : Count := Count'first; 147 148 -- Count how many time the word appears within the given message. 149 150 begin 151 -- ... Error-checking code omitted for brevity. 152 153 for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop 154 -- Parent's private type 155 if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd 156 -- Parent's private type 157 then 158 Num := Num + 1; 159 end if; 160 161 end loop; 162 163 TC_Function_Called := true; 164 165 return (Num); 166 167 end Find_Word; 168 169end CA11018_0.CA11018_1; 170 171 --=================================================================-- 172 173with CA11018_0.CA11018_1; -- Public generic child. 174 175pragma Elaborate (CA11018_0.CA11018_1); 176package body CA11018_0 is 177 178 ---------------------------------------------------- 179 -- Parent's body depends on public generic child. -- 180 ---------------------------------------------------- 181 182 -- Instantiate the public child for the secret message. 183 184 package Designated_Pkg is new CA11018_0.CA11018_1 185 (Msg_Type => Designated_Msg, Count => Designated_Num); 186 187 -- Instantiate the public child for the top secret message. 188 189 package Particularly_Designated_Pkg is new CA11018_0.CA11018_1 190 (Particularly_Designated_Msg, Particularly_Designated_Num); 191 192 -- End instantiations. ----------------------------- 193 194 195 function TC_Designated_Success return Boolean is 196 -- Check to see if the function in the public generic child is called. 197 198 begin 199 return Designated_Pkg.TC_Function_Called; 200 end TC_Designated_Success; 201 -------------------------------------------------------------- 202 function TC_Particularly_Designated_Success return Boolean is 203 -- Check to see if the function in the public generic child is called. 204 205 begin 206 return Particularly_Designated_Pkg.TC_Function_Called; 207 end TC_Particularly_Designated_Success; 208 -------------------------------------------------------------- 209 -- Calls functions from public child to search for a key word. 210 -- If the word appears more than once in each message, 211 -- highlight all of them. 212 213 procedure Highlight_Designated (The_Word : in Message; 214 In_The_Message : in out Designated_Msg) is 215 216 -- Not a real highlight procedure. Real application can use graphic 217 -- device to highlight all occurrences of words. 218 219 begin 220 -------------------------------------------------------------- 221 -- Parent's body uses function from instantiation of public -- 222 -- generic child. -- 223 -------------------------------------------------------------- 224 225 if Designated_Pkg.Find_Word -- Child's operation. 226 (The_Word, In_The_Message) > 0 then 227 228 -- Highlight all occurrences in lavender. 229 230 TC_Designated_Not_Zero := true; 231 end if; 232 233 end Highlight_Designated; 234 -------------------------------------------------------------- 235 procedure Highlight_Particularly_Designated 236 (The_Word : in Message; 237 In_The_Message : in out Particularly_Designated_Msg) is 238 239 -- Not a real highlight procedure. Real application can use graphic 240 -- device to highlight all occurrences of words. 241 242 begin 243 -------------------------------------------------------------- 244 -- Parent's body uses function from instantiation of public -- 245 -- generic child. -- 246 -------------------------------------------------------------- 247 248 if Particularly_Designated_Pkg.Find_Word -- Child's operation. 249 (The_Word, In_The_Message) > 0 then 250 251 -- Highlight all occurrences in chartreuse. 252 -- Do other more secret stuff. 253 254 TC_Particularly_Designated_Not_Zero := true; 255 end if; 256 257 end Highlight_Particularly_Designated; 258 259end CA11018_0; 260 261 --=================================================================-- 262 263-- Public generic child to copy words to the messages. 264 265generic 266 type Message_Type is new Message_Rec with private; 267 -- Derived from parent's type. 268 269package CA11018_0.CA11018_2 is 270 271 procedure Copy (From_The_Word : in Message; 272 To_The_Message : in out Message_Type); 273 274end CA11018_0.CA11018_2; 275 276 --=================================================================-- 277 278package body CA11018_0.CA11018_2 is 279 280 procedure Copy (From_The_Word : in Message; 281 To_The_Message : in out Message_Type) is 282 283 -- Copy words to the appropriate messages. 284 285 begin 286 To_The_Message.The_Content -- Parent's private type. 287 (1 .. From_The_Word'length) := From_The_Word; 288 289 To_The_Message.The_Length -- Parent's private type. 290 := From_The_Word'length; 291 end Copy; 292 293end CA11018_0.CA11018_2; 294 295 --=================================================================-- 296 297with Report; 298 299with CA11018_0.CA11018_2; -- Public generic child package, copy words 300 -- to the message. 301 -- Implicit with parent package (CA11018_0). 302 303procedure CA11018 is 304 305 package Message_Pkg renames CA11018_0; 306 307begin 308 309 Report.Test ("CA11018", "Check that body of the parent package can " & 310 "depend on one of its own public generic children"); 311 312-- Highlight the word "Alert" from the secret message. 313 314 Designated_Subtest: 315 declare 316 The_Message : Message_Pkg.Designated_Msg; -- Parent's private type. 317 318 -- Instantiate the public child to copy words to the secret message. 319 320 package Copy_Designated_Pkg is new CA11018_0.CA11018_2 321 (Message_Pkg.Designated_Msg); 322 323 begin 324 Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard", 325 To_The_Message => The_Message); 326 327 Message_Pkg.Highlight_Designated ("Alert", The_Message); 328 329 if not Message_Pkg.TC_Designated_Not_Zero and 330 Message_Pkg.TC_Designated_Success then 331 Report.Failed ("Alert should have been highlighted"); 332 end if; 333 334 end Designated_Subtest; 335 336-- Highlight the word "Push The Alarm" from the top secret message. 337 338 Particularly_Designated_Subtest: 339 declare 340 The_Message : Message_Pkg.Particularly_Designated_Msg ; 341 -- Parent's private type. 342 343 -- Instantiate the public child to copy words to the top secret 344 -- message. 345 346 package Copy_Particularly_Designated_Pkg is new 347 CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg); 348 349 begin 350 Copy_Particularly_Designated_Pkg.Copy 351 ("Alert Level 10 : Alert The Guard and Push The Alarm", 352 The_Message); 353 354 Message_Pkg.Highlight_Particularly_Designated 355 ("Push The Alarm", The_Message); 356 357 if not Message_Pkg.TC_Particularly_Designated_Not_Zero and 358 Message_Pkg.TC_Particularly_Designated_Success then 359 Report.Failed ("Key words should have been highlighted"); 360 end if; 361 362 end Particularly_Designated_Subtest; 363 364 Report.Result; 365 366end CA11018; 367