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/] [ca/] [ca11015.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11015.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 child of a non-generic package can use its
28
--      parent's declarations and operations.  Check that the instantiation
29
--      of the generic child can correctly use the operations.
30
--
31
-- TEST DESCRIPTION:
32
--      Declare a map abstraction in a package which manages basic physical
33
--      maps.  Declare a generic child of this package which defines copies
34
--      of maps of any discrete type, i.e., population, density, or weather.
35
--
36
--      In the main program, declare an instance of the child.  Check that
37
--      the operations in the parent and instance of the child package
38
--      perform as expected.
39
--
40
--
41
-- CHANGE HISTORY:
42
--      06 Dec 94   SAIC    ACVC 2.0
43
--
44
--!
45
 
46
-- Simulates map of physical features, i.e., desert, forest, water,
47
-- or plains.
48
 
49
package CA11015_0 is
50
   type Map_Type is private;
51
   subtype Latitude is integer range 1 .. 9;
52
   subtype Longitude is integer range 1 .. 7;
53
 
54
   type Physical_Features is (Desert, Forest, Water, Plains, Unexplored);
55
   type Page_Type is range 0 .. 80;
56
 
57
   Terra_Incognita : exception;
58
 
59
   -- Use geographic database to initialize the basic map.
60
 
61
   procedure Initialize_Basic_Map (Map  : in out Map_Type);
62
 
63
   function Get_Physical_Feature (Lat  : Latitude;
64
                                  Long : Longitude;
65
                                  Map  : Map_Type) return Physical_Features;
66
 
67
   function Next_Page return Page_Type;
68
 
69
private
70
   type Map_Type is array (Latitude, Longitude) of Physical_Features;
71
   Basic_Map : Map_Type;
72
   Page      : Page_Type := 0;       -- Location for each copy of Map.
73
 
74
end CA11015_0;
75
 
76
     --==================================================================--
77
 
78
package body CA11015_0 is
79
 
80
   procedure Initialize_Basic_Map (Map : in out Map_Type) is
81
   -- Not a real initialization.  Real application can use geographic
82
   -- database to create the basic map.
83
   begin
84
      for I in Latitude'first .. Latitude'last loop
85
         for J in 1 .. 2 loop
86
            Map (I, J) := Unexplored;
87
         end loop;
88
         for J in 3 .. 4 loop
89
            Map (I, J) := Desert;
90
         end loop;
91
         for J in 5 .. 7 loop
92
            Map (I, J) := Plains;
93
         end loop;
94
      end loop;
95
 
96
   end Initialize_Basic_Map;
97
   ---------------------------------------------------
98
   function Get_Physical_Feature (Lat  : Latitude;
99
                                  Long : Longitude;
100
                                  Map  : Map_Type)
101
     return Physical_Features is
102
   begin
103
     return (Map (Lat, Long));
104
   end Get_Physical_Feature;
105
   ---------------------------------------------------
106
   function Next_Page return Page_Type is
107
   begin
108
      Page := Page + 1;
109
      return (Page);
110
   end Next_Page;
111
 
112
   ---------------------------------------------------
113
   begin -- CA11015_0
114
      -- Initialize a basic map.
115
      Initialize_Basic_Map (Basic_Map);
116
 
117
end CA11015_0;
118
 
119
     --==================================================================--
120
 
121
-- Generic child package of physical map.  Instantiate this package to
122
-- create map copy with a new geographic feature, i.e., population, density,
123
-- or weather.
124
 
125
generic
126
 
127
   type Generic_Feature is (<>);  -- Any geographic feature, i.e., population,
128
                                  -- density, or weather that can be
129
                                  -- characterized by a scalar value.
130
 
131
package CA11015_0.CA11015_1 is
132
 
133
   type Feature_Map is private;
134
 
135
   function Get_Feature_Val (Lat  : Latitude;
136
                             Long : Longitude;
137
                             Map  : Feature_Map) return Generic_Feature;
138
 
139
   procedure Set_Feature_Val (Lat  : in     Latitude;
140
                              Long : in     Longitude;
141
                              Fea  : in     Generic_Feature;
142
                              Map  : in out Feature_Map);
143
 
144
   function Check_Page (Map     : Feature_Map;
145
                        Page_No : Page_Type) return boolean;
146
 
147
private
148
   type Feature_Type is array (Latitude, Longitude) of Generic_Feature;
149
 
150
   type Feature_Map is
151
     record
152
        Feature : Feature_Type;
153
        Page    : Page_Type := Next_Page;    -- Operation from parent.
154
     end record;
155
 
156
end CA11015_0.CA11015_1;
157
 
158
     --==================================================================--
159
 
160
package body CA11015_0.CA11015_1 is
161
 
162
   function Get_Feature_Val (Lat  : Latitude;
163
                             Long : Longitude;
164
                             Map  : Feature_Map) return Generic_Feature is
165
   begin
166
     return (Map.Feature (Lat, Long));
167
   end Get_Feature_Val;
168
   ---------------------------------------------------
169
   procedure Set_Feature_Val (Lat  : in     Latitude;
170
                              Long : in     Longitude;
171
                              Fea  : in     Generic_Feature;
172
                              Map  : in out Feature_Map) is
173
   begin
174
      if Get_Physical_Feature (Lat, Long, Basic_Map) = Unexplored
175
                                                -- Parent's operation,
176
                                                -- Parent's private object.
177
      then
178
         raise Terra_Incognita;                 -- Exception from parent.
179
      else
180
         Map.Feature (Lat, Long) := Fea;
181
      end if;
182
   end Set_Feature_Val;
183
   ---------------------------------------------------
184
   function Check_Page (Map     : Feature_Map;
185
                        Page_No : Page_Type) return boolean is
186
   begin
187
      return (Map.Page = Page_No);
188
   end Check_Page;
189
 
190
end CA11015_0.CA11015_1;
191
 
192
     --==================================================================--
193
 
194
with CA11015_0.CA11015_1;              -- Generic map operation,
195
                                       -- implicitly withs parent, basic map
196
                                       -- application.
197
with Report;
198
 
199
procedure CA11015 is
200
 
201
begin
202
 
203
   Report.Test ("CA11015", "Check that an instantiation of a child package " &
204
                           "of a non-generic package can use its parent's "  &
205
                           "declarations and operations");
206
 
207
-- An application creates a population map using an integer type.
208
 
209
           Population_Map_Subtest:
210
           declare
211
              type Population_Type is range 0 .. 10_000;
212
 
213
              -- Declare instance of the child generic map package for one
214
              -- particular integer type.
215
 
216
              package Population is new CA11015_0.CA11015_1 (Population_Type);
217
 
218
              Population_Map_Latitude   : CA11015_0.Latitude := 1;
219
                                                   -- parent's type
220
              Population_Map_Longitude : CA11015_0.Longitude := 5;
221
                                                   -- parent's type
222
              Pop_Map                   : Population.Feature_Map;
223
              Pop                       : Population_Type := 1000;
224
 
225
           begin
226
              Population.Set_Feature_Val (Population_Map_Latitude,
227
                                          Population_Map_Longitude,
228
                                          Pop,
229
                                          Pop_Map);
230
 
231
              If not ( (Population.Get_Feature_Val (Population_Map_Latitude,
232
                Population_Map_Longitude, Pop_Map) = Pop) or
233
                  (Population.Check_Page (Pop_Map, 1)) ) then
234
                    Report.Failed ("Population map contains incorrect values");
235
              end if;
236
 
237
           end Population_Map_Subtest;
238
 
239
-- An application creates a weather map using an enumeration type.
240
 
241
           Weather_Map_Subtest:
242
           declare
243
              type Weather_Type is (Hot, Cold, Mild);
244
 
245
              -- Declare instance of the child generic map package for one
246
              -- particular enumeration type.
247
 
248
              package Weather_Pkg is new CA11015_0.CA11015_1 (Weather_Type);
249
 
250
              Weather_Map_Latitude   : CA11015_0.Latitude := 2;
251
                                                   -- parent's type
252
              Weather_Map_Longitude : CA11015_0.Longitude := 6;
253
                                                   -- parent's type
254
              Weather_Map            : Weather_Pkg.Feature_Map;
255
              Weather                : Weather_Type := Mild;
256
 
257
           begin
258
              Weather_Pkg.Set_Feature_Val (Weather_Map_Latitude,
259
                                           Weather_Map_Longitude,
260
                                           Weather,
261
                                           Weather_Map);
262
 
263
              if ( (Weather_Pkg.Get_Feature_Val (Weather_Map_Latitude,
264
                    Weather_Map_Longitude, Weather_Map) /= Weather) or
265
                not (Weather_Pkg.Check_Page (Weather_Map, 2)) )
266
              then
267
                 Report.Failed ("Weather map contains incorrect values");
268
              end if;
269
 
270
           end Weather_Map_Subtest;
271
 
272
-- During processing, the application may erroneously attempts to create
273
-- a density map on an unexplored area.  This would result in the raising
274
-- of an exception.
275
 
276
           Density_Map_Subtest:
277
           declare
278
              type Density_Type is (High, Medium, Low);
279
 
280
              -- Declare instance of the child generic map package for one
281
              -- particular enumeration type.
282
 
283
              package Density_Pkg is new CA11015_0.CA11015_1 (Density_Type);
284
 
285
              Density_Map_Latitude   : CA11015_0.Latitude := 7;
286
                                                   -- parent's type
287
              Density_Map_Longitude : CA11015_0.Longitude := 2;
288
                                                   -- parent's type
289
              Density                : Density_Type := Low;
290
              Density_Map            : Density_Pkg.Feature_Map;
291
 
292
           begin
293
              Density_Pkg.Set_Feature_Val (Density_Map_Latitude,
294
                                           Density_Map_Longitude,
295
                                           Density,
296
                                           Density_Map);
297
 
298
              Report.Failed ("Exception not raised in child generic package");
299
 
300
           exception
301
 
302
              when CA11015_0.Terra_Incognita =>   -- parent's exception,
303
                  null;                           -- raised in child.
304
 
305
              when others          =>
306
                  Report.Failed ("Others exception is raised");
307
 
308
           end Density_Map_Subtest;
309
 
310
   Report.Result;
311
 
312
end CA11015;

powered by: WebSVN 2.1.0

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