cxaca02.a

来自「linux下编程用 编译软件」· A 代码 · 共 361 行

-- CXACA02.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 'Read and 'Write using attribute definition clauses.
--      Use objects of record types. 
--
-- TEST DESCRIPTION:
--      This test demonstrates that the default implementations of the
--      'Read and 'Write 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.
--      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
--      21 Nov 95   SAIC    Corrected recursive attribute definitions 
--                          for ACVC 2.0.1.
--      24 Aug 96   SAIC    Corrected typo in test verification criteria.
--
--!

with Report;
with Ada.Streams.Stream_IO;

procedure CXACA02 is
begin

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

   Test_for_Stream_IO_Support:
   declare

      Data_File      : Ada.Streams.Stream_IO.File_Type;
      Data_Stream    : Ada.Streams.Stream_IO.Stream_Access;
      The_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 (Data_File, 
                                    Ada.Streams.Stream_IO.Out_File,
                                    The_Filename);

      Operational_Test_Block:
      declare

         type Origin_Type is (Foreign, Domestic);
         subtype String_Data_Type is String(1..8);

         type Product_Type is
            record
               Item        : String_Data_Type;               
               ID          : Natural range 1..100;
               Manufacture : Origin_Type := Domestic;
               Distributor : String_Data_Type;
               Importer    : String_Data_Type;
            end record;

         type Sales_Record_Type is
            record                                      
               Name              : String_Data_Type;
               Sale_Item         : Boolean := False;
               Buyer             : Origin_Type;
               Quantity_Discount : Boolean;
               Cash_Discount     : Boolean;
            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.

         procedure Product_Read
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : out Product_Type );

         procedure Product_Write
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : Product_Type );

         procedure Sales_Read
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : out Sales_Record_Type );

         procedure Sales_Write
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : Sales_Record_Type );

         -- Attribute definition clauses.

         for Product_Type'Read  use Product_Read;
         for Product_Type'Write use Product_Write;

         for Sales_Record_Type'Read  use Sales_Read;
         for Sales_Record_Type'Write use Sales_Write;


         -- Object Declarations

         Product_01 : Product_Type := 
           ("Product1", 1, Domestic, "Distrib1", "Import 1");
         Product_02 : Product_Type := 
           ("Product2", 2, Foreign,  "Distrib2", "Import 2");

         Sale_Rec_01 : Sales_Record_Type := 
           ("Buyer 01", False, Domestic, True, True);
         Sale_Rec_02 : Sales_Record_Type := 
           ("Buyer 02", True,  Domestic, True, False);
         Sale_Rec_03 : Sales_Record_Type := (Name              => "Buyer 03", 
                                             Sale_Item         => True, 
                                             Buyer             => Foreign,  
                                             Quantity_Discount => False, 
                                             Cash_Discount     => True);
         Sale_Rec_04 : Sales_Record_Type := 
           ("Buyer 04", True,  Foreign,  False, False);
         Sale_Rec_05 : Sales_Record_Type := 
           ("Buyer 05", False, Foreign,  False, False);

         TC_Read_Total  : Integer := 100;
         TC_Write_Total : Integer :=   0;


         -- Subprogram bodies.
         -- These subprograms are designed to override the default attributes
         -- 'Read and 'Write for the specified types.  Each adds/subtracts
         -- a quantity to/from a program control variable, indicating its
         -- activity.   In addition, each component of the record is
         -- individually read from or written to the stream, using the 
         -- appropriate 'Read or 'Write attribute for the component type.
         -- The string components are moved to/from the stream using the
         -- 'Input and 'Output attributes for the string subtype, so that
         -- the bounds of the strings are also written/read.

         procedure Product_Read
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : out Product_Type ) is
         begin
            TC_Read_Total := TC_Read_Total - 10;

            The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1.
            Natural'Read(Data_Stream, The_Item.ID);               -- Field 2.
            Origin_Type'Read(Data_Stream,                         -- Field 3.
                             The_Item.Manufacture);        
            The_Item.Distributor :=                               -- Field 4.
              String_Data_Type'Input(Data_Stream);
            The_Item.Importer    :=                               -- Field 5.  
              String_Data_Type'Input(Data_Stream);
         end Product_Read;


         procedure Product_Write
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : Product_Type ) is
         begin
            TC_Write_Total := TC_Write_Total + 5;

            String_Data_Type'Output(Data_Stream, The_Item.Item);  -- Field 1.
            Natural'Write(Data_Stream, The_Item.ID);              -- Field 2.
            Origin_Type'Write(Data_Stream,                        -- Field 3.
                             The_Item.Manufacture);        
            String_Data_Type'Output(Data_Stream,                  -- Field 4.
                                    The_Item.Distributor);
            String_Data_Type'Output(Data_Stream,                  -- Field 5.
                                    The_Item.Importer);
         end Product_Write;


         procedure Sales_Read
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : out Sales_Record_Type ) is
         begin
            TC_Read_Total := TC_Read_Total - 20;

            The_Item.Name := String_Data_Type'Input(Data_Stream);  -- Field 1.
            Boolean'Read(Data_Stream, The_Item.Sale_Item);         -- Field 2.
            Origin_Type'Read(Data_Stream, The_Item.Buyer);         -- Field 3.
            Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
            Boolean'Read(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
         end Sales_Read;


         procedure Sales_Write
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
             The_Item : Sales_Record_Type ) is
         begin
            TC_Write_Total := TC_Write_Total + 10;

            String_Data_Type'Output(Data_Stream, The_Item.Name);    -- Field 1.
            Boolean'Write(Data_Stream, The_Item.Sale_Item);         -- Field 2.
            Origin_Type'Write(Data_Stream, The_Item.Buyer);         -- Field 3.
            Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
            Boolean'Write(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
         end Sales_Write;



      begin

         Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File);

         -- Write product and sales data to the stream.

         Product_Type'Write      (Data_Stream, Product_01);
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_01);
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_02);

         Product_Type'Write      (Data_Stream, Product_02);
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_03);
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_04);
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_05);

         -- Read data from the stream, and verify the use of the user specified
         -- attributes.

         Verify_Data_Block:
         declare

            TC_Product1,
            TC_Product2 : Product_Type;

            TC_Sale1, 
            TC_Sale2,
            TC_Sale3,
            TC_Sale4,
            TC_Sale5    : Sales_Record_Type;

         begin

            -- Reset the mode of the stream file so that Read/Input
            -- operations may be performed.

            Ada.Streams.Stream_IO.Reset (Data_File, 
                                         Ada.Streams.Stream_IO.In_File);

            -- Data is read/reconstructed from the stream, in the order that
            -- the data was placed into the stream.

            Product_Type'Read      (Data_Stream, TC_Product1);
            Sales_Record_Type'Read (Data_Stream, TC_Sale1);
            Sales_Record_Type'Read (Data_Stream, TC_Sale2);

            Product_Type'Read      (Data_Stream, TC_Product2);
            Sales_Record_Type'Read (Data_Stream, TC_Sale3);
            Sales_Record_Type'Read (Data_Stream, TC_Sale4);
            Sales_Record_Type'Read (Data_Stream, TC_Sale5);

            -- Verify product data was correctly written to/read from stream.

            if TC_Product1 /= Product_01 then
               Report.Failed ("Data verification error, Product 1");
            end if;
            if TC_Product2 /= Product_02 then
               Report.Failed ("Data verification error, Product 2");
            end if;

            if TC_Sale1 /= Sale_Rec_01 then
               Report.Failed ("Data verification error, Sale_Rec_01");
            end if;
            if TC_Sale2 /= Sale_Rec_02 then
               Report.Failed ("Data verification error, Sale_Rec_02");
            end if;
            if TC_Sale3 /= Sale_Rec_03 then
               Report.Failed ("Data verification error, Sale_Rec_03");
            end if;
            if TC_Sale4 /= Sale_Rec_04 then
               Report.Failed ("Data verification error, Sale_Rec_04");
            end if;
            if TC_Sale5 /= Sale_Rec_05 then
               Report.Failed ("Data verification error, Sale_Rec_05");
            end if;

            -- Verify that the user defined subprograms were used to
            -- override the default 'Read and 'Write attributes.
            -- There were two "product" reads and two writes; there 
            -- were five "sale record" reads and five writes.
            
            if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then
               Report.Failed ("Incorrect use of user defined attributes");
            end if;

         end Verify_Data_Block;

      exception

         when others => 
            Report.Failed ("Exception raised in Operational Test Block");
      
      end Operational_Test_Block;

      if Ada.Streams.Stream_IO.Is_Open (Data_File) then
         Ada.Streams.Stream_IO.Delete (Data_File);
      else
         Ada.Streams.Stream_IO.Open (Data_File,
                                     Ada.Streams.Stream_IO.Out_File, 
                                     The_Filename);
         Ada.Streams.Stream_IO.Delete (Data_File);
      end if;


   exception

      -- Since Use_Error or Name_Error can be raised if, for the specified
      -- mode, the environment does not support Stream_IO operations,
      -- the following handlers are included:

      when Ada.Streams.Stream_IO.Name_Error =>
         Report.Not_Applicable ("Name_Error raised on Stream IO Create");

      when Ada.Streams.Stream_IO.Use_Error  =>
         Report.Not_Applicable ("Use_Error raised on Stream IO Create");

      when others                           =>
         Report.Failed ("Unexpected exception raised");

   end Test_for_Stream_IO_Support;

   Report.Result;

end CXACA02;