-- 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;