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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11019.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11019.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 body of the parent package may depend on one of its own
28
--      private generic children.
29
--
30
-- TEST DESCRIPTION:
31
--      A scenario is created that demonstrates the potential of adding a
32
--      generic private child during code maintenance without distubing a
33
--      large subsystem.  After child is added to the subsystem, a maintainer
34
--      decides to take advantage of the new functionality and rewrites
35
--      the parent's body.
36
--
37
--      Declare a data collection abstraction in a package. Declare a private
38
--      generic child of this package which provides parameterized code that
39
--      have been written once and will be used three times to implement the
40
--      services of the parent package. In the parent body, instantiate the
41
--      private child.
42
--
43
--      In the main program, check that the operations in the parent,
44
--      and instance of the private child package perform as expected.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
50
--
51
--!
52
 
53
package CA11019_0 is
54
     -- parent
55
 
56
   type Data_Record is tagged private;
57
   type Data_Collection is private;
58
   ---
59
   ---
60
   subtype Data_1 is integer range 0 .. 100;
61
   procedure Add_1 (Data : Data_1; To : in out Data_Collection);
62
   function Statistical_Op_1 (Data : Data_Collection) return Data_1;
63
   ---
64
   subtype Data_2 is integer range -100 .. 1000;
65
   procedure Add_2 (Data : Data_2; To : in out Data_Collection);
66
   function Statistical_Op_2 (Data : Data_Collection) return Data_2;
67
   ---
68
   subtype Data_3 is integer range -10_000 .. 10_000;
69
   procedure Add_3 (Data : Data_3; To : in out Data_Collection);
70
   function Statistical_Op_3 (Data : Data_Collection) return Data_3;
71
   ---
72
 
73
private
74
 
75
   type Data_Ptr is access Data_Record'class;
76
   subtype Sequence_Number is positive range 1 .. 512;
77
 
78
   type Data_Record is tagged
79
     record
80
        Next  : Data_Ptr := null;
81
        Seq   : Sequence_Number;
82
     end record;
83
   ---
84
   type Data_Collection is
85
     record
86
        First : Data_Ptr := null;
87
        Last  : Data_Ptr := null;
88
     end record;
89
 
90
end CA11019_0;
91
 -- parent
92
 
93
    --=================================================================--
94
 
95
-- This generic package provides parameterized code that has been
96
-- written once and will be used three times to implement the services
97
-- of the parent package.
98
 
99
private
100
generic
101
   type Data_Type is range <>;
102
 
103
package CA11019_0.CA11019_1 is
104
     -- parent.child
105
 
106
   type Data_Elem is new Data_Record with
107
     record
108
        Value : Data_Type;
109
     end record;
110
 
111
   Next_Avail_Seq_No : Sequence_Number := 1;
112
 
113
   procedure Sequence (Ptr : Data_Ptr);
114
    -- the child must be private for this procedure to know details of
115
    -- the implementation of data collections
116
 
117
   procedure Add (Datum : Data_Type; To : in out Data_Collection);
118
 
119
   function  Op  (Data : Data_Collection) return Data_Type;
120
    -- op models a complicated operation that whose code can be
121
    -- used for various data types
122
 
123
 
124
end CA11019_0.CA11019_1;
125
 -- parent.child
126
 
127
     --=================================================================--
128
 
129
 
130
package body CA11019_0.CA11019_1 is
131
          -- parent.child
132
 
133
   procedure Sequence (Ptr : Data_Ptr) is
134
   begin
135
      Ptr.Seq := Next_Avail_Seq_No;
136
      Next_Avail_Seq_No := Next_Avail_Seq_No + 1;
137
   end Sequence;
138
 
139
   ---------------------------------------------------------
140
 
141
   procedure Add (Datum : Data_Type; To : in out Data_Collection) is
142
      Ptr : Data_Ptr;
143
   begin
144
      if To.First = null then
145
         -- assign new record with data value to
146
         -- to.next <- null;
147
         To.First := new Data_Elem'(Next  => null,
148
                                    Value => Datum,
149
                                    Seq   => 1);
150
         Sequence (To.First);
151
         To.Last := To.First;
152
      else
153
         -- chase to end of list
154
         Ptr := To.First;
155
         while Ptr.Next /= null loop
156
            Ptr := Ptr.Next;
157
         end loop;
158
         -- and add element there
159
         Ptr.Next := new Data_Elem'(Next  => null,
160
                                    Value => Datum,
161
                                    Seq   => 1);
162
         Sequence (Ptr.Next);
163
         To.Last := Ptr.Next;
164
      end if;
165
 
166
   end Add;
