| -- 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; |
