ca11015.a

linux下编程用 编译软件

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