OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cdb0a01.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CDB0A01.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 storage pool may be user_determined, and that storage
28
--      is allocated by calling Allocate.
29
--
30
--      Check that a storage.pool may be specified using 'Storage_Pool
31
--      and that S'Storage_Pool denotes the storage pool of the type S.
32
--
33
-- TEST DESCRIPTION:
34
--      The package System.Storage_Pools is exercised by two very similar
35
--      packages which define a tree type and exercise it in a simple manner.
36
--      One package uses a user defined pool.  The other package uses a
37
--      storage pool assigned by the implementation; Storage_Size is
38
--      specified for this pool.
39
--      The dispatching procedures Allocate and Deallocate are tested as an
40
--      intentional side effect of the tree packages.
41
--
42
--      For completeness, the actions of the tree packages are checked for
43
--      correct operation.
44
--
45
-- TEST FILES:
46
--      The following files comprise this test:
47
--
48
--         FDB0A00.A   (foundation code)
49
--         CDB0A01.A
50
--
51
--
52
-- CHANGE HISTORY:
53
--      02 JUN 95   SAIC   Initial version
54
--      07 MAY 96   SAIC   Removed ambiguity with CDB0A02
55
--      13 FEB 97   PWB.CTA Corrected lexically ordered string literal
56
--!
57
 
58
---------------------------------------------------------------- CDB0A01_1
59
 
60
---------------------------------------------------------- FDB0A00.Pool1
61
 
62
package FDB0A00.Pool1 is
63
  User_Pool : Stack_Heap( 5_000 );
64
end FDB0A00.Pool1;
65
 
66
---------------------------------------------------------- FDB0A00.Comparator
67
 
68
with System.Storage_Pools;
69
package FDB0A00.Comparator is
70
 
71
  function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
72
           return Boolean;
73
 
74
end FDB0A00.Comparator;
75
 
76
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
77
 
78
with TCTouch;
79
package body FDB0A00.Comparator is
80
 
81
  function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
82
           return Boolean is
83
    use type System.Address;
84
  begin
85
    return A'Address = B'Address;
86
  end "=";
87
 
88
end FDB0A00.Comparator;
89
 
90
---------------------------------------------------------------- CDB0A01_2
91
 
92
with FDB0A00.Pool1;
93
package CDB0A01_2 is
94
 
95
  type Cell;
96
  type User_Pool_Tree is access Cell;
97
 
98
  for User_Pool_Tree'Storage_Pool use FDB0A00.Pool1.User_Pool;
99
 
100
  type Cell is record
101
    Data : Character;
102
    Left,Right : User_Pool_Tree;
103
  end record;
104
 
105
  procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree );
106
 
107
  procedure Traverse( The_Tree : User_Pool_Tree );
108
 
109
  procedure Defoliate( The_Tree : in out User_Pool_Tree );
110
 
111
end CDB0A01_2;
112
 
113
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
114
 
115
with TCTouch;
116
with Unchecked_Deallocation;
117
package body CDB0A01_2 is
118
  procedure Deallocate is new Unchecked_Deallocation(Cell,User_Pool_Tree);
119
 
120
  -- Sort: zeros on the left, ones on the right...
121
  procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree ) is
122
  begin
123
    if On_Tree = null then
124
      On_Tree := new Cell'(Item,null,null);
125
    elsif Item > On_Tree.Data then
126
      Insert(Item,On_Tree.Right);
127
    else
128
      Insert(Item,On_Tree.Left);
129
    end if;
130
  end Insert;
131
 
132
  procedure Traverse( The_Tree : User_Pool_Tree ) is
133
  begin
134
    if The_Tree = null then
135
      null;  -- how very symmetrical
136
    else
137
      Traverse(The_Tree.Left);
138
      TCTouch.Touch(The_Tree.Data);
139
      Traverse(The_Tree.Right);
140
    end if;
141
  end Traverse;
142
 
143
  procedure Defoliate( The_Tree : in out User_Pool_Tree ) is
144
  begin
145
 
146
    if The_Tree.Left /= null then
147
      Defoliate(The_Tree.Left);
148
    end if;
149
 
150
    if The_Tree.Right /= null then
151
      Defoliate(The_Tree.Right);
152
    end if;
153
 
154
    Deallocate(The_Tree);
155
 
156
  end Defoliate;
157
 
158
end CDB0A01_2;
159
 
160
---------------------------------------------------------------- CDB0A01_3
161
 
162
with FDB0A00.Pool1;
163
package CDB0A01_3 is
164
 
165
  type Cell;
166
  type System_Pool_Tree is access Cell;
167
 
168
  for System_Pool_Tree'Storage_Size use 2000;
169
 
170
  -- assumptions: Cell is <= 20 storage_units
171
  --              Tree building exercise requires O(15) cells
172
  --              2000 > 20 * 15 by a generous margin
173
 
174
  type Cell is record
175
    Data: Character;
176
    Left,Right : System_Pool_Tree;
177
  end record;
178
 
