1-- CC54001.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-constant type may be passed as an
28--      actual to a generic formal access-to-constant type.
29--
30-- TEST DESCRIPTION:
31--      The generic implements a stack of access objects as an array. The
32--      designated type of the formal access type is itself a formal private
33--      type declared in the same generic formal part.
34--
35--      The generic is instantiated with an unconstrained subtype of String,
36--      which results in a stack which can accommodate strings of varying
37--      lengths (ragged array). Furthermore, the access objects to be pushed
38--      onto the stack are created both statically and dynamically, utilizing
39--      allocators and the 'Access 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 CC54001_1.
46--
47--!
48
49generic
50   Size : in Positive;
51   type Element_Type (<>) is private;
52   type Element_Ptr       is access constant Element_Type;
53package CC54001_0 is -- Generic stack of pointers.
54
55   type Stack_Type is private;
56
57   procedure Push (Stack    : in out Stack_Type;
58                   Elem_Ptr : in     Element_Ptr);
59
60   procedure Pop  (Stack    : in out Stack_Type;
61                   Elem_Ptr :    out Element_Ptr);
62
63   -- ... Other operations.
64
65private
66
67   subtype Index is Positive range 1 .. (Size + 1);
68   type Stack_Type is array (Index) of Element_Ptr;  -- Last element unused.
69
70   Top : Index := 1;
71
72end CC54001_0;
73
74
75     --===================================================================--
76
77
78package body CC54001_0 is
79
80   procedure Push (Stack    : in out Stack_Type;
81                   Elem_Ptr : in     Element_Ptr) is
82   begin
83      Stack(Top) := Elem_Ptr;
84      Top := Top + 1;  -- Artificial: no Constraint_Error protection.
85   end Push;
86
87
88   procedure Pop (Stack    : in out Stack_Type;
89                  Elem_Ptr :    out Element_Ptr) is
90   begin
91      Top := Top - 1;  -- Artificial: no Constraint_Error protection.
92      Elem_Ptr := Stack(Top);
93   end Pop;
94
95end CC54001_0;
96
97
98     --===================================================================--
99
100
101with CC54001_0;      -- Generic stack of pointers.
102pragma Elaborate (CC54001_0);
103
104package CC54001_1 is
105
106   subtype Message     is String;
107   type    Message_Ptr is access constant Message;
108
109   Message_Count : constant := 4;
110
111   Message_0 : aliased constant Message := "Hello";
112   Message_1 : aliased constant Message := "Doctor";
113   Message_2 : aliased constant Message := "Name";
114   Message_3 : aliased constant Message := "Continue";
115
116
117   package Stack_of_Messages is new CC54001_0
118     (Element_Type => Message,
119      Element_Ptr  => Message_Ptr,
120      Size         => Message_Count);
121
122   Message_Stack : Stack_Of_Messages.Stack_Type;
123
124
125   procedure Create_Message_Stack;
126
127end CC54001_1;
128
129
130     --===================================================================--
131
132
133package body CC54001_1 is
134
135   procedure Create_Message_Stack is
136      -- Push access objects onto stack. Note that some are statically
137      -- allocated, and some are dynamically allocated (using an aliased
138      -- object to initialize).
139   begin
140      Stack_Of_Messages.Push (Message_Stack, Message_0'Access); -- Static.
141      Stack_Of_Messages.Push (Message_Stack,
142                              new Message'(Message_1));         -- Dynamic.
143      Stack_Of_Messages.Push (Message_Stack, Message_2'Access); -- Static.
144      Stack_Of_Messages.Push (Message_Stack,                    -- Dynamic.
145                              new Message'(Message_3));
146   end Create_Message_Stack;
147
148end CC54001_1;
149
150
151     --===================================================================--
152
153
154with CC54001_1;
155
156with Report;
157procedure CC54001 is
158
159   package Messages renames CC54001_1.Stack_Of_Messages;
160
161   Msg0, Msg1, Msg2, Msg3 : CC54001_1.Message_Ptr;
162
163begin
164   Report.Test ("CC54001", "Check that a general access-to-constant type "   &
165                           "may be passed as an actual to a generic formal " &
166                           "access-to-constant type");
167
168   CC54001_1.Create_Message_Stack;
169
170   Messages.Pop (CC54001_1.Message_Stack, Msg3);  -- Pop items off stack in the
171   Messages.Pop (CC54001_1.Message_Stack, Msg2);  -- reverse order that they
172   Messages.Pop (CC54001_1.Message_Stack, Msg1);  -- were pushed.
173   Messages.Pop (CC54001_1.Message_Stack, Msg0);
174
175   if Msg0.all /= CC54001_1.Message_0 or else
176      Msg1.all /= CC54001_1.Message_1 or else
177      Msg2.all /= CC54001_1.Message_2 or else
178      Msg3.all /= CC54001_1.Message_3
179   then
180      Report.Failed ("Items popped off of stack do not match those pushed");
181   end if;
182
183   Report.Result;
184end CC54001;
185