From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/cxb/cxb4001.a | 230 ++++++++++++++++++++++++++++ 1 file changed, 230 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cxb/cxb4001.a (limited to 'gcc/testsuite/ada/acats/tests/cxb/cxb4001.a') diff --git a/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a b/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a new file mode 100644 index 000000000..0c9ab1a62 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a @@ -0,0 +1,230 @@ +-- 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; -- cgit v1.2.3