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