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