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/] [cc/] [cc70c02.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC70C02.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 generic formal package is an instance. Specifically,
28
--      check that a generic formal package may be passed as an actual
29
--      parameter to another generic formal package. Check that the
30
--      visible part of the generic formal package includes the first list of
31
--      basic declarative items of the package specification.
32
--
33
-- TEST DESCRIPTION:
34
--      A generic formal package is a package, and is an instance.
35
--
36
--      Declare a list type in a generic package for lists of elements of any
37
--      nonlimited type (foundation code). Declare a second generic package
38
--      which declares operations for the list type, and parameterize it with
39
--      a generic formal package with the list-type package as template
40
--      (foundation code). Declare a third generic package which declares
41
--      additional operations for the list type, and parameterize it with two
42
--      generic formal packages, one with the list-type package as template,
43
--      the other with the second generic package as template. Use the first
44
--      formal package as the generic formal actual part for the second formal
45
--      package.
46
--
47
-- TEST FILES:
48
--      The following files comprise this test:
49
--
50
--         FC70C00.A
51
--         CC70C02.A
52
--
53
--
54
-- CHANGE HISTORY:
55
--      06 Dec 94   SAIC    ACVC 2.0
56
--
57
--!
58
 
59
with FC70C00_0;                -- List abstraction.
60
with FC70C00_1;                -- Basic list operations.
61
generic
62
 
63
   -- Import both the list-type abstraction defined in FC70C00_0 and the basic
64
   -- list operations defined in FC70C00_1. To ensure that only basic operation
65
   -- instances for lists of the same element type as that used to instantiate
66
   -- the list type are accepted as actuals to this generic, pass the list-type
67
   -- formal package as an actual parameter to the list-operation formal
68
   -- package.
69
 
70
   with package Lists          is new FC70C00_0 (<>);
71
   with package Basic_List_Ops is new FC70C00_1 (Lists);
72
package CC70C02_0 is           -- Additional list operations.
73
 
74
   End_of_List_Reached : exception;
75
 
76
 
77
   -- Read from current element and advance "current" pointer.
78
   procedure Read_Element (L : in out Lists.List_Type;
79
                           E :    out Lists.Element_Type);
80
 
81
   -- Add element to end of list.
82
   procedure Add_Element (L : in out Lists.List_Type;
83
                          E : in     Lists.Element_Type);
84
 
85
end CC70C02_0;
86
 
87
 
88
     --==================================================================--
89
 
90
 
91
package body CC70C02_0 is
92
 
93
   procedure Read_Element (L : in out Lists.List_Type;
94
                           E :    out Lists.Element_Type) is
95
   begin
96
      if Basic_List_Ops.End_Of_List (L) then  -- Use of op from the previous
97
         raise End_Of_List_Reached;           -- generic package.
98
      else
99
         E         := L.Current.Item;         -- Retrieve current element.
100
         L.Current := L.Current.Next;         -- Advance "current" pointer.
101
      end if;
102
   end Read_Element;
103
 
104
 
105
   procedure Add_Element (L : in out Lists.List_Type;
106
                          E : in     Lists.Element_Type) is
107
      New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null);
108
      use type Lists.Node_Pointer;
109
   begin
110
      if L.First = null then                -- No elements in list, so add new
111
         L.First := New_Node;               -- element at beginning of list.
112
      else
113
         L.Last.Next := New_Node;           -- Add new element at end of list.
114
      end if;
115
      L.Last := New_Node;                   -- Set last-in-list pointer.
116
   end Add_Element;
117
 
118
 
119
end CC70C02_0;
120
 
121
 
122
     --==================================================================--
123
 
124
 
125
with FC70C00_0;  -- Generic list type abstraction.
126
with FC70C00_1;  -- Generic list operations.
127
with CC70C02_0;  -- Additional generic list operations.
128
 
129
with Report;
130
procedure CC70C02 is
131
 
132
   type Points is range 0 .. 100;                     -- Discrete type.
133
 
134
   package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
135
 
136
   package Basic_Point_Ops is new                     -- Basic points-list ops.
137
     FC70C00_1 (Lists_Of_Points);
138
 
139
   package Points_List_Ops is new                     -- More points-list ops.
140
     CC70C02_0 (Lists          => Lists_Of_Points,
141
                Basic_List_Ops => Basic_Point_Ops);
142
 
143
   Scores : Lists_of_Points.List_Type;                -- List of points.
144
 
145
 
146
   -- Begin test code declarations: -----------------------
147
 
148
   type TC_Score_Array is array (1 .. 3) of Points;
149
 
150
   TC_List_Values : constant TC_Score_Array := (23, 15,  0);
151
 
152
   TC_Correct_List_Values : Boolean := False;
153
 
154
 
155
   procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
156
   begin                                  -- Initial list contains 3 scores
157
      for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
158
         Points_List_Ops.Add_Element (L, TC_List_Values(I));
159
      end loop;
160
   end TC_Initialize_List;
161
 
162
 
163
   procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
164
                             Expected : in     TC_Score_Array;
165
                             OK       :    out Boolean) is
166
      Actual : TC_Score_Array;
167
   begin
168
      Basic_Point_Ops.Reset (L);
169
      for I in TC_Score_Array'Range loop
170
         Points_List_Ops.Read_Element (L, Actual(I));
171
      end loop;
172
      OK := (Actual = Expected);
173
   end TC_Verify_List;
174
 
175
   -- End test code declarations. -------------------------
176
 
177
 
178
begin
179
 
180
   Report.Test ("CC70C02", "Check that a generic formal package may be " &
181
                "passed as an actual to another formal package");
182
 
183
   TC_Initialize_List (Scores);
184
   TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
185
 
186
   if not TC_Correct_List_Values then
187
      Report.Failed ("List contains incorrect values");
188
   end if;
189
 
190
   Report.Result;
191
 
192
end CC70C02;

powered by: WebSVN 2.1.0

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