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