URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11018.a] - Rev 294
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log