cxacb02.a

来自「linux下编程用 编译软件」· A 代码 · 共 422 行 · 第 1/2 页

-- CXACB02.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.
--*
--
-- OBJECTIVE:
--      Check that user defined subprograms can override the default
--      attributes 'Input and 'Output using attribute definition clauses,
--      when used with objects of discriminated record and multi-dimensional
--      array types.
--
-- TEST DESCRIPTION:
--      This test demonstrates that the default implementations of the
--      'Input and 'Output attributes can be overridden by user specified 
--      subprograms in conjunction with attribute definition clauses.
--      These attributes have been overridden below, and in the user defined
--      substitutes, values are added or subtracted to global variables.
--      Following the completion of the writing/reading test, the global
--      variables are evaluated to ensure that the user defined subprograms
--      were used in overriding the type-related default attributes.
--      
-- APPLICABILITY CRITERIA: 
--      Applicable to all implementations that support external
--      Stream_IO files.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      14 Nov 95   SAIC    Corrected test errors for ACVC 2.0.1.
--
--!

with Report;
with Ada.Streams.Stream_IO;

procedure CXACB02 is
begin

   Report.Test ("CXACB02", "Check that user defined subprograms can "    &
                           "override the default attributes 'Input and " &
                           "'Output using attribute definition clauses");

   Test_for_Stream_IO_Support:
   declare

      Util_File        : Ada.Streams.Stream_IO.File_Type;
      Util_Stream      : Ada.Streams.Stream_IO.Stream_Access;
      Utility_Filename : constant String := Report.Legal_File_Name;

   begin

      -- If an implementation does not support Stream_IO in a particular
      -- environment, the exception Use_Error or Name_Error will be raised on 
      -- calls to various Stream_IO operations.  This block statement 
      -- encloses a call to Create, which should produce an exception in a 
      -- non-supportive environment.  These exceptions will be handled to 
      -- produce a Not_Applicable result.

      Ada.Streams.Stream_IO.Create (Util_File, 
                                    Ada.Streams.Stream_IO.Out_File,
                                    Utility_Filename);

      Operational_Test_Block:
      declare

         type    Customer_Type          is (Residence, Apartment, Commercial);
         type    Electric_Usage_Type    is range 0..100000;
         type    Months_In_Service_Type is range 1..12;
         type    Quarterly_Period_Type  is (Spring, Summer, Autumn, Winter);
         subtype Month_In_Quarter_Type  is Positive range 1..3;
         type    Service_History_Type   is 
           array (Quarterly_Period_Type range <>, 
                  Month_In_Quarter_Type range <>) of Electric_Usage_Type;

         type Service_Type (Customer : Customer_Type) is
            record
               Name       : String (1..21);               
               Account_ID : Natural range 0..100;
               case Customer is
                  when Residence | Apartment =>
                     Low_Income_Credit : Boolean := False;
                  when Commercial            =>
                     Baseline_Allowance : Natural range 0..1000;
                     Quantity_Discount  : Boolean := False;
               end case;
            end record;


         -- Mode conformant, user defined subprograms that will override 
         -- the type-related attributes.
         -- In this test, the user defines these subprograms to add/subtract
         -- specific values from global variables.

         function Service_Input 
           (Stream : access Ada.Streams.Root_Stream_Type'Class) 
           return Service_Type;

         procedure Service_Output 
           (Stream : access Ada.Streams.Root_Stream_Type'Class;
            Item   : Service_Type);

         function History_Input 
           (Stream : access Ada.Streams.Root_Stream_Type'Class)
           return Service_History_Type;

         procedure History_Output
           (Stream : access Ada.Streams.Root_Stream_Type'Class;
            Item   : Service_History_Type);


         -- Attribute definition clauses.

         for Service_Type'Input  use Service_Input;
         for Service_Type'Output use Service_Output;

         for Service_History_Type'Input  use History_Input;
         for Service_History_Type'Output use History_Output;


         -- Object Declarations

         Customer1 : Service_Type (Residence) := 
                       (Residence, "1221 Morningstar Lane", 44, False); 
         Customer2 : Service_Type (Apartment) := 
                       (Customer => Apartment,
                        Account_ID => 67,
                        Name => "15 South Front St. #8",
                        Low_Income_Credit => True);
         Customer3 : Service_Type (Commercial) := 
                       (Commercial,
                        "12442 Central Avenue ", 
                        100, 
                        Baseline_Allowance => 938, 
                        Quantity_Discount  => True);

         C1_Service_History : 
           Service_History_Type (Quarterly_Period_Type, 
                                 Month_In_Quarter_Type) := 
             (Spring => (1 => 35, 2 => 39, 3 => 32),
              Summer => (1 => 34, 2 => 33, 3 => 39),
              Autumn => (1 => 45, 2 => 40, 3 => 38),
              Winter => (1 => 53, 2 =>  0, 3 =>  0));
  
         C2_Service_History : 
           Service_History_Type (Quarterly_Period_Type range Spring..Summer, 
                                 Month_In_Quarter_Type) := 
             (Spring => (23, 22, 0), Summer => (0, 0, 0));

         C3_Service_History :
           Service_History_Type (Quarterly_Period_Type, 
                                 Month_In_Quarter_Type) := 
             (others => (others => 200));

   
         TC_Input_Total  : Integer := 0;
         TC_Output_Total : Integer := 0;


         -- Subprogram bodies.
         -- These subprograms are designed to override the default attributes
         -- 'Input and 'Output for the specified types.  Each adds/subtracts
         -- a quantity to/from a program control variable, indicating its
         -- activity.  Each user defined "Input" function uses the 'Read
         -- attribute for the type to accomplish the operation.  Likewise, 
         -- each user defined "Output" subprogram uses the 'Write attribute 
         -- for the type.

         function Service_Input
           ( Stream : access Ada.Streams.Root_Stream_Type'Class )
           return Service_Type is
            Customer : Customer_Type;
         begin
            TC_Input_Total := TC_Input_Total + 1;

            -- Extract the discriminant value from the stream.
            -- This discriminant would not otherwise be extracted from the
            -- stream when the Service_Type'Read attribute is used below.
            Customer_Type'Read (Stream, Customer);

            declare
               -- Declare a constant of Service_Type, using the value just
               -- read from the stream as the discriminant value of the
               -- object.
               Service : Service_Type(Customer);
            begin
               Service_Type'Read (Stream, Service);
               return Service;
            end;
         end Service_Input;