1-- CC54002.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- 26-- OBJECTIVE: 27-- Check that a general access-to-variable type may be passed as an 28-- actual to a generic formal general access-to-variable type. Check that 29-- designated objects may be read and updated through the access value. 30-- 31-- TEST DESCRIPTION: 32-- The generic implements a List of access objects as an array, which 33-- is itself a component of a record. The designated type of the formal 34-- access type is a formal private type declared in the same generic 35-- formal part. 36-- 37-- The access objects to be placed in the List are created both 38-- statically and dynamically, utilizing allocators and the 'Access 39-- attribute. 40-- 41-- 42-- CHANGE HISTORY: 43-- 06 Dec 94 SAIC ACVC 2.0 44-- 10 Apr 96 SAIC ACVC 2.1: Added pragma Elaborate to context clause 45-- preceding CC54002_1. 46-- 47--! 48 49generic 50 Size : in Positive; 51 type Element_Type (<>) is private; 52 type Element_Ptr is access all Element_Type; 53package CC54002_0 is -- Generic list of pointers. 54 55 subtype Index is Positive range 1 .. (Size + 1); 56 57 type List_Array is array (Index) of Element_Ptr; 58 59 type List_Type is record 60 Elements : List_Array; 61 Next : Index := 1; -- Next available "slot" in list. 62 end record; 63 64 65 procedure Put (List : in out List_Type; 66 Elem_Ptr : in Element_Ptr; 67 Location : in Index); 68 69 procedure Get (List : in out List_Type; 70 Elem_Ptr : out Element_Ptr; 71 Location : in Index); 72 73 -- ... Other operations. 74 75end CC54002_0; 76 77 78 --===================================================================-- 79 80 81package body CC54002_0 is 82 83 procedure Put (List : in out List_Type; 84 Elem_Ptr : in Element_Ptr; 85 Location : in Index) is 86 begin 87 List.Elements(Location) := Elem_Ptr; 88 end Put; 89 90 91 procedure Get (List : in out List_Type; 92 Elem_Ptr : out Element_Ptr; 93 Location : in Index) is 94 begin -- Artificial: no provision for getting "empty" element. 95 Elem_Ptr := List.Elements(Location); 96 end Get; 97 98end CC54002_0; 99 100 101 --===================================================================-- 102 103 104with CC54002_0; -- Generic List of pointers. 105pragma Elaborate (CC54002_0); 106 107package CC54002_1 is 108 109 subtype Lengths is Natural range 0 .. 50; 110 111 type Subscriber (NLen, ALen: Lengths := 50) is record 112 Name : String(1 .. NLen); 113 Address : String(1 .. ALen); 114 -- ... Other components. 115 end record; 116 117 type Subscriber_Ptr is access all Subscriber; -- General access-to- 118 -- variable type. 119 120 package District_Subscription_Lists is new CC54002_0 121 (Element_Type => Subscriber, 122 Element_Ptr => Subscriber_Ptr, 123 Size => 100); 124 125 District_01_Subscribers : District_Subscription_Lists.List_Type; 126 127 128 New_Subscriber_01 : aliased CC54002_1.Subscriber := 129 (12, 23, "Brown, Silas", "King's Pyland, Dartmoor"); 130 131 New_Subscriber_02 : aliased CC54002_1.Subscriber := 132 (16, 23, "Hatherly, Victor", "16A Victoria St. London"); 133 134end CC54002_1; 135 136-- No body for CC54002_1. 137 138 139 --===================================================================-- 140 141 142with CC54002_1; 143 144with Report; 145procedure CC54002 is 146 147 Mod_Subscriber_01 : constant CC54002_1.Subscriber := 148 (12, 23, "Brown, Silas", "Mapleton, Dartmoor "); 149 150 TC_Actual_01, TC_Actual_02 : CC54002_1.Subscriber_Ptr; 151 152 153 use type CC54002_1.Subscriber; -- "/=" directly visible. 154 155begin 156 Report.Test ("CC54002", "Check that a general access-to-variable type " & 157 "may be passed as an actual to a generic formal " & 158 "access-to-variable type"); 159 160 161 -- Add elements to the list: 162 163 CC54002_1.District_Subscription_Lists.Put -- Element created statically. 164 (List => CC54002_1.District_01_Subscribers, 165 Elem_Ptr => CC54002_1.New_Subscriber_01'Access, 166 Location => 1); 167 168 CC54002_1.District_Subscription_Lists.Put -- Element created dynamically. 169 (List => CC54002_1.District_01_Subscribers, 170 Elem_Ptr => new CC54002_1.Subscriber'(CC54002_1.New_Subscriber_02), 171 Location => 2); 172 173 174 -- Manipulation of the objects on the list is performed below directly 175 -- through the access objects. Although such manipulation is artificial 176 -- from the perspective of this usage model, it is not artificial in 177 -- general and is necessary in order to test the objective. 178 179 180 -- Modify the first list element through the access object: 181 182 CC54002_1.District_01_Subscribers.Elements(1).Address := -- Update 183 "Mapleton, Dartmoor "; -- Implicit dereference. -- through the 184 -- access 185 -- object. 186 -- Retrieve elements of the list: 187 188 CC54002_1.District_Subscription_Lists.Get 189 (CC54002_1.District_01_Subscribers, 190 TC_Actual_01, 191 1); 192 193 CC54002_1.District_Subscription_Lists.Get 194 (CC54002_1.District_01_Subscribers, 195 TC_Actual_02, 196 2); 197 198 -- Verify list contents in two ways: 1st verify the directly-dereferenced 199 -- access objects against the dereferenced access objects returned by Get; 200 -- 2nd verify them against objects the expected values: 201 202 -- Read 203 -- through the 204 -- access 205 -- objects. 206 207 if CC54002_1.District_01_Subscribers.Elements(1).all /= TC_Actual_01.all 208 or else 209 CC54002_1.District_01_Subscribers.Elements(2).all /= TC_Actual_02.all 210 then 211 Report.Failed ("Wrong results returned by Get"); 212 213 elsif CC54002_1.District_01_Subscribers.Elements(1).all /= 214 Mod_Subscriber_01 215 or 216 CC54002_1.District_01_Subscribers.Elements(2).all /= 217 CC54002_1.New_Subscriber_02 218 then 219 Report.Failed ("List elements do not have expected values"); 220 end if; 221 222 Report.Result; 223end CC54002; 224