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

   1 -- CA13001.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 separate protected unit declared in a non-generic child
  28 --      unit of a private parent have the same visibility into its parent,
  29 --      its siblings, and packages on which its parent depends as is available
  30 --      at the point of their declaration.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      A scenario is created that demonstrates the potential of having all
  34 --      members of one family to take out a transportation.  The restriction
  35 --      is depend on each member to determine who can get a car, a clunker,
  36 --      or a bicycle.  If no transportation is available, that member has to
  37 --      walk.
  38 --
  39 --      Declare a package with location for each family member.  Declare
  40 --      a public parent package.  Declare a private child package. Declare a
  41 --      public grandchild of this private package.  Declare a protected unit
  42 --      as a subunit in a public grandchild package.  This subunit has
  43 --      visibility into it's parent body ancestor and its sibling.
  44 --
  45 --      Declare another public parent package.  The body of this package has
  46 --      visibility into its private sibling's descendants.
  47 --
  48 --      In the main program, "with"s the parent package.  Check that the
  49 --      protected subunit performs as expected.
  50 --
  51 --
  52 -- CHANGE HISTORY:
  53 --      06 Dec 94   SAIC    ACVC 2.0
  54 --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
  55 --
  56 --!
  57
  58 package CA13001_0 is
  59
  60    type Location is (School, Work, Beach, Home);
  61    type Family is (Father, Mother, Teen);
  62    Destination : array (Family) of Location;
  63
  64    -- Other type definitions and procedure declarations in real application.
  65
  66 end CA13001_0;
  67
  68 -- No bodies required for CA13001_0.
  69
  70      --==================================================================--
  71
  72 -- Public parent.
  73
  74 package CA13001_1 is
  75
  76    type Transportation is (Bicycle, Clunker, New_Car);
  77    type Key_Type is private;
  78    Walking : boolean := false;
  79
  80    -- Other type definitions and procedure declarations in real application.
  81
  82 private
  83    type Key_Type
  84      is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
  85
  86 end CA13001_1;
  87
  88 -- No bodies required for CA13001_1.
  89
  90      --==================================================================--
  91
  92 -- Private child.
  93
  94 private package CA13001_1.CA13001_2 is
  95
  96    type Transport is
  97       record
  98          In_Use : boolean := false;
  99       end record;
 100    Vehicles : array (Transportation) of Transport;
 101
 102    -- Other type definitions and procedure declarations in real application.
 103
 104 end CA13001_1.CA13001_2;
 105
 106 -- No bodies required for CA13001_1.CA13001_2.
 107
 108      --==================================================================--
 109
 110 -- Public grandchild of a private parent.
 111
 112 package CA13001_1.CA13001_2.CA13001_3 is
 113
 114    Flat_Tire : array (Transportation) of boolean := (others => false);
 115
 116    -- Other type definitions and procedure declarations in real application.
 117
 118 end CA13001_1.CA13001_2.CA13001_3;
 119
 120 -- No bodies required for CA13001_1.CA13001_2.CA13001_3.
 121
 122      --==================================================================--
 123
 124 -- Context clauses required for visibility needed by a separate subunit.
 125
 126 with CA13001_0;
 127 use  CA13001_0;
 128
 129 -- Public grandchild of a private parent.
 130
 131 package CA13001_1.CA13001_2.CA13001_4 is
 132
 133    type Transit is
 134       record
 135          Available : boolean := false;
 136       end record;
 137    type Keys_Array is array (Transportation) of Transit;
 138    Fuel : array (Transportation) of boolean := (others => true);
 139
 140    protected Family_Transportation is
 141
 142       procedure Get_Vehicle (Who : in     Family;
 143                              Key :    out Key_Type);
 144       procedure Return_Vehicle (Tr : in Transportation);
 145       function TC_Verify (What : Transportation) return boolean;
 146
 147    private
 148       Keys : Keys_Array;
 149
 150    end Family_Transportation;
 151
 152 end CA13001_1.CA13001_2.CA13001_4;
 153
 154      --==================================================================--
 155
 156 -- Context clause required for visibility needed by a separate subunit.
 157
 158 with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
 159
 160 package body CA13001_1.CA13001_2.CA13001_4 is
 161
 162    protected body Family_Transportation is separate;
 163
 164 end CA13001_1.CA13001_2.CA13001_4;
 165
 166      --==================================================================--
 167
 168 separate (CA13001_1.CA13001_2.CA13001_4)
 169 protected body Family_Transportation is
 170
 171    procedure Get_Vehicle (Who : in     Family;
 172                           Key :    out Key_Type) is
 173    begin
 174       case Who is
 175          when Father|Mother =>
 176             -- Drive new car to work
 177
 178             -- Reference package with'ed by the subunit parent's body.
 179             if Destination(Who) = Work then
 180
 181                -- Reference type declared in the private parent of the subunit
 182                -- parent's body.
 183                -- Reference type declared in the visible part of the
 184                -- subunit parent's body.
 185                if not Vehicles(New_Car).In_Use and Fuel(New_Car)
 186
 187                  -- Reference type declared in the public sibling of the
 188                  -- subunit parent's body.
 189                  and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
 190                     Vehicles(New_Car).In_Use := true;
 191
 192                     -- Reference type declared in the private part of the
 193                     -- protected subunit.
 194                     Keys(New_Car).Available := false;
 195                     Key                     := Transportation'pos(New_Car);
 196                else
 197                  -- Reference type declared in the grandparent of the subunit
 198                  -- parent's body.
 199                  Walking := true;
 200                end if;
 201
 202             -- Drive clunker to other destinations.
 203             else
 204                if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
 205                  CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
 206                     Vehicles(Clunker).In_Use := true;
 207                     Keys(Clunker).Available  := false;
 208                     Key                      := Transportation'pos(Clunker);
 209                else
 210                  Walking := true;
 211                  Key     := Transportation'pos(Bicycle);
 212                end if;
 213             end if;
 214
 215          -- Similar for Teen.
 216          when Teen =>
 217             if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not
 218               CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
 219                  Vehicles(Clunker).In_Use := true;
 220                  Keys(Clunker).Available  := false;
 221                  Key                      := Transportation'pos(Clunker);
 222             else
 223                Walking := true;
 224                Key     := Transportation'pos(Bicycle);
 225             end if;
 226       end case;
 227
 228    end Get_Vehicle;
 229
 230    ----------------------------------------------------------------
 231
 232    -- Any family member can bring back the transportation with the key.
 233
 234    procedure Return_Vehicle (Tr : in Transportation) is
 235    begin
 236       Vehicles(Tr).In_Use := false;
 237       Keys(Tr).Available  := true;
 238    end Return_Vehicle;
 239
 240    ----------------------------------------------------------------
 241
 242    function TC_Verify (What : Transportation) return boolean is
 243    begin
 244       return Keys(What).Available;
 245    end TC_Verify;
 246
 247 end Family_Transportation;
 248
 249      --==================================================================--
 250
 251 with CA13001_0;
 252 use  CA13001_0;
 253
 254 -- Public child.
 255
 256 package CA13001_1.CA13001_5 is
 257
 258    -- In a real application, tasks could be used to demonstrate
 259    -- a family transportation scenario, i.e., each member of
 260    -- a family can take a vehicle out concurrently, then return
 261    -- them at the same time. For the purposes of the test, family
 262    -- transportation happens sequentially.
 263
 264    procedure Provide_Transportation (Who     : in     Family;
 265                                      Get_Key :    out Key_Type;
 266                                      Get_Veh :    out boolean);
 267    procedure Return_Transportation (What   : in     Transportation;
 268                                     Rt_Veh :    out boolean);
 269
 270 end CA13001_1.CA13001_5;
 271
 272      --==================================================================--
 273
 274 with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
 275                                       -- implicitly with CA13001_1.CA13001_2.
 276 package body CA13001_1.CA13001_5 is
 277
 278    package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
 279    use Transportation_Pkg;
 280
 281    -- These two validation subprograms provide the capability to check the
 282    -- components defined in the private packages from within the client
 283    -- program.
 284
 285    procedure Provide_Transportation (Who     : in     Family;
 286                                      Get_Key :    out Key_Type;
 287                                      Get_Veh :    out boolean) is
 288    begin
 289       -- Goto work, school, or to the beach.
 290       Family_Transportation.Get_Vehicle (Who, Get_Key);
 291       if not Family_Transportation.TC_Verify
 292         (Transportation'Val(Get_Key)) then
 293            Get_Veh := true;
 294       else
 295          Get_Veh := false;
 296       end if;
 297
 298    end Provide_Transportation;
 299
 300    ----------------------------------------------------------------
 301
 302    procedure Return_Transportation (What   : in     Transportation;
 303                                     Rt_Veh :    out boolean) is
 304    begin
 305       Family_Transportation.Return_Vehicle (What);
 306       if Family_Transportation.TC_Verify(What) and
 307         not CA13001_1.CA13001_2.Vehicles(What).In_Use then
 308            Rt_Veh := true;
 309       else
 310          Rt_Veh := false;
 311       end if;
 312
 313    end Return_Transportation;
 314
 315 end CA13001_1.CA13001_5;
 316
 317      --==================================================================--
 318
 319 with CA13001_0;
 320 with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
 321 with Report;
 322
 323 procedure CA13001 is
 324
 325    Mommy           : CA13001_0.Family := CA13001_0.Mother;
 326    Daddy           : CA13001_0.Family := CA13001_0.Father;
 327    BG              : CA13001_0.Family := CA13001_0.Teen;
 328    BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
 329    Get_Key         : CA13001_1.Key_Type;
 330    Get_Transit     : boolean := false;
 331    Return_Transit  : boolean := false;
 332
 333 begin
 334    Report.Test ("CA13001", "Check that a protected subunit declared in " &
 335                 "a child unit of a private parent have the same visibility " &
 336                 "into its parent, its parent's siblings, and packages on " &
 337                 "which its parent depends");
 338
 339    -- Get transportation for mother to go to work.
 340    CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
 341    CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
 342    if not Get_Transit then
 343       Report.Failed ("Failed to get mother transportation");
 344    end if;
 345
 346    -- Get transportation for teen to go to school.
 347    CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
 348    Get_Transit := false;
 349    CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
 350    if not Get_Transit then
 351       Report.Failed ("Failed to get teen transportation");
 352    end if;
 353
 354    -- Get transportation for father to go to the beach.
 355    CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
 356    Get_Transit := false;
 357    CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
 358    if Get_Transit and not CA13001_1.Walking then
 359       Report.Failed ("Failed to make daddy to walk to the beach");
 360    end if;
 361
 362    -- Return the clunker.
 363    CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
 364    if not Return_Transit then
 365       Report.Failed ("Failed to get back the clunker");
 366    end if;
 367
 368    Report.Result;
 369
 370 end CA13001;