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