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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [support/] [f392a00.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- F392A00.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
-- FOUNDATION DESCRIPTION:
27
--      This foundation provides a basis for tests needing a hierarchy of
28
--      types to check object-oriented features.
29
--
30
-- CHANGE HISTORY:
31
--      06 Dec 94   SAIC    ACVC 2.0
32
--
33
--!
34
 
35
package F392A00 is          -- package Accounts
36
 
37
   --
38
   -- Types and subtypes.
39
   --
40
 
41
   type Dollar_Amount  is new Float;
42
   type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
43
   type Account_Types  is (Bank, Savings, Preferred, Total);
44
   type Account_Counter is array (Account_Types) of Integer;
45
   type Account_Rep is (President, Manager, New_Account_Manager, Teller);
46
 
47
   --
48
   -- Constants.
49
   --
50
 
51
   Opening_Balance           : constant Dollar_Amount := 100.00;
52
   Current_Rate              : constant Interest_Rate := 0.030;
53
   Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
54
 
55
   --
56
   -- Global Variables
57
   --
58
 
59
   Bank_Reserve         : Dollar_Amount   := 0.00;
60
   Daily_Representative : Account_Rep     := New_Account_Manager;
61
   Number_Of_Accounts   : Account_Counter := (Bank      => 0,
62
                                              Savings   => 0,
63
                                              Preferred => 0,
64
                                              Total     => 0);
65
   --
66
   -- Account types and their primitive operations.
67
   --
68
 
69
   -- Root type.
70
 
71
   type Bank_Account is tagged
72
      record
73
         Balance : Dollar_Amount;
74
      end record;
75
 
76
   -- Primitive operations of Bank_Account.
77
 
78
   procedure Increment_Bank_Reserve (Acct : in     Bank_Account);
79
   procedure Assign_Representative  (Acct : in     Bank_Account);
80
   procedure Increment_Counters     (Acct : in     Bank_Account);
81
   procedure Open                   (Acct : in out Bank_Account);
82
 
83
   --
84
 
85
   type Savings_Account is new Bank_Account with
86
      record
87
         Rate : Interest_Rate;
88
      end record;
89
 
90
   -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account).
91
 
92
   -- Primitive operations (Overridden).
93
   procedure Assign_Representative (Acct : in     Savings_Account);
94
   procedure Increment_Counters    (Acct : in     Savings_Account);
95
   procedure Open                  (Acct : in out Savings_Account);
96
 
97
   --
98
 
99
   type Preferred_Account is new Savings_Account with
100
      record
101
         Minimum_Balance : Dollar_Amount;
102
      end record;
103
 
104
   -- Procedure Increment_Bank_Reserve inherited twice.
105
   -- Procedure Assign_Representative inherited from parent (Savings_Account).
106
 
107
   -- Primitive operations (Overridden).
108
   procedure Increment_Counters (Acct : in     Preferred_Account);
109
   procedure Open               (Acct : in out Preferred_Account);
110
 
111
   -- Function used to verify Open operation for Preferred_Account objects.
112
   function Verify_Open (Acct : in Preferred_Account) return Boolean;
113
 
114
 
115
end F392A00;
116
 
117
 
118
     --=================================================================--
119
 
120
 
121
package body F392A00 is
122
 
123
   --
124
   -- Primitive operations for Bank_Account.
125
   --
126
 
127
   procedure Increment_Bank_Reserve (Acct : in Bank_Account) is
128
   begin
129
      Bank_Reserve := Bank_Reserve + Acct.Balance;
130
   end Increment_Bank_Reserve;
131
 
132
   procedure Assign_Representative (Acct : in Bank_Account) is
133
   begin
134
      Daily_Representative := Teller;
135
   end Assign_Representative;
136
 
137
   procedure Increment_Counters (Acct : in Bank_Account) is
138
   begin
139
      Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
140
      Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
141
   end Increment_Counters;
142
 
143
   procedure Open (Acct : in out Bank_Account) is
144
   begin
145
      Acct.Balance := Opening_Balance;
146
   end Open;
147
 
148
 
149
   --
150
   -- Overridden operations for Savings_Account type.
151
   --
152
 
153
   procedure Assign_Representative (Acct : in Savings_Account) is
154
   begin
155
      Daily_Representative := Manager;
156
   end Assign_Representative;
157
 
158
   procedure Increment_Counters (Acct : in Savings_Account) is
159
   begin
160
      Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
161
      Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
162
   end Increment_Counters;
163
 
164
   procedure Open (Acct : in out Savings_Account) is
165
   begin
166
      Open (Bank_Account(Acct));
167
      Acct.Rate := Current_Rate;
168
      Acct.Balance := 2.0 * Opening_Balance;
169
   end Open;
170
 
171
 
172
   --
173
   -- Overridden operation for Preferred_Account type.
174
   --
175
 
176
   procedure Increment_Counters (Acct : in Preferred_Account) is
177
   begin
178
      Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1;
179
      Number_Of_Accounts (Total)     := Number_Of_Accounts (Total) + 1;
180
   end Increment_Counters;
181
 
182
   procedure Open (Acct : in out Preferred_Account) is
183
   begin
184
      Open (Savings_Account(Acct));
185
      Acct.Minimum_Balance := Preferred_Minimum_Balance;
186
      Acct.Balance := Acct.Minimum_Balance;
187
   end Open;
188
 
189
   --
190
   -- Function used to verify Open operation for Preferred_Account objects.
191
   --
192
 
193
   function Verify_Open (Acct : in Preferred_Account) return Boolean is
194
   begin
195
      return (Acct.Balance         = Preferred_Minimum_Balance and
196
              Acct.Rate            = Current_Rate              and
197
              Acct.Minimum_Balance = Preferred_Minimum_Balance);
198
   end Verify_Open;
199
 
200
end F392A00;

powered by: WebSVN 2.1.0

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