1-- 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
35package 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
115end F392A00;
116
117
118     --=================================================================--
119
120
121package 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
200end F392A00;
201