OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca110042.am] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.