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