-- CA11018.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that body of the parent package may depend on one of its own -- public generic children. -- -- TEST DESCRIPTION: -- A scenario is created that demonstrates the potential of adding a -- public generic child during code maintenance without distubing a large -- subsystem. After child is added to the subsystem, a maintainer -- decides to take advantage of the new functionality and rewrites -- the parent's body. -- -- Declare a message application in a package which highlights some -- key words. Declare a public generic child of this package which adds -- functionality to the original subsystem. In the parent body, -- instantiate the child. -- -- In the main program, check that the operations in the parent, -- and instances of the public child package perform as expected. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 14 Dec 94 SAIC Modified Copy_Particularly_Designated_Pkg inst. -- 17 Nov 95 SAIC Update and repair for ACVC 2.0.1 -- --! -- Simulates application which displays messages. package CA11018_0 is type Designated_Num is new Integer range 0 .. 100; type Particularly_Designated_Num is new Integer range 0 .. 100; type Message is new String; type Message_Rec is tagged private; type Designated_Msg is new Message_Rec with private; type Particularly_Designated_Msg is new Message_Rec with private; -- Analyzes message for presence of word in the secret message. If found, -- word is highlighted. procedure Highlight_Designated (The_Word : in Message; In_The_Message : in out Designated_Msg); -- Analyzes message for presence of word in the secret message. If found, -- word is highlighted and do other actions. procedure Highlight_Particularly_Designated (The_Word : in Message; In_The_Message : in out Particularly_Designated_Msg); -- Begin test code declarations: ----------------------- TC_Designated_Not_Zero : Boolean := false; TC_Particularly_Designated_Not_Zero : Boolean := false; -- The following two functions are used to check for function -- calls from the public generic child. function TC_Designated_Success return Boolean; function TC_Particularly_Designated_Success return Boolean; -- End test code declarations. ------------------------- private type Message_Rec is tagged record The_Length : natural := 0; The_Content : Message (1 .. 60); end record; type Designated_Msg is new Message_Rec with null record; -- ... More components in real application. type Particularly_Designated_Msg is new Message_Rec with null record; -- ... More components in real application. end CA11018_0; --=================================================================-- -- Public generic child package of message display application. Imagine that -- messages of one security level are associated with a type derived from -- integer. For overall system security, messages of a different security -- level are associated with a different type derived from integer. By -- instantiating this package for each security level, the results of Count -- applied to one kind of message cannot inadvertently be compared with the -- results applied to a different kind. generic type Msg_Type is new Message_Rec with private; -- Derived from parent's type. type Count is range <>; package CA11018_0.CA11018_1 is TC_Function_Called : Boolean := false; function Find_Word (Wrd : in Message; Msg : in Msg_Type) return Count; end CA11018_0.CA11018_1; --=================================================================-- package body CA11018_0.CA11018_1 is function Find_Word (Wrd : in Message; Msg : in Msg_Type) return Count is Num : Count := Count'first; -- Count how many time the word appears within the given message. begin -- ... Error-checking code omitted for brevity. for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop -- Parent's private type if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd -- Parent's private type then Num := Num + 1; end if; end loop; TC_Function_Called := true; return (Num); end Find_Word; end CA11018_0.CA11018_1; --=================================================================-- with CA11018_0.CA11018_1; -- Public generic child. pragma Elaborate (CA11018_0.CA11018_1); package body CA11018_0 is ---------------------------------------------------- -- Parent's body depends on public generic child. -- ---------------------------------------------------- -- Instantiate the public child for the secret message. package Designated_Pkg is new CA11018_0.CA11018_1 (Msg_Type => Designated_Msg, Count => Designated_Num); -- Instantiate the public child for the top secret message. package Particularly_Designated_Pkg is new CA11018_0.CA11018_1 (Particularly_Designated_Msg, Particularly_Designated_Num); -- End instantiations. ----------------------------- function TC_Designated_Success return Boolean is -- Check to see if the function in the public generic child is called. begin return Designated_Pkg.TC_Function_Called; end TC_Designated_Success; -------------------------------------------------------------- function TC_Particularly_Designated_Success return Boolean is -- Check to see if the function in the public generic child is called. begin return Particularly_Designated_Pkg.TC_Function_Called; end TC_Particularly_Designated_Success; -------------------------------------------------------------- -- Calls functions from public child to search for a key word. -- If the word appears more than once in each message, -- highlight all of them. procedure Highlight_Designated (The_Word : in Message; In_The_Message : in out Designated_Msg) is -- Not a real highlight procedure. Real application can use graphic -- device to highlight all occurrences of words. begin -------------------------------------------------------------- -- Parent's body uses function from instantiation of public -- -- generic child. -- -------------------------------------------------------------- if Designated_Pkg.Find_Word -- Child's operation. (The_Word, In_The_Message) > 0 then -- Highlight all occurrences in lavender. TC_Designated_Not_Zero := true; end if; end Highlight_Designated; -------------------------------------------------------------- procedure Highlight_Particularly_Designated (The_Word : in Message; In_The_Message : in out Particularly_Designated_Msg) is -- Not a real highlight procedure. Real application can use graphic -- device to highlight all occurrences of words. begin -------------------------------------------------------------- -- Parent's body uses function from instantiation of public -- -- generic child. -- -------------------------------------------------------------- if Particularly_Designated_Pkg.Find_Word -- Child's operation. (The_Word, In_The_Message) > 0 then -- Highlight all occurrences in chartreuse. -- Do other more secret stuff. TC_Particularly_Designated_Not_Zero := true; end if; end Highlight_Particularly_Designated; end CA11018_0; --=================================================================-- -- Public generic child to copy words to the messages. generic type Message_Type is new Message_Rec with private; -- Derived from parent's type. package CA11018_0.CA11018_2 is procedure Copy (From_The_Word : in Message; To_The_Message : in out Message_Type); end CA11018_0.CA11018_2; --=================================================================-- package body CA11018_0.CA11018_2 is procedure Copy (From_The_Word : in Message; To_The_Message : in out Message_Type) is -- Copy words to the appropriate messages. begin To_The_Message.The_Content -- Parent's private type. (1 .. From_The_Word'length) := From_The_Word; To_The_Message.The_Length -- Parent's private type. := From_The_Word'length; end Copy; end CA11018_0.CA11018_2; --=================================================================-- with Report; with CA11018_0.CA11018_2; -- Public generic child package, copy words -- to the message. -- Implicit with parent package (CA11018_0). procedure CA11018 is package Message_Pkg renames CA11018_0; begin Report.Test ("CA11018", "Check that body of the parent package can " & "depend on one of its own public generic children"); -- Highlight the word "Alert" from the secret message. Designated_Subtest: declare The_Message : Message_Pkg.Designated_Msg; -- Parent's private type. -- Instantiate the public child to copy words to the secret message. package Copy_Designated_Pkg is new CA11018_0.CA11018_2 (Message_Pkg.Designated_Msg); begin Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard", To_The_Message => The_Message); Message_Pkg.Highlight_Designated ("Alert", The_Message); if not Message_Pkg.TC_Designated_Not_Zero and Message_Pkg.TC_Designated_Success then Report.Failed ("Alert should have been highlighted"); end if; end Designated_Subtest; -- Highlight the word "Push The Alarm" from the top secret message. Particularly_Designated_Subtest: declare The_Message : Message_Pkg.Particularly_Designated_Msg ; -- Parent's private type. -- Instantiate the public child to copy words to the top secret -- message. package Copy_Particularly_Designated_Pkg is new CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg); begin Copy_Particularly_Designated_Pkg.Copy ("Alert Level 10 : Alert The Guard and Push The Alarm", The_Message); Message_Pkg.Highlight_Particularly_Designated ("Push The Alarm", The_Message); if not Message_Pkg.TC_Particularly_Designated_Not_Zero and Message_Pkg.TC_Particularly_Designated_Success then Report.Failed ("Key words should have been highlighted"); end if; end Particularly_Designated_Subtest; Report.Result; end CA11018;