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

   1 -- CA13A01.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 subunits declared in non-generic child units of a public
  28 --      parent have the same visibility into its parent, its siblings
  29 --      (public and private), and packages on which its parent depends
  30 --      as is available at the point of their declaration.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      Declare an check system procedure as a subunit in a private child
  34 --      package of the basic operation package (FA13A00.A).  This procedure
  35 --      has visibility into its parent ancestor and its private sibling.
  36 --
  37 --      Declare an emergency procedure as a subunit in a public child package
  38 --      of the basic operation package (FA13A00.A).  This procedure has
  39 --      visibility into its parent ancestor and its private sibling.
  40 --
  41 --      Declare an express procedure as a subunit in a public child subprogram
  42 --      of the basic operation package (FA13A00.A).  This procedure has
  43 --      visibility into its parent ancestor and its public sibling.
  44 --
  45 --      In the main program, "with"s the child package and subprogram.  Check
  46 --      that subunits perform as expected.
  47 --
  48 -- TEST FILES:
  49 --      The following files comprise this test:
  50 --
  51 --         FA13A00.A
  52 --         CA13A01.A
  53 --
  54 --
  55 -- CHANGE HISTORY:
  56 --      06 Dec 94   SAIC    ACVC 2.0
  57 --
  58 --!
  59
  60 -- Private child package of an elevator application.  This package
  61 -- provides maintenance operations.
  62
  63 private package FA13A00_1.CA13A01_4 is    -- Maintenance operation
  64
  65    One_Floor : Floor_No := 1;             -- Type declared in parent.
  66
  67    procedure Check_System;
  68
  69    -- other type definitions and procedure declarations in real application.
  70
  71 end FA13A00_1.CA13A01_4;
  72
  73      --==================================================================--
  74
  75 -- Context clauses required for visibility needed by separate subunit.
  76
  77 with FA13A00_0;                           -- Building Manager
  78
  79 with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
  80
  81 with FA13A00_1.FA13A00_3;                 -- Move Elevator
  82
  83 use  FA13A00_0;
  84
  85 package body FA13A00_1.CA13A01_4 is
  86
  87    procedure Check_System is separate;
  88
  89 end FA13A00_1.CA13A01_4;
  90
  91      --==================================================================--
  92
  93 separate (FA13A00_1.CA13A01_4)
  94
  95 -- Subunit Check_System declared in Maintenance Operation.
  96
  97 procedure Check_System is
  98 begin
  99    -- See if regular power is on.
 100
 101    if Power /= V120 then                  -- Reference package with'ed by
 102       TC_Operation := false;              -- the subunit parent's body.
 103    end if;
 104
 105    -- Test elevator function.
 106
 107    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of
 108      (Penthouse, Call_Waiting);           -- the subunit parent's body.
 109
 110    if not Call_Waiting (Penthouse) then   -- Reference private part of the
 111       TC_Operation := false;              -- parent of the subunit package's
 112                                           -- body.
 113    end if;
 114
 115    FA13A00_1.FA13A00_2.Down (One_Floor);  -- Reference private sibling of
 116                                           -- the subunit parent's body.
 117
 118    if Current_Floor /= Floor'pred (Penthouse) then
 119       TC_Operation := false;              -- Reference type declared in the
 120    end if;                                -- parent of the subunit parent's
 121                                           -- body.
 122
 123 end Check_System;
 124
 125      --==================================================================--
 126
 127 -- Public child package of an elevator application.  This package provides
 128 -- an emergency operation.
 129
 130 package FA13A00_1.CA13A01_5 is            -- Emergency Operation
 131
 132    -- Other type definitions in real application.
 133
 134    procedure Emergency;
 135
 136 private
 137    type Bell_Type is (Inactive, Active);
 138
 139 end FA13A00_1.CA13A01_5;
 140
 141      --==================================================================--
 142
 143 -- Context clauses required for visibility needed by separate subunit.
 144
 145 with FA13A00_0;                           -- Building Manager
 146
 147 with FA13A00_1.FA13A00_3;                 -- Move Elevator
 148
 149 with FA13A00_1.CA13A01_4;                 -- Maintenance Operation (private)
 150
 151 use  FA13A00_0;
 152
 153 package body FA13A00_1.CA13A01_5 is
 154
 155    procedure Emergency is separate;
 156
 157 end FA13A00_1.CA13A01_5;
 158
 159      --==================================================================--
 160
 161 separate (FA13A00_1.CA13A01_5)
 162
 163 -- Subunit Emergency declared in Maintenance Operation.
 164
 165 procedure Emergency is
 166    Bell : Bell_Type;                      -- Reference type declared in the
 167                                           -- subunit parent's body.
 168
 169 begin
 170    -- Calls maintenance operation.
 171
 172    FA13A00_1.CA13A01_4.Check_System;      -- Reference private sibling of the
 173                                           -- subunit parent 's body.
 174
 175    -- Clear all calls to the elevator.
 176
 177    Clear_Calls (Call_Waiting);            -- Reference subprogram declared
 178                                           -- in the parent of the subunit
 179                                           -- parent's body.
 180    for I in Floor loop
 181       if Call_Waiting (I) then            -- Reference private part of the
 182         TC_Operation := false;            -- parent of the subunit parent's
 183       end if;                             -- body.
 184    end loop;
 185
 186    -- Move elevator to the basement.
 187
 188    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
 189      (Basement, Call_Waiting);            -- subunit parent's body.
 190
 191    if Current_Floor /= Basement then      -- Reference type declared in the
 192       TC_Operation := false;              -- parent of the subunit parent's
 193    end if;                                -- body.
 194
 195    -- Shut off power.
 196
 197    Power := Off;                          -- Reference package with'ed by
 198                                           -- the subunit parent's body.
 199
 200    -- Activate bell.
 201
 202    Bell := Active;                        -- Reference type declared in the
 203                                           -- subunit parent's body.
 204
 205 end Emergency;
 206
 207      --==================================================================--
 208
 209 -- Public child subprogram of an elevator application.  This subprogram
 210 -- provides an express operation.
 211
 212 procedure FA13A00_1.CA13A01_6;
 213
 214      --==================================================================--
 215
 216 -- Context clauses required for visibility needed by separate subunit.
 217
 218 with FA13A00_0;                           -- Building Manager
 219
 220 with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
 221
 222 with FA13A00_1.FA13A00_3;                 -- Move Elevator
 223
 224 use  FA13A00_0;
 225
 226 procedure FA13A00_1.CA13A01_6 is          -- Express Operation
 227
 228    -- Other type definitions in real application.
 229
 230    procedure GoTo_Penthouse is separate;
 231
 232 begin
 233    GoTo_Penthouse;
 234
 235 end FA13A00_1.CA13A01_6;
 236
 237      --==================================================================--
 238
 239 separate (FA13A00_1.CA13A01_6)
 240
 241 -- Subunit GoTo_Penthouse declared in Express Operation.
 242
 243 procedure GoTo_Penthouse is
 244 begin
 245    -- Go faster.
 246
 247    Power := V240;                         -- Reference package with'ed by
 248                                           -- the subunit parent's body.
 249
 250    -- Call elevator.
 251
 252    Call (Penthouse, Call_Waiting);        -- Reference subprogram declared in
 253                                           -- the parent of the subunit
 254                                           -- parent's body.
 255
 256    if not Call_Waiting (Penthouse) then   -- Reference private part of the
 257       TC_Operation := false;              -- parent of the subunit parent's
 258    end if;                                -- body.
 259
 260    -- Move elevator to Penthouse.
 261
 262    FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
 263      (Penthouse, Call_Waiting);           -- subunit parent's body.
 264
 265    if Current_Floor /= Penthouse then     -- Reference type declared in the
 266       TC_Operation := false;              -- parent of the subunit parent's
 267    end if;                                -- body.
 268
 269    -- Return slowly
 270
 271    while Current_Floor /= Floor1 loop     -- Reference type, subprogram
 272       FA13A00_1.FA13A00_2.Down (1);       -- declared in the parent of the
 273                                           -- subunit parent's body.
 274    end loop;
 275
 276    if Current_Floor /= Floor1 then        -- Reference type declared in
 277       TC_Operation := false;              -- the parent of the subunit
 278    end if;                                -- parent's body.
 279
 280    -- Back to normal.
 281
 282    Power := V120;                         -- Reference package with'ed by
 283                                           -- the subunit parent's body.
 284
 285 end GoTo_Penthouse;
 286
 287      --==================================================================--
 288
 289 with FA13A00_1.CA13A01_5;                 -- Emergency Operation
 290                                           -- implicitly with Basic Elevator
 291                                           -- Operations
 292
 293 with FA13A00_1.CA13A01_6;                 -- Express Operation
 294
 295 with Report;
 296
 297 procedure CA13A01 is
 298
 299 begin
 300
 301    Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
 302                 "child units of a public parent have the same visibility " &
 303                 "into its parent, its parent's siblings, and packages on " &
 304                 "which its parent depends");
 305
 306    -- Go to Penthouse.
 307
 308    FA13A00_1.CA13A01_6;
 309
 310    -- Call emergency operation.
 311
 312    FA13A00_1.CA13A01_5.Emergency;
 313
 314    if not FA13A00_1.TC_Operation then
 315       Report.Failed ("Incorrect elevator operation");
 316    end if;
 317
 318    Report.Result;
 319
 320 end CA13A01;