179
  procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree );
180
 
181
  procedure Traverse( The_Tree : System_Pool_Tree );
182
 
183
  procedure Defoliate( The_Tree : in out System_Pool_Tree );
184
 
185
end CDB0A01_3;
186
 
187
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
188
 
189
with TCTouch;
190
with Unchecked_Deallocation;
191
package body CDB0A01_3 is
192
  procedure Deallocate is new Unchecked_Deallocation(Cell,System_Pool_Tree);
193
 
194
  -- Sort: zeros on the left, ones on the right...
195
  procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree ) is
196
  begin
197
    if On_Tree = null then
198
      On_Tree := new Cell'(Item,null,null);
199
    elsif Item > On_Tree.Data then
200
      Insert(Item,On_Tree.Right);
201
    else
202
      Insert(Item,On_Tree.Left);
203
    end if;
204
  end Insert;
205
 
206
  procedure Traverse( The_Tree : System_Pool_Tree ) is
207
  begin
208
    if The_Tree = null then
209
      null;  -- how very symmetrical
210
    else
211
      Traverse(The_Tree.Left);
212
      TCTouch.Touch(The_Tree.Data);
213
      Traverse(The_Tree.Right);
214
    end if;
215
  end Traverse;
216
 
217
  procedure Defoliate( The_Tree : in out System_Pool_Tree ) is
218
  begin
219
 
220
    if The_Tree.Left /= null then
221
      Defoliate(The_Tree.Left);
222
    end if;
223
 
224
    if The_Tree.Right /= null then
225
      Defoliate(The_Tree.Right);
226
    end if;
227
 
228
    Deallocate(The_Tree);
229
 
230
  end Defoliate;
231
 
232
end CDB0A01_3;
233
 
234
------------------------------------------------------------------ CDB0A01
235
 
236
with Report;
237
with TCTouch;
238
with FDB0A00.Comparator;
239
with FDB0A00.Pool1;
240
with CDB0A01_2;
241
with CDB0A01_3;
242
 
243
procedure CDB0A01 is
244
 
245
  Banyan : CDB0A01_2.User_Pool_Tree;
246
  Torrey : CDB0A01_3.System_Pool_Tree;
247
 
248
  use type CDB0A01_2.User_Pool_Tree;
249
  use type CDB0A01_3.System_Pool_Tree;
250
 
251
  Countess     : constant String := "Ada Augusta Lovelace";
252
  Cenosstu     : constant String := "  AALaaacdeeglostuuv";
253
  Insertion    : constant String := "AAAAAAAAAAAAAAAAAAAA";
254
  Deallocation : constant String := "DDDDDDDDDDDDDDDDDDDD";
255
 
256
begin  -- Main test procedure.
257
 
258
   Report.Test ("CDB0A01", "Check that a storage pool may be " &
259
                           "user_determined, and that storage is " &
260
                           "allocated by calling Allocate.  Check that " &
261
                           "a storage.pool may be specified using " &
262
                           "'Storage_Pool and that S'Storage_Pool denotes " &
263
                           "the storage pool of the type S" );
264
 
265
--      Check that S'Storage_Pool denotes the storage pool for the type S.
266
 
267
  TCTouch.Assert(
268
     FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
269
                            CDB0A01_2.User_Pool_Tree'Storage_Pool ),
270
     "'Storage_Pool not correct for CDB0A01_2.User_Pool_Tree");
271
 
272
  TCTouch.Assert_Not(
273
     FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
274
                            CDB0A01_3.System_Pool_Tree'Storage_Pool ),
275
     "'Storage_Pool not correct for CDB0A01_3.System_Pool_Tree");
276
 
277
--      Check that storage is allocated by calling Allocate.
278
 
279
  for Count in Countess'Range loop
280
    CDB0A01_2.Insert( Countess(Count), Banyan );
281
  end loop;
282
  TCTouch.Validate(Insertion, "Allocate calls via CDB0A01_2" );
283
 
284
  for Count in Countess'Range loop
285
    CDB0A01_3.Insert( Countess(Count), Torrey );
286
  end loop;
287
  TCTouch.Validate("", "Allocate calls via CDB0A01_3" );
288
 
289
  CDB0A01_2.Traverse(Banyan);
290
  TCTouch.Validate(Cenosstu, "Traversal of Banyan" );
291
 
292
  CDB0A01_3.Traverse(Torrey);
293
  TCTouch.Validate(Cenosstu, "Traversal of Torrey" );
294
 
295
  CDB0A01_2.Defoliate(Banyan);
296
  TCTouch.Validate(Deallocation, "Deforestation of Banyan" );
297
  TCTouch.Assert(Banyan = null, "Banyan Deallocation result not null");
298
 
299
  CDB0A01_3.Defoliate(Torrey);
300
  TCTouch.Validate("", "Deforestation of Torrey" );
301
  TCTouch.Assert(Torrey = null, "Torrey Deallocation result not null");
302
 
303
  Report.Result;
304
 
305
end CDB0A01;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.