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