167
 
168
   ---------------------------------------------------------
169
 
170
   function  Op  (Data : Data_Collection) return Data_Type is
171
      -- for simplicity, just return the maximum of the data set
172
      Max : Data_Type := Data_Elem( Data.First.all ).Value;
173
                              -- assuming non-empty collection
174
      Ptr : Data_Ptr  := Data.First;
175
 
176
   begin
177
      -- no error checking
178
      while Ptr.Next /= null loop
179
         if Data_Elem( Ptr.Next.all ).Value > Max then
180
            Max := Data_Elem( Ptr.Next.all ).Value;
181
         end if;
182
         Ptr := Ptr.Next;
183
      end loop;
184
      return Max;
185
   end Op;
186
 
187
end CA11019_0.CA11019_1;
188
 -- parent.child
189
 
190
     --=================================================================--
191
 
192
-- parent body depends on private generic child
193
with CA11019_0.CA11019_1;     -- Private generic child.
194
 
195
pragma Elaborate (CA11019_0.CA11019_1);
196
package body CA11019_0 is
197
 
198
   -- instantiate the generic child with data types needed by the
199
   -- package interface services
200
   package Data_1_Ops is new CA11019_1
201
     (Data_Type => Data_1);
202
 
203
   package Data_2_Ops is new CA11019_1
204
     (Data_Type => Data_2);
205
 
206
   package Data_3_Ops is new CA11019_1
207
     (Data_Type => Data_3);
208
 
209
   ---------------------------------------------------------
210
 
211
   procedure Add_1 (Data : Data_1; To : in out Data_Collection) is
212
   begin
213
      -- maybe do other stuff here
214
      Data_1_Ops.Add (Data, To);
215
      -- and here
216
   end;
217
 
218
   ---------------------------------------------------------
219
 
220
   function Statistical_Op_1 (Data : Data_Collection) return Data_1 is
221
   begin
222
      -- maybe use generic operation(s) in some complicated ways
223
      -- (but simplified out, for the sake of testing)
224
      return Data_1_Ops.Op (Data);
225
   end;
226
 
227
   ---------------------------------------------------------
228
 
229
   procedure Add_2 (Data : Data_2; To : in out Data_Collection) is
230
   begin
231
      Data_2_Ops.Add (Data, To);
232
   end;
233
 
234
   ---------------------------------------------------------
235
 
236
   function Statistical_Op_2 (Data : Data_Collection) return Data_2 is
237
   begin
238
      return Data_2_Ops.Op (Data);
239
   end;
240
 
241
   ---------------------------------------------------------
242
 
243
   procedure Add_3 (Data : Data_3; To : in out Data_Collection) is
244
   begin
245
      Data_3_Ops.Add (Data, To);
246
   end;
247
 
248
   ---------------------------------------------------------
249
 
250
   function Statistical_Op_3 (Data : Data_Collection) return Data_3 is
251
   begin
252
      return Data_3_Ops.Op (Data);
253
   end;
254
 
255
end CA11019_0;
256
 
257
 
258
     --=================================================--
259
 
260
with CA11019_0,
261
  -- Main,
262
  -- Main.Child is private
263
     Report;
264
 
265
procedure CA11019 is
266
 
267
   package Main renames CA11019_0;
268
 
269
   Col_1,
270
   Col_2,
271
   Col_3 : Main.Data_Collection;
272
 
273
begin
274
 
275
   Report.Test ("CA11019", "Check that body of a (non-generic) package " &
276
                "may depend on its private generic child");
277
 
278
   -- build a data collection
279
 
280
   for I in 1 .. 10 loop
281
      Main.Add_1 ( Main.Data_1(I), Col_1);
282
   end loop;
283
 
284
   if Main.Statistical_Op_1 (Col_1) /= 10 then
285
      Report.Failed ("Wrong data_1 value returned");
286
   end if;
287
 
288
   for I in reverse 10 .. 20 loop
289
      Main.Add_2 ( Main.Data_2(I * 10), Col_2);
290
   end loop;
291
 
292
   if Main.Statistical_Op_2 (Col_2) /= 200 then
293
      Report.Failed ("Wrong data_2 value returned");
294
   end if;
295
 
296
   for I in 0 .. 10 loop
297
      Main.Add_3 ( Main.Data_3(I + 5), Col_3);
298
   end loop;
299
 
300
   if Main.Statistical_Op_3 (Col_3) /= 15 then
301
      Report.Failed ("Wrong data_3 value returned");
302
   end if;
303
 
304
   Report.Result;
305
 
306
end CA11019;

powered by: WebSVN 2.1.0

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