Subversion Repositories openrisc_2011-10-31

-- CXB4001.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 the specifications of the package Interfaces.COBOL
--      are available for use
--
-- TEST DESCRIPTION: 
--      This test verifies that the type and the subprograms specified for
--      the interface are present.
--
-- APPLICABILITY CRITERIA: 
--      This test is applicable to all implementations that provide 
--      package Interfaces.COBOL.  If an implementation provides
--      package Interfaces.COBOL, this test must compile, execute, and 
--      report "PASSED".
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      15 Nov 95   SAIC    Corrected visibility errors for ACVC 2.0.1.
--      28 Feb 96   SAIC    Added applicability criteria.
--      27 Oct 96   SAIC    Incorporated reviewer comments.
--      01 DEC 97   EDS     Change "To_Comp" to "To_Binary".
--!

with Report;
with Interfaces.COBOL;                                        -- N/A => ERROR

procedure CXB4001 is

   package COBOL renames Interfaces.COBOL;
   use type COBOL.Byte;
   use type COBOL.Decimal_Element;

begin

   Report.Test ("CXB4001", "Check the specification of Interfaces.COBOL");


   declare  -- encapsulate the test

      --  Types and operations for internal data representations
 
      TST_Floating : COBOL.Floating;
      TST_Long_Floating : COBOL.Long_Floating;

      TST_Binary        : COBOL.Binary;
      TST_Long_Binary   : COBOL.Long_Binary;

      TST_Max_Digits_Binary      : constant := COBOL.Max_Digits_Binary; 
      TST_Max_Digits_Long_Binary : constant := COBOL.Max_Digits_Long_Binary;

      TST_Decimal_Element : COBOL.Decimal_Element;

      TST_Packed_Decimal : COBOL.Packed_Decimal (1..5) := 
                                    (others => COBOL.Decimal_Element'First);

      --  initialize it so it can reasonably be used later
      TST_COBOL_Character : COBOL.COBOL_Character :=
                                                COBOL.COBOL_Character'First;

      TST_Ada_To_COBOL : COBOL.COBOL_Character :=  
                                          COBOL.Ada_To_COBOL (Character'First);

      TST_COBOL_To_Ada : Character :=  
                              COBOL.COBOL_To_Ada (COBOL.COBOL_Character'First);

      --  assignment to make sure it is an array of  COBOL_Character
      TST_Alphanumeric : COBOL.Alphanumeric (1..5) := 
                                             (others => TST_COBOL_Character);

        
      --  assignment to make sure it is an array of  COBOL_Character
      TST_Numeric : COBOL.Numeric (1..5) := (others => TST_COBOL_Character);


      procedure Collect_All_Calls is

         CAC_Alphanumeric : COBOL.Alphanumeric(1..5) :=
                              COBOL.To_COBOL("abcde");
         CAC_String       : String (1..5) := "vwxyz";
         CAC_Natural      : natural       := 0;

      begin
   
         CAC_Alphanumeric := COBOL.To_COBOL (CAC_String);
         CAC_String := COBOL.To_Ada  (CAC_Alphanumeric);

         COBOL.To_COBOL (CAC_String, CAC_Alphanumeric, CAC_Natural);
         COBOL.To_Ada (CAC_Alphanumeric, CAC_String, CAC_Natural);

         raise COBOL.Conversion_Error;

      end Collect_All_Calls;



      --  Formats for COBOL data representations

      TST_Unsigned   : COBOL.Display_Format := COBOL.Unsigned;
      TST_Leading_Separate : COBOL.Display_Format := COBOL.Leading_Separate;
      TST_Trailing_Separate : COBOL.Display_Format := COBOL.Trailing_Separate;
      TST_Leading_Nonseparate  : COBOL.Display_Format :=  
                                                   COBOL.Leading_Nonseparate;
      TST_Trailing_Nonseparate : COBOL.Display_Format :=  
                                                   COBOL.Trailing_Nonseparate;


      TST_High_Order_First  : COBOL.Binary_Format := COBOL.High_Order_First;
      TST_Low_Order_First   : COBOL.Binary_Format := COBOL.Low_Order_First;
      TST_Native_Binary     : COBOL.Binary_Format := COBOL.Native_Binary;


      TST_Packed_Unsigned   : COBOL.Packed_Format := COBOL.Packed_Unsigned;
      TST_Packed_Signed     : COBOL.Packed_Format := COBOL.Packed_Signed;


      --  Types for external representation of COBOL binary data

      TST_Byte_Array : COBOL.Byte_Array(1..5) := (others => COBOL.Byte'First);

      -- Now instantiate one version of the generic
      --
      type bx4001_Decimal is delta 0.1 digits 5;
      package bx4001_conv is new COBOL.Decimal_Conversions (bx4001_Decimal);

      procedure Collect_All_Generic_Calls is
         CAGC_natural        : natural;
         CAGC_Display_Format : COBOL.Display_Format;
         CAGC_Boolean        : Boolean;
         CAGC_Numeric        : COBOL.Numeric(1..5);
         CAGC_Num            : bx4001_Decimal;
         CAGC_Packed_Decimal : COBOL.Packed_Decimal (1..5);
         CAGC_Packed_Format  : COBOL.Packed_Format; 
         CAGC_Byte_Array     : COBOL.Byte_Array (1..5);
         CAGC_Binary_Format  : COBOL.Binary_Format;
         CAGC_Binary         : COBOL.Binary;
         CAGC_Long_Binary    : COBOL.Long_Binary;
      begin

         --  Display Formats: data values are represented as Numeric
         
         CAGC_Boolean := bx4001_conv.Valid (CAGC_Numeric, CAGC_Display_Format);
         CAGC_Natural := bx4001_conv.Length (CAGC_Display_Format);

         CAGC_Num := bx4001_conv.To_Decimal 
                                       (CAGC_Numeric, CAGC_Display_Format);
         CAGC_Numeric := bx4001_conv.To_Display 
                                       (CAGC_Num, CAGC_Display_Format);


         --  Packed Formats: data values are represented as Packed_Decimal
         
         CAGC_Boolean := bx4001_conv.Valid 
                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);

         CAGC_Natural := bx4001_conv.Length (CAGC_Packed_Format);

         CAGC_Num := bx4001_conv.To_Decimal 
                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);

         CAGC_Packed_Decimal := bx4001_conv.To_Packed 
                                    (CAGC_Num, CAGC_Packed_Format);


         --  Binary Formats: external data values are represented as 
         --  Byte_Array

         CAGC_Boolean := bx4001_conv.Valid 
                                    (CAGC_Byte_Array, CAGC_Binary_Format);
         
         CAGC_Natural := bx4001_conv.Length (CAGC_Binary_Format);
         CAGC_Num := bx4001_conv.To_Decimal 
                                    (CAGC_Byte_Array, CAGC_Binary_Format);

         CAGC_Byte_Array := bx4001_conv.To_Binary (CAGC_Num, CAGC_Binary_Format);


         --  Internal Binary formats: data values are of type 
         --  Binary/Long_Binary

         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Binary);
         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Long_Binary);

         CAGC_Binary       := bx4001_conv.To_Binary (CAGC_Num);
         CAGC_Long_Binary  := bx4001_conv.To_Long_Binary (CAGC_Num);
         

      end Collect_All_Generic_Calls;


   begin    -- encapsulation

      if COBOL.Byte'First /= 0     or
         COBOL.Byte'Last  /=  (2 ** COBOL.COBOL_Character'Size) - 1 then
            Report.Failed ("Byte is incorrectly defined");
      end if;

      if  COBOL.Decimal_Element'First /= 0 then
         Report.Failed ("Decimal_Element is incorrectly defined");
      end if;

   end;     -- encapsulation

   Report.Result;

end CXB4001;