gomp-20050608-branch/gcc/testsuite/ada/acats/tests/ca/ca110042.am

   1 -- CA110042.AM
   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 the private part of a child library unit package can
  28 --      utilize its parent unit's visible definitions.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a public library unit package and child package, with the
  32 --      child package having a private part in the specification.  Within
  33 --      this child private part, make use of components that are declared in
  34 --      the visible part of the parent.
  35 --
  36 --      Demonstrate visibility to the following parent components in the
  37 --      child private part:
  38 --                          Parent
  39 --          Type              X
  40 --          Constant          X
  41 --          Object            X
  42 --          Subprogram        X
  43 --          Exception         X
  44 --
  45 --
  46 -- TEST FILES:
  47 --      The following files comprise this test:
  48 --
  49 --         CA110040.A
  50 --         CA110041.A
  51 --      => CA110042.AM
  52 --
  53 --
  54 -- CHANGE HISTORY:
  55 --      06 Dec 94   SAIC    ACVC 2.0
  56 --
  57 --!
  58 with Report;
  59 with CA110040.CA110041;
  60
  61 procedure CA110042 is
  62
  63       package System_Manager renames CA110040.CA110041;
  64       use CA110040;
  65       User1, User2, User3 : System_Manager.User_Account;
  66
  67 begin
  68
  69    Report.Test ("CA110042", "Check that the private part of a child "     &
  70                             "library unit package can utilize its "       &
  71                             "parent unit's visible definitions");
  72
  73    Assign_New_Accounts:            -- This code simulates the entering of new
  74                                    -- user accounts into a computer system.
  75                                    -- It also simulates the processing that
  76                                    -- could occur when the limit on system
  77                                    -- accounts has been exceeded.
  78
  79                                    -- This processing block demonstrates the
  80                                    -- use of child package functionality that
  81                                    -- takes advantage of components declared in
  82                                    -- the parent package.
  83    begin
  84
  85       if Total_Accounts /= 2 then
  86          Report.Failed ("Incorrect number of accounts currently allocated");
  87       end if;                                         -- At this point, both
  88                                                       -- System_Account and
  89                                                       -- Auditor_Account have
  90                                                       -- been declared and
  91                                                       -- initialized in package
  92                                                       -- CA110040.CA110041.
  93
  94       System_Manager.Initialize_User_Account (User1); -- User_ID has been
  95                                                       -- set to 3.
  96
  97       System_Manager.Initialize_User_Account (User2); -- User_ID has been
  98                                                       -- set to 4, which
  99                                                       -- is the last value
 100                                                       -- defined for the
 101                                                       -- CA110040.ID_Type
 102                                                       -- range.
 103
 104       System_Manager.Initialize_User_Account (User3); -- This final call will
 105                                                       -- result in an
 106                                                       -- Account_Limit_Exceeded
 107                                                       -- exception being raised.
 108
 109       Report.Failed ("Control should have transferred with exception");
 110
 111    exception
 112
 113       when Account_Limit_Exceeded =>
 114          if (not (Administrator_Account.User_ID = ID_Type'First)) or
 115            (User2.User_ID /= CA110040.ID_Type'Last)
 116          then
 117             Report.Failed ("Account initialization failure");
 118          end if;
 119       when others =>
 120          Report.Failed ("Unexpected exception raised");
 121
 122    end Assign_New_Accounts;
 123
 124    if (User1.User_ID /= 3) or (User2.User_ID /= 4) then
 125       Report.Failed ("Improper initialization of user accounts");
 126    end if;
 127
 128    Report.Result;
 129
 130 end CA110042;