1-- 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 49package 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 69private 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 74end CA11015_0; 75 76 --==================================================================-- 77 78package 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 117end 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 125generic 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 131package 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 147private 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 156end CA11015_0.CA11015_1; 157 158 --==================================================================-- 159 160package 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 190end CA11015_0.CA11015_1; 191 192 --==================================================================-- 193 194with CA11015_0.CA11015_1; -- Generic map operation, 195 -- implicitly withs parent, basic map 196 -- application. 197with Report; 198 199procedure CA11015 is 200 201begin 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 312end CA11015; 313