Subversion Repositories openrisc

-- 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;