diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a new file mode 100644 index 000000000..623f25d6c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a @@ -0,0 +1,223 @@ +-- 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; |