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