cc54002.a

来自「linux下编程用 编译软件」· A 代码 · 共 224 行

-- CC54002.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 a general access-to-variable type may be passed as an
--      actual to a generic formal general access-to-variable type. Check that
--      designated objects may be read and updated through the access value.
--
-- TEST DESCRIPTION:
--      The generic implements a List of access objects as an array, which
--      is itself a component of a record. The designated type of the formal
--      access type is a formal private type declared in the same generic
--      formal part.
--
--      The access objects to be placed in the List are created both
--      statically and dynamically, utilizing allocators and the 'Access
--      attribute.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
--                          preceding CC54002_1.
--
--!

generic
   Size : in Positive;
   type Element_Type (<>) is private;
   type Element_Ptr       is access all Element_Type;
package CC54002_0 is -- Generic list of pointers.

   subtype Index is Positive range 1 .. (Size + 1);

   type List_Array is array (Index) of Element_Ptr;

   type List_Type is record
      Elements : List_Array;
      Next     : Index := 1;    -- Next available "slot" in list.
   end record;


   procedure Put (List     : in out List_Type;
                  Elem_Ptr : in     Element_Ptr;
                  Location : in     Index);

   procedure Get (List     : in out List_Type;
                  Elem_Ptr :    out Element_Ptr;
                  Location : in     Index);

   -- ... Other operations.

end CC54002_0;


     --===================================================================--


package body CC54002_0 is

   procedure Put (List     : in out List_Type;
                  Elem_Ptr : in     Element_Ptr;
                  Location : in     Index) is
   begin
      List.Elements(Location) := Elem_Ptr;
   end Put;


   procedure Get (List     : in out List_Type;
                  Elem_Ptr :    out Element_Ptr;
                  Location : in     Index) is
   begin  -- Artificial: no provision for getting "empty" element.
      Elem_Ptr := List.Elements(Location);
   end Get;

end CC54002_0;


     --===================================================================--


with CC54002_0;      -- Generic List of pointers.
pragma Elaborate (CC54002_0);

package CC54002_1 is

   subtype Lengths is Natural range 0 .. 50;

   type Subscriber (NLen, ALen: Lengths := 50) is record
      Name    : String(1 .. NLen);
      Address : String(1 .. ALen);
      -- ... Other components.
   end record;

   type Subscriber_Ptr is access all Subscriber;         -- General access-to-
                                                         -- variable type.

   package District_Subscription_Lists is new CC54002_0
     (Element_Type => Subscriber,
      Element_Ptr  => Subscriber_Ptr,
      Size         => 100);

   District_01_Subscribers : District_Subscription_Lists.List_Type;


   New_Subscriber_01 : aliased CC54002_1.Subscriber :=
     (12, 23, "Brown, Silas", "King's Pyland, Dartmoor");

   New_Subscriber_02 : aliased CC54002_1.Subscriber :=
     (16, 23, "Hatherly, Victor", "16A Victoria St. London");

end CC54002_1;

-- No body for CC54002_1.


     --===================================================================--


with CC54002_1;

with Report;
procedure CC54002 is

   Mod_Subscriber_01 : constant CC54002_1.Subscriber :=
     (12, 23, "Brown, Silas", "Mapleton, Dartmoor     ");

   TC_Actual_01, TC_Actual_02 : CC54002_1.Subscriber_Ptr;


   use type CC54002_1.Subscriber;  -- "/=" directly visible.

begin
   Report.Test ("CC54002", "Check that a general access-to-variable type "   &
                           "may be passed as an actual to a generic formal " &
                           "access-to-variable type");


   -- Add elements to the list:

   CC54002_1.District_Subscription_Lists.Put    -- Element created statically.
     (List     => CC54002_1.District_01_Subscribers,
      Elem_Ptr => CC54002_1.New_Subscriber_01'Access,
      Location => 1);

   CC54002_1.District_Subscription_Lists.Put    -- Element created dynamically.
     (List     => CC54002_1.District_01_Subscribers,
      Elem_Ptr => new CC54002_1.Subscriber'(CC54002_1.New_Subscriber_02),
      Location => 2);


   -- Manipulation of the objects on the list is performed below directly
   -- through the access objects. Although such manipulation is artificial
   -- from the perspective of this usage model, it is not artificial in
   -- general and is necessary in order to test the objective.


   -- Modify the first list element through the access object:

   CC54002_1.District_01_Subscribers.Elements(1).Address :=      -- Update
      "Mapleton, Dartmoor     ";      -- Implicit dereference.   -- through the
                                                                 -- access
                                                                 -- object.
   -- Retrieve elements of the list:

   CC54002_1.District_Subscription_Lists.Get
     (CC54002_1.District_01_Subscribers,
      TC_Actual_01,
      1);

   CC54002_1.District_Subscription_Lists.Get
     (CC54002_1.District_01_Subscribers,
      TC_Actual_02,
      2);

   -- Verify list contents in two ways: 1st verify the directly-dereferenced
   -- access objects against the dereferenced access objects returned by Get;
   -- 2nd verify them against objects the expected values:

                                                                 -- Read
                                                                 -- through the
                                                                 -- access
                                                                 -- objects.

   if CC54002_1.District_01_Subscribers.Elements(1).all /= TC_Actual_01.all
      or else
      CC54002_1.District_01_Subscribers.Elements(2).all /= TC_Actual_02.all
   then
      Report.Failed ("Wrong results returned by Get");
   
   elsif CC54002_1.District_01_Subscribers.Elements(1).all /=
           Mod_Subscriber_01
         or
         CC54002_1.District_01_Subscribers.Elements(2).all /=
           CC54002_1.New_Subscriber_02
   then
      Report.Failed ("List elements do not have expected values");
   end if;

   Report.Result;
end CC54002;