::
x11_acc4.ada
package Class_abstract_account is
type Abstract_account is abstract tagged null record;
subtype Money is Float;
subtype PMoney is Float range 0.0 .. Float'Last;
procedure statement( the:in Abstract_account ) is abstract;
procedure deposit ( the:in out Abstract_account;
amount:in PMoney ) is abstract;
procedure withdraw ( the:in out Abstract_account;
amount:in PMoney;
get:out PMoney ) is abstract;
function balance ( the:in Abstract_account )
return Money is abstract;
end Class_abstract_account;
-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
-- FIX
-- type Abstract_account is tagged private;
-- MUST BE
-- type Abstract_account is abstract tagged private;
package Class_abstract_account_other is
type Abstract_account is abstract tagged private;
type Abstract_account2 is abstract tagged private;
subtype Money is Float;
subtype PMoney is Float range 0.0 .. Float'Last;
procedure statement( the:in Abstract_account ) is abstract;
procedure deposit ( the:in out Abstract_account;
amount:in PMoney ) is abstract;
procedure withdraw ( the:in out Abstract_account;
amount:in PMoney;
get:out PMoney ) is abstract;
function balance ( the:in Abstract_account )
return Money is abstract;
private
type Abstract_account is abstract tagged record null; end record;
type Abstract_account2 is abstract tagged null record;
end Class_abstract_account_other;
-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
with Class_abstract_account;
use Class_abstract_account;
package Class_account is
type Account is new Abstract_account with private;
subtype Money is Class_abstract_account.Money;
subtype PMoney is Class_abstract_account.PMoney;
procedure statement( the:in Account );
procedure deposit ( the:in out Account; amount:in PMoney );
procedure withdraw ( the:in out Account; amount:in PMoney;
get:out PMoney );
function balance ( the:in Account ) return Money;
private
type Account is new Abstract_account with record
balance_of : Money := 0.00; -- Amount in account
end record;
end Class_account;
with Simple_io; use Simple_io;
package body Class_account is
procedure statement( the:in Account ) is
begin
put("Mini statement: The amount on deposit is $" );
put( the.balance_of, aft=>2, exp=>0 );
new_line(2);
end statement;
procedure deposit( the:in out Account; amount:in PMoney ) is
begin
the.balance_of := the.balance_of + amount;
end deposit;
procedure withdraw( the:in out Account;
amount:in PMoney; get:out PMoney ) is
begin
if the.balance_of >= amount then
the.balance_of := the.balance_of - amount;
get := amount;
else
get := 0.00;
end if;
end withdraw;
function balance( the:in Account ) return Money is
begin
return the.balance_of;
end balance;
end Class_account;
-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
with Class_account;
use Class_account;
package Class_interest_account is
type Interest_account is new Account with private;
procedure set_rate( rate:in Float );
procedure calc_interest( the:in out Interest_account );
procedure add_interest( the:in out Interest_account );
private
DAILY_INTEREST_RATE: CONSTANT Float := 0.00026116; -- 10%
type Interest_account is new Account with record
accumulated_interest : Money := 0.00; -- To date
end record;
the_interest_rate : Float := DAILY_INTEREST_RATE;
end Class_interest_account;
package body Class_interest_account is
procedure set_rate( rate:in Float ) is
begin
the_interest_rate := rate;
end set_rate;
procedure calc_interest( the:in out Interest_account ) is
begin
the.accumulated_interest := the.accumulated_interest +
balance(the) * the_interest_rate;
end calc_interest;
procedure add_interest( the:in out Interest_account ) is
begin
deposit( the, the.accumulated_interest );
the.accumulated_interest := 0.00;
end add_interest;
end Class_interest_account;
-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
with Class_account;
use Class_account;
package Class_account_ltd is
type Account_ltd is new Account with private;
procedure withdraw ( the:in out Account_ltd;
amount:in PMoney; get:out PMoney );
procedure reset( the:in out Account_ltd );
private
WITHDRAWALS_IN_A_WEEK : Natural := 3;
type Account_ltd is new Account with record
withdrawals : Natural := WITHDRAWALS_IN_A_WEEK;
end record;
end Class_account_ltd;
package body Class_account_ltd is
procedure withdraw ( the:in out Account_ltd;
amount:in PMoney; get:out PMoney ) is
begin
if the.withdrawals > 0 then -- Not limit
the.withdrawals := the.withdrawals - 1;
withdraw( Account(the), amount, get ); -- In Account
else
get := 0.00; -- Sorry
end if;
end withdraw;
procedure reset( the:in out Account_ltd ) is
begin
the.withdrawals := WITHDRAWALS_IN_A_WEEK;
end reset;
end Class_account_ltd;
-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
-- Can not have abstract account as now two definitions for PMoney
with Ada.Text_io, Class_account, Class_interest_account,
Class_account_ltd;
use Ada.Text_io, Class_account, Class_interest_account,
Class_account_ltd;
package Pack_procedures is
procedure ex1;
procedure ex2;
procedure ex3;
procedure ex4;
end Pack_procedures;
package body Pack_procedures is
procedure ex1 is
mike : Interest_account;
obtain: Money;
begin
statement( mike );
withdraw( mike, 100.00, obtain ); -- Withdraw some money
statement( mike );
deposit( mike, 300.00 ); -- In credit
statement( mike );
end ex1;
procedure ex2 is
mike : Account_ltd;
obtain: Money;
begin
deposit( mike, 300.00 ); -- In credit
statement( mike );
withdraw( mike, 100.00, obtain ); -- Withdraw some money
withdraw( mike, 10.00, obtain ); -- Withdraw some money
withdraw( mike, 10.00, obtain ); -- Withdraw some money
withdraw( mike, 20.00, obtain ); -- Withdraw some money
statement( mike );
end ex2;
procedure ex3 is
mike : Account_ltd;
obtain: Money;
begin
deposit( mike, 300.00 ); -- In credit
statement( mike );
withdraw( mike, 100.00, obtain ); -- Withdraw some money
statement( mike );
withdraw( mike, 10.00, obtain ); -- Withdraw some money
statement( mike );
withdraw( mike, 10.00, obtain ); -- Withdraw some money
statement( mike );
withdraw( Account(mike), 20.00, obtain ); -- Cheat
statement( mike );
end ex3;
procedure ex4 is
MAX_ACCOUNTS : CONSTANT := 5;
type P_account is access all Account'Class;
type Bank_index is range 1 .. MAX_ACCOUNTS;
subtype Bank_range is Bank_index;
type Bank_array is array ( Bank_range ) of P_account;
procedure print_statement( no:in Bank_range;
a:in Account'Class ) is
begin
put("Account number #");
put( Integer'Image(Integer(no)) ); new_line;
statement( a );
end print_statement;
piggy : Bank_array;
obtained : Money;
begin
piggy(1) := new Account;
piggy(2) := new Account_ltd;
piggy(3) := new Interest_account;
piggy(4) := new Interest_account;
piggy(5) := new Account;
deposit( piggy(1).all, 100.00 ); -- deposit $100 #1
deposit( piggy(3).all, 100.00 ); -- deposit $100 #3
withdraw( piggy(2).all, 50.00, obtained ); -- withdraw $50 #2
withdraw( piggy(4).all, 50.00, obtained ); -- withdraw $50 #4
for i in Bank_range loop
print_statement( i, piggy(i).all );
end loop;
null;
end ex4;
end Pack_procedures;
with Simple_io, Pack_procedures;
use Simple_io, Pack_procedures;
procedure main is
begin
put("Example 1"); new_line; ex1;
put("Example 2"); new_line; ex2;
put("Example 3"); new_line; ex3;
put("Example 4"); new_line; ex4;
end main;
© M.A.Smith University of Brighton.
Created September 1995 last modified May 1997.
Comments, suggestions, etc.
M.A.Smith@brighton.ac.uk
*
[Home page]