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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC70B02.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 formal package actual part may specify actual parameters
28
--      for a generic formal package. Check that such an actual parameter may
29
--      be a formal parameter of a previously declared formal package
30
--      (with a (<>) actual part). Check that a use clause in the generic
31
--      formal part provides direct visibility of declarations within the
32
--      generic formal package, including formal parameters (if the formal
33
--      package has a (<>) actual part). Check that the scope of such a use
34
--      clause extends to the generic subprogram body. Check that the visible
35
--      part of the generic formal package includes the first list of basic
36
--      declarative items of the package specification.
37
--
38
--      Check the case where the formal package is declared in a generic
39
--      package.
40
--
41
-- TEST DESCRIPTION:
42
--      Declare a list abstraction in a generic package which manages lists of
43
--      elements of any nonlimited type (foundation code). Declare a second
44
--      generic package which declares operations on discrete types. Declare
45
--      a third generic package which combines the abstractions of the first
46
--      two generics and declares operations on lists of elements of discrete
47
--      types. Provide the third generic package with two formal parameters:
48
--      (1) a generic formal package with the discrete operation package as
49
--      template, and (2) a generic formal package with the list abstraction
50
--      package as template. Use the formal discrete type of the discrete
51
--      operations generic as the generic formal actual part for the second
52
--      formal package. Include a use clause for the first formal package in
53
--      the third generic package formal part.
54
--
55
-- TEST FILES:
56
--      The following files comprise this test:
57
--
58
--         FC70B00.A
59
--         CC70B02.A
60
--
61
--
62
-- CHANGE HISTORY:
63
--      06 Dec 94   SAIC    ACVC 2.0
64
--
65
--!
66
 
67
generic
68
   type Discrete_Type is (<>);  -- Discrete types only.
69
package CC70B02_0 is            -- Discrete type operations.
70
 
71
   procedure Double (Object : in out Discrete_Type);
72
 
73
   -- ... Other operations on discrete objects.
74
 
75
end CC70B02_0;
76
 
77
 
78
     --==================================================================--
79
 
80
 
81
package body CC70B02_0 is
82
 
83
   procedure Double (Object : in out Discrete_Type) is
84
      Doubled_Position : Integer := Discrete_Type'Pos (Object) * 2;
85
   begin
86
      -- ... Error-checking code omitted for brevity.
87
      Object := Discrete_Type'Val (Doubled_Position);
88
   end Double;
89
 
90
end CC70B02_0;
91
 
92
 
93
     --==================================================================--
94
 
95
 
96
with CC70B02_0;                  -- Discrete type operations.
97
with FC70B00;                    -- List abstraction.
98
generic
99
 
100
   -- Import both the discrete-operation and list abstractions. To ensure that
101
   -- only list abstraction instances defining lists of *discrete* elements
102
   -- will be accepted as actuals to this generic, pass the formal discrete
103
   -- type from the discrete-operation abstraction as an actual parameter to
104
   -- the list-abstraction formal package.
105
   --
106
   -- Only list instances declared for the same discrete type as that used
107
   -- to instantiate the discrete-operation package will be accepted.
108
 
109
   with package Discrete_Ops is new CC70B02_0 (<>);
110
 
111
   use Discrete_Ops;             -- Discrete_Ops directly visible.
112
 
113
   with package List_Mgr is new FC70B00 (Discrete_Type);  -- Discrete_Type is
114
                                                          -- formal parameter
115
                                                          -- of template for
116
                                                          -- Discrete_Ops.
117
package CC70B02_1 is             -- Discrete list operations.
118
 
119
   procedure Double_List (L : in out List_Mgr.List_Type);
120
 
121
   -- ... Other operations on lists of discrete objects.
122
 
123
end CC70B02_1;
124
 
125
 
126
     --==================================================================--
127
 
128
 
129
package body CC70B02_1 is
130
 
131
   procedure Double_List (L : in out List_Mgr.List_Type) is
132
      Element : Discrete_Type;  -- Formal part of Discrete_Ops template
133
   begin                        -- is directly visible here.
134
      List_Mgr.Reset (L);
135
      while not List_Mgr.End_Of_List (L) loop
136
         List_Mgr.View_Element (L, Element);
137
         Double (Element);
138
         List_Mgr.Write_Element (L, Element);
139
      end loop;
140
   end Double_List;
141
 
142
end CC70B02_1;
143
 
144
 
145
     --==================================================================--
146
 
147
 
148
with FC70B00;    -- Generic list abstraction.
149
with CC70B02_0;  -- Generic discrete type operations.
150
with CC70B02_1;  -- Generic discrete list operations.
151
 
152
with Report;
153
procedure CC70B02 is
154
 
155
   type Points is range 0 .. 100;                   -- Discrete type.
156
 
157
   package Points_Ops is new CC70B02_0 (Points);    -- Points-type operations.
158
   package Lists_of_Points is new FC70B00 (Points); -- Points lists.
159
   package Points_List_Ops is new                   -- Points-list operations.
160
     CC70B02_1 (Points_Ops, Lists_Of_Points);
161
 
162
   Scores : Lists_of_Points.List_Type;              -- List of points.
163
 
164
 
165
   -- Begin test code declarations: -----------------------
166
 
167
   type TC_Score_Array is array (1 .. 3) of Points;
168
 
169
   TC_Initial_Values : constant TC_Score_Array := (23, 15,  0);
170
   TC_Final_Values   : constant TC_Score_Array := (46, 30,  0);
171
 
172
   TC_Correct_Initial_Values : Boolean := False;
173
   TC_Correct_Final_Values   : Boolean := False;
174
 
175
 
176
   procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
177
   begin                                  -- Initial list contains 3 scores
178
      for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
179
         Lists_Of_Points.Add_Element (L, TC_Initial_Values(I));
180
      end loop;
181
   end TC_Initialize_List;
182
 
183
 
184
   procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
185
                             Expected : in     TC_Score_Array;
186
                             OK       :    out Boolean) is
187
      Actual : TC_Score_Array;
188
   begin                                  -- Verify that all scores have been
189
      Lists_Of_Points.Reset (L);          -- set to zero.
190
      for I in TC_Score_Array'Range loop
191
         Lists_Of_Points.Read_Element (L, Actual(I));
192
      end loop;
193
      OK := (Actual = Expected);
194
   end TC_Verify_List;
195
 
196
   -- End test code declarations. -------------------------
197
 
198
 
199
begin
200
   Report.Test ("CC70B02", "Check that a library-level generic package "      &
201
                "may have a formal package as a formal parameter, and that "  &
202
                "the generic formal actual part may specify explicit actual " &
203
                "parameters (including a formal parameter of a previously "   &
204
                "declared formal package). Check that a use clause is legal " &
205
                "in the generic formal part");
206
 
207
   TC_Initialize_List (Scores);
208
   TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
209
 
210
   if not TC_Correct_Initial_Values then
211
      Report.Failed ("List contains incorrect initial values");
212
   end if;
213
 
214
   Points_List_Ops.Double_List (Scores);
215
   TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
216
 
217
   if not TC_Correct_Final_Values then
218
      Report.Failed ("List contains incorrect final values");
219
   end if;
220
 
221
   Report.Result;
222
end CC70B02;

powered by: WebSVN 2.1.0

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