gcc/testsuite/ada/acats/tests/ca/ca11015.a

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