diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/support/f392a00.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/support/f392a00.a | 200 |
1 files changed, 0 insertions, 200 deletions
diff --git a/gcc/testsuite/ada/acats/support/f392a00.a b/gcc/testsuite/ada/acats/support/f392a00.a deleted file mode 100644 index 2d4f7a55aec..00000000000 --- a/gcc/testsuite/ada/acats/support/f392a00.a +++ /dev/null @@ -1,200 +0,0 @@ --- F392A00.A --- --- Grant of Unlimited Rights --- --- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, --- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained --- unlimited rights in the software and documentation contained herein. --- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making --- this public release, the Government intends to confer upon all --- recipients unlimited rights equal to those held by the Government. --- These rights include rights to use, duplicate, release or disclose the --- released technical data and computer software in whole or in part, in --- any manner and for any purpose whatsoever, and to have or permit others --- to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- FOUNDATION DESCRIPTION: --- This foundation provides a basis for tests needing a hierarchy of --- types to check object-oriented features. --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package F392A00 is -- package Accounts - - -- - -- Types and subtypes. - -- - - type Dollar_Amount is new Float; - type Interest_Rate is delta 0.001 range 0.000 .. 1.000; - type Account_Types is (Bank, Savings, Preferred, Total); - type Account_Counter is array (Account_Types) of Integer; - type Account_Rep is (President, Manager, New_Account_Manager, Teller); - - -- - -- Constants. - -- - - Opening_Balance : constant Dollar_Amount := 100.00; - Current_Rate : constant Interest_Rate := 0.030; - Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00; - - -- - -- Global Variables - -- - - Bank_Reserve : Dollar_Amount := 0.00; - Daily_Representative : Account_Rep := New_Account_Manager; - Number_Of_Accounts : Account_Counter := (Bank => 0, - Savings => 0, - Preferred => 0, - Total => 0); - -- - -- Account types and their primitive operations. - -- - - -- Root type. - - type Bank_Account is tagged - record - Balance : Dollar_Amount; - end record; - - -- Primitive operations of Bank_Account. - - procedure Increment_Bank_Reserve (Acct : in Bank_Account); - procedure Assign_Representative (Acct : in Bank_Account); - procedure Increment_Counters (Acct : in Bank_Account); - procedure Open (Acct : in out Bank_Account); - - -- - - type Savings_Account is new Bank_Account with - record - Rate : Interest_Rate; - end record; - - -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account). - - -- Primitive operations (Overridden). - procedure Assign_Representative (Acct : in Savings_Account); - procedure Increment_Counters (Acct : in Savings_Account); - procedure Open (Acct : in out Savings_Account); - - -- - - type Preferred_Account is new Savings_Account with - record - Minimum_Balance : Dollar_Amount; - end record; - - -- Procedure Increment_Bank_Reserve inherited twice. - -- Procedure Assign_Representative inherited from parent (Savings_Account). - - -- Primitive operations (Overridden). - procedure Increment_Counters (Acct : in Preferred_Account); - procedure Open (Acct : in out Preferred_Account); - - -- Function used to verify Open operation for Preferred_Account objects. - function Verify_Open (Acct : in Preferred_Account) return Boolean; - - -end F392A00; - - - --=================================================================-- - - -package body F392A00 is - - -- - -- Primitive operations for Bank_Account. - -- - - procedure Increment_Bank_Reserve (Acct : in Bank_Account) is - begin - Bank_Reserve := Bank_Reserve + Acct.Balance; - end Increment_Bank_Reserve; - - procedure Assign_Representative (Acct : in Bank_Account) is - begin - Daily_Representative := Teller; - end Assign_Representative; - - procedure Increment_Counters (Acct : in Bank_Account) is - begin - Number_Of_Accounts (Bank) := Number_Of_Accounts (Bank) + 1; - Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; - end Increment_Counters; - - procedure Open (Acct : in out Bank_Account) is - begin - Acct.Balance := Opening_Balance; - end Open; - - - -- - -- Overridden operations for Savings_Account type. - -- - - procedure Assign_Representative (Acct : in Savings_Account) is - begin - Daily_Representative := Manager; - end Assign_Representative; - - procedure Increment_Counters (Acct : in Savings_Account) is - begin - Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1; - Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; - end Increment_Counters; - - procedure Open (Acct : in out Savings_Account) is - begin - Open (Bank_Account(Acct)); - Acct.Rate := Current_Rate; - Acct.Balance := 2.0 * Opening_Balance; - end Open; - - - -- - -- Overridden operation for Preferred_Account type. - -- - - procedure Increment_Counters (Acct : in Preferred_Account) is - begin - Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1; - Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; - end Increment_Counters; - - procedure Open (Acct : in out Preferred_Account) is - begin - Open (Savings_Account(Acct)); - Acct.Minimum_Balance := Preferred_Minimum_Balance; - Acct.Balance := Acct.Minimum_Balance; - end Open; - - -- - -- Function used to verify Open operation for Preferred_Account objects. - -- - - function Verify_Open (Acct : in Preferred_Account) return Boolean is - begin - return (Acct.Balance = Preferred_Minimum_Balance and - Acct.Rate = Current_Rate and - Acct.Minimum_Balance = Preferred_Minimum_Balance); - end Verify_Open; - -end F392A00; |