diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxf')
20 files changed, 6661 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a b/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a new file mode 100644 index 000000000..be7e50692 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a @@ -0,0 +1,261 @@ +-- CXF1001.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 values of 2 and 10 are allowable values for Machine_Radix +-- of a decimal first subtype. +-- Check that the value of Decimal.Max_Decimal_Digits is at least 18; +-- the value of Decimal.Max_Scale is at least 18; the value of +-- Decimal.Min_Scale is at most 0. +-- +-- TEST DESCRIPTION: +-- This test examines the Machine_Radix attribute definition clause +-- and its effect on Decimal fixed point types, as well as several +-- constants from the package Ada.Decimal. +-- The first subtest checks that the Machine_Radix attribute will +-- return the value set for Machine_Radix by an attribute definition +-- clause. The second and third subtests examine differences between +-- the binary and decimal scaling of a type, based on the radix +-- representation. The final subtest examines the values +-- assigned to constants Min_Scale, Max_Scale, and Max_Decimal_Digits, +-- found in the package Ada.Decimal. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 29 Dec 94 SAIC Restructured Radix 10 and Radix 2 test blocks. +-- +--! + +with Report; +with Ada.Decimal; + +procedure CXF1001 is +begin + + Report.Test ("CXF1001", "Check that values of 2 and 10 are allowable " & + "values for Machine_Radix of a decimal first " & + "subtype. Check that the value of " & + "Decimal.Max_Decimal_Digits is at least 18; " & + "the value of Decimal.Max_Scale is at least " & + "18; the value of Decimal.Min_Scale is at " & + "most 0"); + + Attribute_Check_Block: + declare + + Del : constant := 1.0/10**2; + Const_Digits : constant := 3; + Two : constant := 2; + Ten : constant := 10; + + type Radix_2_Type_1 is delta 0.01 digits 7; + type Radix_2_Type_2 is delta Ada.Decimal.Min_Delta digits 10; + type Radix_2_Type_3 is + delta 0.000_1 digits Ada.Decimal.Max_Decimal_Digits; + + type Radix_10_Type_1 is delta 10.0**(-Ada.Decimal.Max_Scale) digits 8; + type Radix_10_Type_2 is delta 10.0**(-Ada.Decimal.Min_Scale) digits 6; + type Radix_10_Type_3 is delta Ada.Decimal.Max_Delta digits 15; + + + -- Use an attribute definition clause to set the Machine_Radix for a + -- decimal first subtype to either 2 or 10. + for Radix_2_Type_1'Machine_Radix use 2; + for Radix_2_Type_2'Machine_Radix use Two; + for Radix_2_Type_3'Machine_Radix use 10-8; + + for Radix_10_Type_1'Machine_Radix use 2*15/Const_Digits; + for Radix_10_Type_2'Machine_Radix use Ten; + for Radix_10_Type_3'Machine_Radix use Radix_10_Type_2'Machine_Radix; + + + begin + + -- Check that the attribute 'Machine_Radix returns the value assigned + -- by the attribute definition clause. + + if Radix_2_Type_1'Machine_Radix /= 2 or else + Radix_2_Type_2'Machine_Radix /= 2 or else + Radix_2_Type_3'Machine_Radix /= 2 + then + Report.Failed("Incorrect radix value returned, 2 expected"); + end if; + + if Radix_10_Type_1'Machine_Radix /= 10 or else + Radix_10_Type_2'Machine_Radix /= 10 or else + Radix_10_Type_3'Machine_Radix /= 10 + then + Report.Failed("Incorrect radix value returned, 10 expected"); + end if; + + exception + when others => Report.Failed ("Exception raised in Attr_Check_Block"); + end Attribute_Check_Block; + + + + Radix_Block: + -- Premises: + -- 1) Choose several numbers, from types using either decimal scaling or + -- binary scaling. + -- 1) Repetitively add these numbers to themselves. + -- 3) Validate that the result is the expected result, regardless of the + -- scaling used in the definition of the type. + declare + + Number_Of_Values : constant := 3; + Loop_Count : constant := 1000; + + type Radix_2_Type is delta 0.0001 digits 10; + type Radix_10_Type is delta 0.0001 digits 10; + + for Radix_2_Type'Machine_Radix use 2; + for Radix_10_Type'Machine_Radix use 10; + + type Result_Record_Type is record + Rad_2 : Radix_2_Type; + Rad_10 : Radix_10_Type; + end record; + + type Result_Array_Type is array (1..Number_Of_Values) + of Result_Record_Type; + + Result_Array : Result_Array_Type := ((50.00, 50.00), + (613.00, 613.00), + (72.70, 72.70)); + + function Repetitive_Radix_2_Add (Value : in Radix_2_Type) + return Radix_2_Type is + Result : Radix_2_Type := 0.0; + begin + for i in 1..Loop_Count loop + Result := Result + Value; + end loop; + return Result; + end Repetitive_Radix_2_Add; + + function Repetitive_Radix_10_Add (Value : in Radix_10_Type) + return Radix_10_Type is + Result : Radix_10_Type := 0.0; + begin + for i in 1..Loop_Count loop + Result := Result + Value; + end loop; + return Result; + end Repetitive_Radix_10_Add; + + begin + + -- Radix 2 Cases, three different values. + -- Compare the result of the repetitive addition with the expected + -- Radix 2 result, as well as with the Radix 10 value after type + -- conversion. + + if Repetitive_Radix_2_Add(0.05) /= Result_Array(1).Rad_2 or + Repetitive_Radix_2_Add(0.05) /= Radix_2_Type(Result_Array(1).Rad_10) + then + Report.Failed("Incorrect Radix 2 Result, Case 1"); + end if; + + if Repetitive_Radix_2_Add(0.613) /= + Result_Array(2).Rad_2 or + Repetitive_Radix_2_Add(0.613) /= + Radix_2_Type(Result_Array(2).Rad_10) + then + Report.Failed("Incorrect Radix 2 Result, Case 2"); + end if; + + if Repetitive_Radix_2_Add(0.0727) /= + Result_Array(3).Rad_2 or + Repetitive_Radix_2_Add(0.0727) /= + Radix_2_Type(Result_Array(3).Rad_10) + then + Report.Failed("Incorrect Radix 2 Result, Case 3"); + end if; + + -- Radix 10 Cases, three different values. + -- Compare the result of the repetitive addition with the expected + -- Radix 10 result, as well as with the Radix 2 value after type + -- conversion. + + if Repetitive_Radix_10_Add(0.05) /= Result_Array(1).Rad_10 or + Repetitive_Radix_10_Add(0.05) /= Radix_10_Type(Result_Array(1).Rad_2) + then + Report.Failed("Incorrect Radix 10 Result, Case 1"); + end if; + + if Repetitive_Radix_10_Add(0.613) /= + Result_Array(2).Rad_10 or + Repetitive_Radix_10_Add(0.613) /= + Radix_10_Type(Result_Array(2).Rad_2) + then + Report.Failed("Incorrect Radix 10 Result, Case 2"); + end if; + + if Repetitive_Radix_10_Add(0.0727) /= + Result_Array(3).Rad_10 or + Repetitive_Radix_10_Add(0.0727) /= + Radix_10_Type(Result_Array(3).Rad_2) + then + Report.Failed("Incorrect Radix 10 Result, Case 3"); + end if; + + exception + when others => Report.Failed ("Exception raised in Radix_Block"); + end Radix_Block; + + + + Size_Block: + -- Check the implementation max/min values of constants declared in + -- package Ada.Decimal. + declare + Minimum_Required_Size : constant := 18; + Maximum_Allowed_Size : constant := 0; + begin + + -- Check that the Max_Decimal_Digits value is at least 18. + if not (Ada.Decimal.Max_Decimal_Digits >= Minimum_Required_Size) then + Report.Failed("Insufficient size provided for Max_Decimal_Digits"); + end if; + + -- Check that the Max_Scale value is at least 18. + if not (Ada.Decimal.Max_Scale >= Minimum_Required_Size) then + Report.Failed("Insufficient size provided for Max_Scale"); + end if; + + -- Check that the Min_Scale value is at most 0. + if not (Ada.Decimal.Min_Scale <= Maximum_Allowed_Size) then + Report.Failed("Too large a value provided for Min_Scale"); + end if; + + exception + when others => Report.Failed ("Exception raised in Size_Block"); + end Size_Block; + + Report.Result; + +end CXF1001; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a new file mode 100644 index 000000000..96d0a0a17 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a @@ -0,0 +1,755 @@ +-- CXF2001.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 Divide procedure provides the following results: +-- Quotient = Dividend divided by Divisor and +-- Remainder = Dividend - (Divisor * Quotient) +-- Check that the Remainder is calculated exactly. +-- +-- TEST DESCRIPTION: +-- This test is designed to test the generic procedure Divide found in +-- package Ada.Decimal. +-- +-- The table below attempts to portray the design approach used in this +-- test. There are three "dimensions" of concern: +-- 1) the delta value of the Quotient and Remainder types, shown as +-- column headers, +-- 2) specific choices for the Dividend and Divisor numerical values +-- (i.e., whether they yielded a repeating/non-terminating result, +-- or a terminating result ["exact"]), displayed on the left side +-- of the tables, and +-- 3) the delta for the Dividend and Divisor. +-- +-- Each row in the tables indicates a specific test case, showing the +-- specific quotient and remainder (under the appropriate Delta column) +-- for each combination of dividend and divisor values. Test cases +-- follow the top-to-bottom sequence shown in the tables. +-- +-- Most of the test case sets (same dividend/divisor combinations - +-- indicated by dashed horizontal lines in the tables) vary the +-- delta of the quotient and remainder types between test cases. This +-- allows for an examination of how different deltas for a quotient +-- and/or remainder type can influence the results of a division with +-- identical dividend and divisor. +-- +-- Note: Test cases are performed for both Radix 10 and Radix 2 types. +-- +-- +-- Divid Divis Delta Delta Delta Delta Delta +-- (Delta)(Delta)| .1 | .01 | .001 | .0001 | .00001 |Test +-- |---|---|-----|-----|-----|-----|-----|-----|-----|-----|Case +-- quotient | Q | R | Q | R | Q | R | Q | R | Q | R | No. +-- --------------------------------------------------------------------------- +-- .05 .3 |.1 .02 1,21 +-- (.01) (.1) |.1 0 2,22 +-- | .16 .002 3,23 +-- 0.166666.. | .16 .00 4,24 +-- | .166 .0002 5,25 +-- --------------------------------------------------------------------------- +-- .15 20 | .00 .1500 6,26 +-- (.01) (1) | .00 .150 7,27 +-- | .00 .15 8,28 +-- 0.0075 | .01 .007 9,29 +-- | .007 .010 10,30 +-- | .0075 .0000 11,31 +-- --------------------------------------------------------------------------- +-- .03125 .5 | .0625 .0000 12,32 +-- (.00001) (.1) | .062 .00025 13,33 +-- | .062 .0002 14,34 +-- 0.0625 | .062 .000 15,35 +-- | .00 .062 16,36 +-- | .06 .00125 17,37 +-- | .06 .0012 18,38 +-- | .06 .001 19,39 +-- | .06 .00 20,40 +-- --------------------------------------------------------------------------- +-- Divide by Zero| Raise Constraint_Error 41 +-- --------------------------------------------------------------------------- +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 29 Dec 94 SAIC Modified Radix 2 cases to match Radix 10 cases. +-- 03 Oct 95 RBKD Modified to fix incorrect remainder results +-- 15 Nov 95 SAIC Incorporated reviewer fixes for ACVC 2.0.1. +-- +--! + +with Report; +with Ada.Decimal; + +procedure CXF2001 is + + TC_Verbose : Boolean := False; + +begin + + Report.Test ("CXF2001", "Check that the Divide procedure provides " & + "correct results. Check that the Remainder " & + "is calculated exactly"); + Radix_10_Block: + declare + + + -- Declare all types and variables used in the various blocks below + -- for all Radix 10 evaluations. + + type DT_1 is delta 1.0 digits 5; + type DT_0_1 is delta 0.1 digits 10; + type DT_0_01 is delta 0.01 digits 10; + type DT_0_001 is delta 0.001 digits 10; + type DT_0_0001 is delta 0.0001 digits 10; + type DT_0_00001 is delta 0.00001 digits 10; + + for DT_1'Machine_Radix use 10; + for DT_0_1'Machine_Radix use 10; + for DT_0_01'Machine_Radix use 10; + for DT_0_001'Machine_Radix use 10; + for DT_0_0001'Machine_Radix use 10; + for DT_0_00001'Machine_Radix use 10; + + Dd_1, Dv_1, Quot_1, Rem_1 : DT_1 := 0.0; + Dd_0_1, Dv_0_1, Quot_0_1, Rem_0_1 : DT_0_1 := 0.0; + Dd_0_01, Dv_0_01, Quot_0_01, Rem_0_01 : DT_0_01 := 0.0; + Dd_0_001, Dv_0_001, Quot_0_001, Rem_0_001 : DT_0_001 := 0.0; + Dd_0_0001, Dv_0_0001, Quot_0_0001, Rem_0_0001 : DT_0_0001 := 0.0; + Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0; + + begin + + + declare + procedure Div is + new Ada.Decimal.Divide(Dividend_Type => DT_0_01, + Divisor_Type => DT_0_1, + Quotient_Type => DT_0_1, + Remainder_Type => DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 1"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01); + if Quot_0_1 /= DT_0_1(0.1) or Rem_0_01 /= DT_0_01(0.02) then + Report.Failed("Incorrect values returned, Case 1"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1); + begin + if TC_Verbose then Report.Comment("Case 2"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1); + if Quot_0_1 /= DT_0_1(0.1) or Rem_0_1 /= DT_0_1(0.0) then + Report.Failed("Incorrect values returned, Case 2"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 3"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.16) or Rem_0_001 /= DT_0_001(0.002) then + Report.Failed("Incorrect values returned, Case 3"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 4"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.16) or Rem_0_01 /= DT_0_01(0.0) then + Report.Failed("Incorrect values returned, Case 4"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 5"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001); + if Quot_0_001 /= DT_0_001(0.166) or + Rem_0_0001 /= DT_0_0001(0.0002) + then + Report.Failed("Incorrect values returned, Case 5"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 6"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then + Report.Failed("Incorrect values returned, Case 6"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 7"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then + Report.Failed("Incorrect values returned, Case 7"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 8"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then + Report.Failed("Incorrect values returned, Case 8"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 9"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001); + if Quot_0_001 /= DT_0_001(0.007) or Rem_0_001 /= DT_0_001(0.01) then + Report.Failed("Incorrect values returned, Case 9"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 10"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01); + if Quot_0_001 /= DT_0_001(0.007) or Rem_0_01 /= DT_0_01(0.01) then + Report.Failed("Incorrect values returned, Case 10"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 11"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001); + if Quot_0_0001 /= DT_0_0001(0.0075) or + Rem_0_0001 /= DT_0_0001(0.0) + then + Report.Failed("Incorrect values returned, Case 11"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 12"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001); + if Quot_0_0001 /= DT_0_0001(0.0625) or + Rem_0_0001 /= DT_0_0001(0.0) + then + Report.Failed("Incorrect values returned, Case 12"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001); + begin + if TC_Verbose then Report.Comment("Case 13"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001); + if Quot_0_001 /= DT_0_001(0.062) or + Rem_0_00001 /= DT_0_00001(0.00025) + then + Report.Failed("Incorrect values returned, Case 13"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 14"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001); + if Quot_0_001 /= DT_0_001(0.062) or + Rem_0_0001 /= DT_0_0001(0.0002) + then + Report.Failed("Incorrect values returned, Case 14"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 15"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001); + if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000) + then + Report.Failed("Incorrect values returned, Case 15"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 16"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01); + if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then + Report.Failed("Incorrect values returned, Case 16"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001); + begin + if TC_Verbose then Report.Comment("Case 17"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125) + then + Report.Failed("Incorrect values returned, Case 17"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 18"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012) + then + Report.Failed("Incorrect values returned, Case 18"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 19"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then + Report.Failed("Incorrect values returned, Case 19"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 20"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then + Report.Failed("Incorrect values returned, Case 20"); + end if; + end; + + + exception + when others => Report.Failed("Exception raised in Radix_10_Block"); + end Radix_10_Block; + + + + Radix_2_Block: + declare + + -- Declare all types and variables used in the various blocks below + -- for all Radix 2 evaluations. + + type DT_1 is delta 1.0 digits 5; + type DT_0_1 is delta 0.1 digits 10; + type DT_0_01 is delta 0.01 digits 10; + type DT_0_001 is delta 0.001 digits 10; + type DT_0_0001 is delta 0.0001 digits 10; + type DT_0_00001 is delta 0.00001 digits 10; + + for DT_1'Machine_Radix use 2; + for DT_0_1'Machine_Radix use 2; + for DT_0_01'Machine_Radix use 2; + for DT_0_001'Machine_Radix use 2; + for DT_0_0001'Machine_Radix use 2; + for DT_0_00001'Machine_Radix use 2; + + Dd_1, Dv_1, Quot_1, Rem_1 : DT_1 := 0.0; + Dd_0_1, Dv_0_1, Quot_0_1, Rem_0_1 : DT_0_1 := 0.0; + Dd_0_01, Dv_0_01, Quot_0_01, Rem_0_01 : DT_0_01 := 0.0; + Dd_0_001, Dv_0_001, Quot_0_001, Rem_0_001 : DT_0_001 := 0.0; + Dd_0_0001, Dv_0_0001, Quot_0_0001, Rem_0_0001 : DT_0_0001 := 0.0; + Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0; + + begin + + + declare + procedure Div is + new Ada.Decimal.Divide(Dividend_Type => DT_0_01, + Divisor_Type => DT_0_1, + Quotient_Type => DT_0_1, + Remainder_Type => DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 21"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01); + if Quot_0_1 /= DT_0_1(0.1) or Rem_0_01 /= DT_0_01(0.02) then + Report.Failed("Incorrect values returned, Case 21"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1); + begin + if TC_Verbose then Report.Comment("Case 22"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1); + if Quot_0_1 /= DT_0_1(0.1) or Rem_0_1 /= DT_0_1(0.0) then + Report.Failed("Incorrect values returned, Case 22"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 23"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.16) or Rem_0_001 /= DT_0_001(0.002) then + Report.Failed("Incorrect values returned, Case 23"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 24"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.16) or Rem_0_01 /= DT_0_01(0.0) then + Report.Failed("Incorrect values returned, Case 24"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 25"); end if; + Dd_0_01 := DT_0_01(0.05); Dv_0_1 := DT_0_1(0.3); + Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001); + if Quot_0_001 /= DT_0_001(0.166) or + Rem_0_0001 /= DT_0_0001(0.0002) + then + Report.Failed("Incorrect values returned, Case 25"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 26"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then + Report.Failed("Incorrect values returned, Case 26"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 27"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then + Report.Failed("Incorrect values returned, Case 27"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 28"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then + Report.Failed("Incorrect values returned, Case 28"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 29"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001); + if Quot_0_001 /= DT_0_001(0.007) or Rem_0_001 /= DT_0_001(0.01) then + Report.Failed("Incorrect values returned, Case 29"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 30"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01); + if Quot_0_001 /= DT_0_001(0.007) or Rem_0_01 /= DT_0_01(0.01) then + Report.Failed("Incorrect values returned, Case 30"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 31"); end if; + Dd_0_01 := DT_0_01(0.15); Dv_1 := DT_1(20); + Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001); + if Quot_0_0001 /= DT_0_0001(0.0075) or + Rem_0_0001 /= DT_0_0001(0.0) + then + Report.Failed("Incorrect values returned, Case 31"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 32"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001); + if Quot_0_0001 /= DT_0_0001(0.0625) or + Rem_0_0001 /= DT_0_0001(0.0) + then + Report.Failed("Incorrect values returned, Case 32"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001); + begin + if TC_Verbose then Report.Comment("Case 33"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001); + if Quot_0_001 /= DT_0_001(0.062) or + Rem_0_00001 /= DT_0_00001(0.00025) + then + Report.Failed("Incorrect values returned, Case 33"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 34"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001); + if Quot_0_001 /= DT_0_001(0.062) or + Rem_0_0001 /= DT_0_0001(0.0002) + then + Report.Failed("Incorrect values returned, Case 34"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 35"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001); + if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000) + then + Report.Failed("Incorrect values returned, Case 35"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 36"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01); + if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then + Report.Failed("Incorrect values returned, Case 36"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001); + begin + if TC_Verbose then Report.Comment("Case 37"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125) + then + Report.Failed("Incorrect values returned, Case 37"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 38"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012) + then + Report.Failed("Incorrect values returned, Case 38"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001); + begin + if TC_Verbose then Report.Comment("Case 39"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then + Report.Failed("Incorrect values returned, Case 39"); + end if; + end; + + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01); + begin + if TC_Verbose then Report.Comment("Case 40"); end if; + Dd_0_00001 := DT_0_00001(0.03125); Dv_0_1 := DT_0_1(0.5); + Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01); + if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then + Report.Failed("Incorrect values returned, Case 40"); + end if; + end; + + declare + procedure Div is + new Ada.Decimal.Divide(DT_0_0001, DT_1, DT_0_0001, DT_0_0001); + begin + if TC_Verbose then Report.Comment("Case 41"); end if; + Dd_0_0001 := (DT_0_0001(6062.0) / DT_0_0001(16384.0)); + Dv_1 := DT_1(0.0); + Div(Dd_0_0001, Dv_1, Quot_0_0001, Rem_0_0001); + Report.Failed("Divide by Zero didn't raise Constraint_Error, " & + "Case 41"); + exception + when Constraint_Error => null; -- OK, expected exception. + when others => + Report.Failed("Unexpected exception raised by Divide by Zero," & + "Case 41"); + end; + + exception + when others => Report.Failed("Exception raised in Radix_10_Block"); + end Radix_2_Block; + + + Report.Result; + +end CXF2001; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a new file mode 100644 index 000000000..984daa97b --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a @@ -0,0 +1,352 @@ +-- CXF2002.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 multiplying operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- Check the case where the operand and result types are the same. +-- +-- Check that if the mathematical result is between multiples of the +-- small of the result type, the result is truncated toward zero. +-- Check that if the attribute 'Round is applied to the mathematical +-- result, however, the result is rounded to the nearest multiple of +-- the small (away from zero if the result is midway between two +-- multiples of the small). +-- +-- TEST DESCRIPTION: +-- Two decimal fixed point types are declared, one with a Machine_Radix +-- value of 2, and one with a value of 10. For each type, checks are +-- performed on the following operations, where the operand and result +-- types are the same: +-- +-- - Multiplication. +-- - Multiplication, where the attribute 'Round is applied to the +-- result. +-- - Division. +-- - Division, where the attribute 'Round is applied to the result. +-- +-- Each operation is performed within a loop, where one operand is +-- always the same variable. After the loop completes, the cumulative +-- total contained in this variable is compared with the expected +-- result. +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 27 Mar 96 SAIC Prerelease version for ACVC 2.1. +-- +--! + +generic + type Decimal_Fixed is delta <> digits <>; +package CXF2002_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; + Factor : in Decimal_Fixed); + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; + Divisor : in Decimal_Fixed); + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed; + Factor : in Decimal_Fixed); + + procedure Divide_And_Round (Balance : in out Decimal_Fixed; + Divisor : in Decimal_Fixed); + +end CXF2002_0; + + + --==================================================================-- + + +package body CXF2002_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; + Factor : in Decimal_Fixed) is + Interest : Decimal_Fixed; + begin + Interest := Factor * Balance; -- Fixed-fixed multiplication. + Balance := Balance + Interest; + end Multiply_And_Truncate; + + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; + Divisor : in Decimal_Fixed) is + Interest : Decimal_Fixed; + begin + Interest := Balance / Divisor; -- Fixed-fixed division. + Balance := Balance + Interest; + end Divide_And_Truncate; + + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed; + Factor : in Decimal_Fixed) is + Interest : Decimal_Fixed; + begin + -- Fixed-fixed multiplication. + Interest := Decimal_Fixed'Round ( Factor * Balance ); + Balance := Balance + Interest; + end Multiply_And_Round; + + + procedure Divide_And_Round (Balance : in out Decimal_Fixed; + Divisor : in Decimal_Fixed) is + Interest : Decimal_Fixed; + begin + -- Fixed-fixed division. + Interest := Decimal_Fixed'Round ( Balance / Divisor ); + Balance := Balance + Interest; + end Divide_And_Round; + +end CXF2002_0; + + + --==================================================================-- + + +package CXF2002_1 is + + type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99 + + + type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99 + +end CXF2002_1; + + + --==================================================================-- + + +with CXF2002_0; +with CXF2002_1; + +with Report; +procedure CXF2002 is + + Loop_Count : constant := 300; + type Loop_Range is range 1 .. Loop_Count; + +begin + + Report.Test ("CXF2002", "Check decimal multiplication and division, and " & + "'Round, where the operand and result types are " & + "the same"); + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_2_SUBTESTS: + declare + package Radix_2 is new CXF2002_0 (CXF2002_1.Money_Radix2); + use type CXF2002_1.Money_Radix2; + begin + + RADIX_2_MULTIPLICATION: + declare + Rate : constant CXF2002_1.Money_Radix2 := 0.12; + Period : constant Integer := 12; + Factor : CXF2002_1.Money_Radix2 := Rate / Period; + + Initial : constant CXF2002_1.Money_Radix2 := 100_000.00; + Trunc_Expected : constant CXF2002_1.Money_Radix2 := 1_978_837.50; + Round_Expected : constant CXF2002_1.Money_Radix2 := 1_978_846.75; + + Balance : CXF2002_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Truncate (Balance, Factor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 2 multiply and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Round (Balance, Factor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 2 multiply and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_2_MULTIPLICATION; + + + RADIX_2_DIVISION: + declare + Rate : constant CXF2002_1.Money_Radix2 := 0.25; + Period : constant Integer := 12; + Factor : CXF2002_1.Money_Radix2 := Rate / Period; + Divisor : constant CXF2002_1.Money_Radix2 := 1.0 / Factor; + + Initial : constant CXF2002_1.Money_Radix2 := 5_500.36; + Trunc_Expected : constant CXF2002_1.Money_Radix2 := 2_091_332.87; + Round_Expected : constant CXF2002_1.Money_Radix2 := 2_091_436.88; + + Balance : CXF2002_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Truncate (Balance, Divisor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 2 divide and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Round (Balance, Divisor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 2 divide and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_2_DIVISION; + + end RADIX_2_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_10_SUBTESTS: + declare + package Radix_10 is new CXF2002_0 (CXF2002_1.Money_Radix10); + use type CXF2002_1.Money_Radix10; + begin + + RADIX_10_MULTIPLICATION: + declare + Rate : constant CXF2002_1.Money_Radix10 := 0.37; + Period : constant Integer := 12; + Factor : CXF2002_1.Money_Radix10 := Rate / Period; + + Initial : constant CXF2002_1.Money_Radix10 := 459.33; + Trunc_Expected : constant CXF2002_1.Money_Radix10 := 3_259_305.54; + Round_Expected : constant CXF2002_1.Money_Radix10 := 3_260_544.11; + + Balance : CXF2002_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Truncate (Balance, Factor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 10 multiply and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Round (Balance, Factor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 10 multiply and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_10_MULTIPLICATION; + + + RADIX_10_DIVISION: + declare + Rate : constant CXF2002_1.Money_Radix10 := 0.15; + Period : constant Integer := 12; + Factor : CXF2002_1.Money_Radix10 := Rate / Period; + Divisor : constant CXF2002_1.Money_Radix10 := 1.0 / Factor; + + Initial : constant CXF2002_1.Money_Radix10 := 29_842.08; + Trunc_Expected : constant CXF2002_1.Money_Radix10 := 590_519.47; + Round_Expected : constant CXF2002_1.Money_Radix10 := 590_528.98; + + Balance : CXF2002_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Truncate (Balance, Divisor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 10 divide and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Round (Balance, Divisor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 10 divide and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_10_DIVISION; + + end RADIX_10_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Report.Result; + +end CXF2002; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a new file mode 100644 index 000000000..133dc48e6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a @@ -0,0 +1,363 @@ +-- CXF2003.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 multiplying operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- Check the case where the two operands are of different decimal +-- fixed point types. +-- +-- Check that if the mathematical result is between multiples of the +-- small of the result type, the result is truncated toward zero. +-- Check that if the attribute 'Round is applied to the mathematical +-- result, however, the result is rounded to the nearest multiple of +-- the small (away from zero if the result is midway between two +-- multiples of the small). +-- +-- TEST DESCRIPTION: +-- Two decimal fixed point types A and B are declared, one with a +-- Machine_Radix value of 2, and one with a value of 10. A third decimal +-- fixed point type C is declared with digits and delta values different +-- from those of A and B. For type A (and B), checks are performed +-- on the following operations, where one operand type is C, and the +-- other operand type and the result type is A (or B): +-- +-- - Multiplication. +-- - Multiplication, where the attribute 'Round is applied to the +-- result. +-- - Division. +-- - Division, where the attribute 'Round is applied to the result. +-- +-- Each operation is performed within a loop, where one operand is +-- always the same variable. After the loop completes, the cumulative +-- total contained in this variable is compared with the expected +-- result. +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 22 Mar 96 SAIC Prerelease version for ACVC 2.1. +-- +--! + +generic + type Decimal_Fixed_1 is delta <> digits <>; + type Decimal_Fixed_2 is delta <> digits <>; +package CXF2003_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1; + Factor : in Decimal_Fixed_2); + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed_1; + Divisor : in Decimal_Fixed_2); + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed_1; + Factor : in Decimal_Fixed_2); + + procedure Divide_And_Round (Balance : in out Decimal_Fixed_1; + Divisor : in Decimal_Fixed_2); + +end CXF2003_0; + + + --==================================================================-- + + +package body CXF2003_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1; + Factor : in Decimal_Fixed_2) is + Interest : Decimal_Fixed_1; + begin + Interest := Factor * Balance; -- Fixed-fixed multiplication. + Balance := Balance + Interest; + end Multiply_And_Truncate; + + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed_1; + Divisor : in Decimal_Fixed_2) is + Interest : Decimal_Fixed_1; + begin + Interest := Balance / Divisor; -- Fixed-fixed division. + Balance := Balance + Interest; + end Divide_And_Truncate; + + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed_1; + Factor : in Decimal_Fixed_2) is + Interest : Decimal_Fixed_1; + begin + -- Fixed-fixed multiplication. + Interest := Decimal_Fixed_1'Round ( Factor * Balance ); + Balance := Balance + Interest; + end Multiply_And_Round; + + + procedure Divide_And_Round (Balance : in out Decimal_Fixed_1; + Divisor : in Decimal_Fixed_2) is + Interest : Decimal_Fixed_1; + begin + -- Fixed-fixed division. + Interest := Decimal_Fixed_1'Round ( Balance / Divisor ); + Balance := Balance + Interest; + end Divide_And_Round; + +end CXF2003_0; + + + --==================================================================-- + + +package CXF2003_1 is + + type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99 + + + type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99 + + + type Interest_Rate is delta 0.00001 digits 9; -- range -9999.99999 .. + -- +9999.99999 + +end CXF2003_1; + + + --==================================================================-- + + +with CXF2003_0; +with CXF2003_1; + +with Report; +procedure CXF2003 is + + Loop_Count : constant := 1825; + type Loop_Range is range 1 .. Loop_Count; + +begin + + Report.Test ("CXF2003", "Check decimal multiplication and division, and " & + "'Round, where the operand types are different"); + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_2_SUBTESTS: + declare + package Radix_2 is new CXF2003_0 (CXF2003_1.Money_Radix2, + CXF2003_1.Interest_Rate); + use type CXF2003_1.Money_Radix2; + use type CXF2003_1.Interest_Rate; + begin + + RADIX_2_MULTIPLICATION: + declare + Rate : CXF2003_1.Interest_Rate := 0.198; + Period : Integer := 365; + Factor : CXF2003_1.Interest_Rate := Rate / Period; + + Initial : constant CXF2003_1.Money_Radix2 := 1_000.00; + Trunc_Expected : constant CXF2003_1.Money_Radix2 := 2_662.94; + Round_Expected : constant CXF2003_1.Money_Radix2 := 2_678.34; + + Balance : CXF2003_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Truncate (Balance, Factor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 2 multiply and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Round (Balance, Factor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 2 multiply and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_2_MULTIPLICATION; + + + RADIX_2_DIVISION: + declare + Rate : CXF2003_1.Interest_Rate := 0.129; + Period : Integer := 365; + Factor : CXF2003_1.Interest_Rate := Rate / Period; + Divisor : CXF2003_1.Interest_Rate := 1.0 / Factor; + + Initial : constant CXF2003_1.Money_Radix2 := 14_626.52; + Trunc_Expected : constant CXF2003_1.Money_Radix2 := 27_688.26; + Round_Expected : constant CXF2003_1.Money_Radix2 := 27_701.12; + + Balance : CXF2003_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Truncate (Balance, Divisor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 2 divide and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Round (Balance, Divisor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 2 divide and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_2_DIVISION; + + end RADIX_2_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_10_SUBTESTS: + declare + package Radix_10 is new CXF2003_0 (CXF2003_1.Money_Radix10, + CXF2003_1.Interest_Rate); + use type CXF2003_1.Money_Radix10; + use type CXF2003_1.Interest_Rate; + begin + + RADIX_10_MULTIPLICATION: + declare + Rate : CXF2003_1.Interest_Rate := 0.063; + Period : Integer := 365; + Factor : CXF2003_1.Interest_Rate := Rate / Period; + + Initial : constant CXF2003_1.Money_Radix10 := 314_036.10; + Trunc_Expected : constant CXF2003_1.Money_Radix10 := 428_249.48; + Round_Expected : constant CXF2003_1.Money_Radix10 := 428_260.52; + + Balance : CXF2003_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Truncate (Balance, Factor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 10 multiply and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Round (Balance, Factor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 10 multiply and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_10_MULTIPLICATION; + + + RADIX_10_DIVISION: + declare + Rate : CXF2003_1.Interest_Rate := 0.273; + Period : Integer := 365; + Factor : CXF2003_1.Interest_Rate := Rate / Period; + Divisor : CXF2003_1.Interest_Rate := 1.0 / Factor; + + Initial : constant CXF2003_1.Money_Radix10 := 25.72; + Trunc_Expected : constant CXF2003_1.Money_Radix10 := 79.05; + Round_Expected : constant CXF2003_1.Money_Radix10 := 97.46; + + Balance : CXF2003_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Truncate (Balance, Divisor); + end loop; + + if Balance /= Trunc_Expected then + Report.Failed ("Wrong result: Radix 10 divide and truncate"); + end if; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Round (Balance, Divisor); + end loop; + + if Balance /= Round_Expected then + Report.Failed ("Wrong result: Radix 10 divide and round"); + end if; + + ---=---=---=---=---=---=--- + end RADIX_10_DIVISION; + + end RADIX_10_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Report.Result; + +end CXF2003; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a new file mode 100644 index 000000000..9651384ce --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a @@ -0,0 +1,513 @@ +-- CXF2004.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 multiplying operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- Check the case where one operand is of an ordinary fixed point type. +-- +-- Check that if the mathematical result is between multiples of the +-- small of the result type, the result is truncated toward zero. +-- Check that if the attribute 'Round is applied to the mathematical +-- result, however, the result is rounded to the nearest multiple of +-- the small (away from zero if the result is midway between two +-- multiples of the small). +-- +-- TEST DESCRIPTION: +-- Two decimal fixed point types A and B are declared, one with a +-- Machine_Radix value of 2, and one with a value of 10. An ordinary +-- fixed point type C is declared with a delta value different from +-- those of A and B (although still a power of 10). For type A (and B), +-- checks are performed on the following operations, where one operand +-- type is C, and the other operand type and the result type is A (or B): +-- +-- - Multiplication. +-- - Multiplication, where the attribute 'Round is applied to the +-- result. +-- - Division. +-- - Division, where the attribute 'Round is applied to the result. +-- +-- Each operation is performed within a loop, where one operand is +-- always the same variable. After the loop completes, the cumulative +-- total contained in this variable is compared with the expected +-- result. +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 22 Mar 96 SAIC Prerelease version for ACVC 2.1. +-- 11 Aug 96 SAIC ACVC 2.1: In RADIX_2_MULTIPLICATION, corrected +-- value of Rate. Corrected associated commentary. +-- +--! + +generic + type Decimal_Fixed is delta <> digits <>; + type Ordinary_Fixed is delta <>; +package CXF2004_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; + Factor : in Ordinary_Fixed); + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; + Divisor : in Ordinary_Fixed); + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed; + Factor : in Ordinary_Fixed); + + procedure Divide_And_Round (Balance : in out Decimal_Fixed; + Divisor : in Ordinary_Fixed); + +end CXF2004_0; + + + --==================================================================-- + + +package body CXF2004_0 is + + procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed; + Factor : in Ordinary_Fixed) is + Interest : Decimal_Fixed; + begin + Interest := Factor * Balance; -- Fixed-fixed multiplication. + Balance := Balance + Interest; + end Multiply_And_Truncate; + + + procedure Divide_And_Truncate (Balance : in out Decimal_Fixed; + Divisor : in Ordinary_Fixed) is + Interest : Decimal_Fixed; + begin + Interest := Balance / Divisor; -- Fixed-fixed division. + Balance := Balance + Interest; + end Divide_And_Truncate; + + + procedure Multiply_And_Round (Balance : in out Decimal_Fixed; + Factor : in Ordinary_Fixed) is + Interest : Decimal_Fixed; + begin + -- Fixed-fixed multiplication. + Interest := Decimal_Fixed'Round ( Factor * Balance ); + Balance := Balance + Interest; + end Multiply_And_Round; + + + procedure Divide_And_Round (Balance : in out Decimal_Fixed; + Divisor : in Ordinary_Fixed) is + Interest : Decimal_Fixed; + begin + -- Fixed-fixed division. + Interest := Decimal_Fixed'Round ( Balance / Divisor ); + Balance := Balance + Interest; + end Divide_And_Round; + +end CXF2004_0; + + + --==================================================================-- + + +package CXF2004_1 is + + type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99 + + + type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99 + + + type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0; + for Interest_Rate'Small use 0.001; -- Power of 10. + +end CXF2004_1; + + + --==================================================================-- + + +with CXF2004_0; +with CXF2004_1; + +with Report; +procedure CXF2004 is + + Loop_Count : constant := 180; + type Loop_Range is range 1 .. Loop_Count; + + type Rounding_Scheme is ( Rounds, Truncates ); + Machine : Rounding_Scheme; + +begin + + Report.Test ("CXF2004", "Check decimal multiplication and division, and " & + "'Round, where one operand type is ordinary fixed"); + + + ---=---=---=---=---=---=---=---=---=---=--- + + if CXF2004_1.Interest_Rate'Machine_Rounds then -- Determine machine's + Machine := Rounds; -- rounding scheme. + else + Machine := Truncates; + end if; + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_2_SUBTESTS: + declare + package Radix_2 is new CXF2004_0 (CXF2004_1.Money_Radix2, + CXF2004_1.Interest_Rate); + use type CXF2004_1.Money_Radix2; + use type CXF2004_1.Interest_Rate; + begin + + RADIX_2_MULTIPLICATION: + declare + Rate : constant CXF2004_1.Interest_Rate := 0.154; + Period : constant Integer := 12; + Factor : CXF2004_1.Interest_Rate := Rate / Period; + + -- The exact value of Factor is: + -- + -- 0.154/12 = 0.01283333... + -- + -- The adjacent multiples of small are 0.012 and 0.013. Since + -- Factor is of an ordinary fixed point type, it may contain either + -- of these values. However, since "Rate / Period" is a static + -- expression, the value Factor contains is determined by the + -- value of CXF2004_1.Interest_Rate'Machine_Rounds: + -- + -- If Machine_Rounds = FALSE : Factor = 0.012 + -- If Machine_Rounds = TRUE : Factor = 0.013 + + Initial : constant CXF2004_1.Money_Radix2 := 1_000.00; + + Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 8_557.07; + Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 8_560.47; + + Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_222.65; + Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_225.81; + + Balance : CXF2004_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Truncate (Balance, Factor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Trunc_Expected_MachRnds then + Report.Failed ("Error (R): Radix 2 multiply and truncate"); + end if; + when Truncates => + if Balance /= Trunc_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 2 multiply and truncate"); + end if; + end case; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Multiply_And_Round (Balance, Factor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Round_Expected_MachRnds then + Report.Failed ("Error (R): Radix 2 multiply and round"); + end if; + when Truncates => + if Balance /= Round_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 2 multiply and round"); + end if; + end case; + + ---=---=---=---=---=---=--- + end RADIX_2_MULTIPLICATION; + + + RADIX_2_DIVISION: + declare + Rate : constant CXF2004_1.Interest_Rate := 0.210; + Period : constant Integer := 12; + Factor : constant CXF2004_1.Interest_Rate := Rate / Period; + Divisor : CXF2004_1.Interest_Rate := 1.0 / Factor; + + -- The exact value of Factor is: + -- + -- 0.210/12 = 0.0175 + -- + -- The adjacent multiples of small are 0.017 and 0.018. Since + -- Factor is of an ordinary fixed point type, it may contain either + -- of these values. However, since "Rate / Period" is a static + -- expression, the value Factor contains is determined by the + -- value of CXF2004_1.Interest_Rate'Machine_Rounds: + -- + -- If Machine_Rounds = FALSE : Factor = 0.017 + -- If Machine_Rounds = TRUE : Factor = 0.018 + -- + -- The exact value of Divisor is one of the following values: + -- + -- 1.0/0.017 = 58.82352... (Adjacent smalls 58.823 and 58.824) + -- 1.0/0.018 = 55.55555... (Adjacent smalls 55.555 and 55.556) + -- + -- Again, since "1.0 / Factor" is static, the value Divisor contains + -- is determined by the value of CXF2004_1.Interest_Rate'Rounds: + -- + -- If Machine_Rounds = FALSE : Divisor = 58.823 + -- If Machine_Rounds = TRUE : Divisor = 55.556 + + Initial : constant CXF2004_1.Money_Radix2 := 260.13; + + Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 5_401.46; + Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 := 5_406.95; + + Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 6_446.56; + Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 6_453.78; + + Balance : CXF2004_1.Money_Radix2; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Truncate (Balance, Divisor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Trunc_Expected_MachRnds then + Report.Failed ("Error (R): Radix 2 divide and truncate"); + end if; + when Truncates => + if Balance /= Trunc_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 2 divide and truncate"); + end if; + end case; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_2.Divide_And_Round (Balance, Divisor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Round_Expected_MachRnds then + Report.Failed ("Error (R): Radix 2 divide and round"); + end if; + when Truncates => + if Balance /= Round_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 2 divide and round"); + end if; + end case; + + ---=---=---=---=---=---=--- + end RADIX_2_DIVISION; + + end RADIX_2_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_10_SUBTESTS: + declare + package Radix_10 is new CXF2004_0 (CXF2004_1.Money_Radix10, + CXF2004_1.Interest_Rate); + use type CXF2004_1.Money_Radix10; + use type CXF2004_1.Interest_Rate; + begin + + RADIX_10_MULTIPLICATION: + declare + Rate : constant CXF2004_1.Interest_Rate := 0.095; + Period : constant Integer := 12; + Factor : CXF2004_1.Interest_Rate := Rate / Period; + + -- The exact value of Factor is: + -- + -- 0.095/12 = 0.00791666... + -- + -- The adjacent multiples of small are 0.007 and 0.008. Since + -- Factor is of an ordinary fixed point type, it may contain either + -- of these values. However, since "Rate / Period" is a static + -- expression, the value Factor contains can be determined based + -- on the value of CXF2004_1.Interest_Rate'Machine_Rounds: + -- + -- If Machine_Rounds = FALSE : Factor = 0.007 + -- If Machine_Rounds = TRUE : Factor = 0.008 + + Initial : constant CXF2004_1.Money_Radix10 := 2_125.00; + + Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_456.90; + Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_458.77; + + Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_915.74; + Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_917.84; + + Balance : CXF2004_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Truncate (Balance, Factor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Trunc_Expected_MachRnds then + Report.Failed ("Error (R): Radix 10 multiply and truncate"); + end if; + when Truncates => + if Balance /= Trunc_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 10 multiply and truncate"); + end if; + end case; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Multiply_And_Round (Balance, Factor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Round_Expected_MachRnds then + Report.Failed ("Error (R): Radix 10 multiply and round"); + end if; + when Truncates => + if Balance /= Round_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 10 multiply and round"); + end if; + end case; + + ---=---=---=---=---=---=--- + end RADIX_10_MULTIPLICATION; + + + RADIX_10_DIVISION: + declare + Rate : constant CXF2004_1.Interest_Rate := 0.295; + Period : constant Integer := 12; + Factor : constant CXF2004_1.Interest_Rate := Rate / Period; + Divisor : CXF2004_1.Interest_Rate := 1.0 / Factor; + + -- The exact value of Factor is: + -- + -- 0.295/12 = 0.02458333... + -- + -- The adjacent multiples of small are 0.024 and 0.025. Thus, the + -- exact value of Divisor is one of the following: + -- + -- 1.0/0.024 = 41.66666... (Adjacent smalls 41.666 and 41.667) + -- 1.0/0.025 = 40.0 + -- + -- The value of CXF2004_1.Interest_Rate'Machine_Rounds determines + -- what Divisor contains: + -- + -- If Machine_Rounds = FALSE : Divisor = 41.666 + -- If Machine_Rounds = TRUE : Divisor = 40.000 + + Initial : constant CXF2004_1.Money_Radix10 := 72.19; + + Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_144.60; + Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_157.80; + + Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_133.28; + Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_149.06; + + Balance : CXF2004_1.Money_Radix10; + begin + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Truncate (Balance, Divisor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Trunc_Expected_MachRnds then + Report.Failed ("Error (R): Radix 10 divide and truncate"); + end if; + when Truncates => + if Balance /= Trunc_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 10 divide and truncate"); + end if; + end case; + + ---=---=---=---=---=---=--- + + Balance := Initial; + + for I in Loop_Range loop + Radix_10.Divide_And_Round (Balance, Divisor); + end loop; + + case (Machine) is + when Rounds => + if Balance /= Round_Expected_MachRnds then + Report.Failed ("Error (R): Radix 10 divide and round"); + end if; + when Truncates => + if Balance /= Round_Expected_MachTrnc then + Report.Failed ("Error (T): Radix 10 divide and round"); + end if; + end case; + + ---=---=---=---=---=---=--- + end RADIX_10_DIVISION; + + end RADIX_10_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Report.Result; + +end CXF2004; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a new file mode 100644 index 000000000..71cd5bb31 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a @@ -0,0 +1,293 @@ +-- CXF2005.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 multiplying operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- Check the case where one operand is of the predefined type Integer. +-- +-- TEST DESCRIPTION: +-- Two decimal fixed point types A and B are declared, one with a +-- Machine_Radix value of 2, and one with a value of 10. A variable of +-- each type is multiplied repeatedly by a series of different Integer +-- values. A cumulative result is kept and compared to an expected +-- final result. Similar checks are performed for division. +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 28 Mar 96 SAIC Prerelease version for ACVC 2.1. +-- +--! + +generic + type Decimal_Fixed is delta <> digits <>; +package CXF2005_0 is + + function Multiply (Operand : Decimal_Fixed; + Interval : Integer) return Decimal_Fixed; + + function Divide (Operand : Decimal_Fixed; + Interval : Integer) return Decimal_Fixed; + +end CXF2005_0; + + + --==================================================================-- + + +package body CXF2005_0 is + + function Multiply (Operand : Decimal_Fixed; + Interval : Integer) return Decimal_Fixed is + begin + return Operand * Interval; -- Fixed-Integer multiplication. + end Multiply; + + + function Divide (Operand : Decimal_Fixed; + Interval : Integer) return Decimal_Fixed is + begin + return Operand / Interval; -- Fixed-Integer division. + end Divide; + +end CXF2005_0; + + + --==================================================================-- + + +package CXF2005_1 is + + ---=---=---=---=---=---=---=---=---=---=--- + + type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0; + for Interest_Rate'Small use 0.001; -- Power of 10. + + ---=---=---=---=---=---=---=---=---=---=--- + + type Money_Radix2 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix2'Machine_Radix use 2; -- +999,999,999.99 + + function Factor (Rate : Interest_Rate; + Interval : Integer) return Money_Radix2; + + ---=---=---=---=---=---=---=---=---=---=--- + + type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money_Radix10'Machine_Radix use 10; -- +999,999,999.99 + + function Factor (Rate : Interest_Rate; + Interval : Integer) return Money_Radix10; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2005_1; + + + --==================================================================-- + + +package body CXF2005_1 is + + ---=---=---=---=---=---=---=---=---=---=--- + + function Factor (Rate : Interest_Rate; + Interval : Integer) return Money_Radix2 is + begin + return Money_Radix2( Rate / Interval ); + end Factor; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Factor (Rate : Interest_Rate; + Interval : Integer) return Money_Radix10 is + begin + return Money_Radix10( Rate / Interval ); + end Factor; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2005_1; + + + --==================================================================-- + + +with CXF2005_0; +with CXF2005_1; + +with Report; +procedure CXF2005 is + + Loop_Count : constant := 25_000; + type Loop_Range is range 1 .. Loop_Count; + +begin + + Report.Test ("CXF2005", "Check decimal multiplication and division, " & + "where one operand type is Integer"); + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_2_SUBTESTS: + declare + package Radix_2 is new CXF2005_0 (CXF2005_1.Money_Radix2); + use type CXF2005_1.Money_Radix2; + begin + + RADIX_2_MULTIPLICATION: + declare + Rate : constant CXF2005_1.Interest_Rate := 0.127; + Period : constant Integer := 12; + + Expected : constant CXF2005_1.Money_Radix2 := 2_624.88; + Balance : CXF2005_1.Money_Radix2 := 1_000.00; + + Operand : CXF2005_1.Money_Radix2; + Increment : CXF2005_1.Money_Radix2; + Interval : Integer; + begin + + for I in Loop_Range loop + Interval := (Integer(I) mod Period) + 1; -- Range from 1 to 12. + Operand := CXF2005_1.Factor (Rate, Period); + Increment := Radix_2.Multiply (Operand, Interval); + Balance := Balance + Increment; + end loop; + + if Balance /= Expected then + Report.Failed ("Error: Radix 2 multiply"); + end if; + + end RADIX_2_MULTIPLICATION; + + + + RADIX_2_DIVISION: + declare + Rate : constant CXF2005_1.Interest_Rate := 0.377; + Period : constant Integer := 12; + + Expected : constant CXF2005_1.Money_Radix2 := 36_215.58; + Balance : CXF2005_1.Money_Radix2 := 456_985.01; + + Operand : CXF2005_1.Money_Radix2; + Increment : CXF2005_1.Money_Radix2; + Interval : Integer; + begin + + for I in Loop_Range loop + Interval := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400. + Operand := CXF2005_1.Factor (Rate, Period); + Increment := Radix_2.Divide (Balance, Interval); + Balance := Balance - (Operand * Increment); + end loop; + + if Balance /= Expected then + Report.Failed ("Error: Radix 2 divide"); + end if; + + end RADIX_2_DIVISION; + + end RADIX_2_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + RADIX_10_SUBTESTS: + declare + package Radix_10 is new CXF2005_0 (CXF2005_1.Money_Radix10); + use type CXF2005_1.Money_Radix10; + begin + + RADIX_10_MULTIPLICATION: + declare + Rate : constant CXF2005_1.Interest_Rate := 0.721; + Period : constant Integer := 12; + + Expected : constant CXF2005_1.Money_Radix10 := 9_875.62; + Balance : CXF2005_1.Money_Radix10 := 126.34; + + Operand : CXF2005_1.Money_Radix10; + Increment : CXF2005_1.Money_Radix10; + Interval : Integer; + begin + + for I in Loop_Range loop + Interval := (Integer(I) mod Period) + 1; -- Range from 1 to 12. + Operand := CXF2005_1.Factor (Rate, Period); + Increment := Radix_10.Multiply (Operand, Interval); + Balance := Balance + Increment; + end loop; + + if Balance /= Expected then + Report.Failed ("Error: Radix 10 multiply"); + end if; + + end RADIX_10_MULTIPLICATION; + + + RADIX_10_DIVISION: + declare + Rate : constant CXF2005_1.Interest_Rate := 0.547; + Period : constant Integer := 12; + + Expected : constant CXF2005_1.Money_Radix10 := 26_116.37; + Balance : CXF2005_1.Money_Radix10 := 770_082.46; + + Operand : CXF2005_1.Money_Radix10; + Increment : CXF2005_1.Money_Radix10; + Interval : Integer; + begin + + for I in Loop_Range loop + Interval := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400. + Operand := CXF2005_1.Factor (Rate, Period); + Increment := Radix_10.Divide (Balance, Interval); + Balance := Balance - (Operand * Increment); + end loop; + + if Balance /= Expected then + Report.Failed ("Error: Radix 10 divide"); + end if; + + end RADIX_10_DIVISION; + + end RADIX_10_SUBTESTS; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Report.Result; + +end CXF2005; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a new file mode 100644 index 000000000..002c59d6c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a @@ -0,0 +1,448 @@ +-- CXF2A01.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 binary adding operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- +-- TEST DESCRIPTION: +-- The test verifies that decimal addition and subtraction behave as +-- expected for types with various digits, delta, and Machine_Radix +-- values. Types with the minimum values for Decimal.Max_Digits and +-- Decimal.Max_Scale (18) are included. +-- +-- Two kinds of checks are performed for each type. In the first check, +-- the iteration, operation, and operand counts in the foundation and +-- the operation tables in this test are given values such that, when the +-- operations loop is complete, each operand will have been added to and +-- subtracted from the loop's cumulator variable the same number of times, +-- albeit in varying order. Thus, the result returned by the operations +-- loop should have the same value as that used to initialize the +-- cumulator (in this test, zero). +-- +-- In the second check, the same operation (addition for some types and +-- subtraction for others) is performed during each loop iteration, +-- resulting in a cumulative total which is checked against an expected +-- value. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF2A00.A +-- -> CXF2A01.A +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 08 Apr 96 SAIC Prerelease version for ACVC 2.1. +-- +--! + +package CXF2A01_0 is + + ---=---=---=---=---=---=---=---=---=---=--- + + type Micro is delta 10.0**(-18) digits 18; -- range -0.999999999999999999 .. + for Micro'Machine_Radix use 10; -- +0.999999999999999999 + + function Add (Left, Right : Micro) return Micro; + function Subtract (Left, Right : Micro) return Micro; + + + type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro; + + Micro_Add : Micro_Optr_Ptr := Add'Access; + Micro_Sub : Micro_Optr_Ptr := Subtract'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + + type Money is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Money'Machine_Radix use 2; -- +999,999,999.99 + + function Add (Left, Right : Money) return Money; + function Subtract (Left, Right : Money) return Money; + + + type Money_Optr_Ptr is access function (Left, Right : Money) return Money; + + Money_Add : Money_Optr_Ptr := Add'Access; + Money_Sub : Money_Optr_Ptr := Subtract'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + + -- Same as Money, but with Radix 10: + + type Cash is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Cash'Machine_Radix use 10; -- +999,999,999.99 + + function Add (Left, Right : Cash) return Cash; + function Subtract (Left, Right : Cash) return Cash; + + + type Cash_Optr_Ptr is access function (Left, Right : Cash) return Cash; + + Cash_Add : Cash_Optr_Ptr := Add'Access; + Cash_Sub : Cash_Optr_Ptr := Subtract'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + + type Broad is delta 10.0**(-9) digits 18; -- range -999,999,999.999999999 .. + for Broad'Machine_Radix use 10; -- +999,999,999.999999999 + + function Add (Left, Right : Broad) return Broad; + function Subtract (Left, Right : Broad) return Broad; + + + type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad; + + Broad_Add : Broad_Optr_Ptr := Add'Access; + Broad_Sub : Broad_Optr_Ptr := Subtract'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A01_0; + + + --==================================================================-- + + +package body CXF2A01_0 is + + ---=---=---=---=---=---=---=---=---=---=--- + + function Add (Left, Right : Micro) return Micro is + begin + return (Left + Right); -- Decimal fixed addition. + end Add; + + function Subtract (Left, Right : Micro) return Micro is + begin + return (Left - Right); -- Decimal fixed subtraction. + end Subtract; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Add (Left, Right : Money) return Money is + begin + return (Left + Right); -- Decimal fixed addition. + end Add; + + function Subtract (Left, Right : Money) return Money is + begin + return (Left - Right); -- Decimal fixed subtraction. + end Subtract; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Add (Left, Right : Cash) return Cash is + begin + return (Left + Right); -- Decimal fixed addition. + end Add; + + function Subtract (Left, Right : Cash) return Cash is + begin + return (Left - Right); -- Decimal fixed subtraction. + end Subtract; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Add (Left, Right : Broad) return Broad is + begin + return (Left + Right); -- Decimal fixed addition. + end Add; + + function Subtract (Left, Right : Broad) return Broad is + begin + return (Left - Right); -- Decimal fixed subtraction. + end Subtract; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A01_0; + + + --==================================================================-- + + +with FXF2A00; +package CXF2A01_0.CXF2A01_1 is + + ---=---=---=---=---=---=---=---=---=---=--- + + type Micro_Ops is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr; + type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro; + + Micro_Optr_Table_Cancel : Micro_Ops := ( Micro_Add, Micro_Sub, + Micro_Add, Micro_Sub, + Micro_Add, Micro_Sub ); + + Micro_Optr_Table_Cumul : Micro_Ops := ( others => Micro_Add ); + + Micro_Opnd_Table_Cancel : Micro_Opnds := ( 0.001025000235111997, + 0.000000000000000003, + 0.724902903219925400, + 0.000459228020000011, + 0.049832104921096533 ); + + Micro_Opnd_Table_Cumul : Micro_Opnds := ( 0.000002309540000000, + 0.000000278060000000, + 0.000000000000070000, + 0.000010003000000000, + 0.000000023090000000 ); + + function Test_Micro_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Micro, + Operator_Ptr => Micro_Optr_Ptr, + Operator_Table => Micro_Ops, + Operand_Table => Micro_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + + type Money_Ops is array (FXF2A00.Optr_Range) of Money_Optr_Ptr; + type Money_Opnds is array (FXF2A00.Opnd_Range) of Money; + + Money_Optr_Table_Cancel : Money_Ops := ( Money_Add, Money_Add, + Money_Sub, Money_Add, + Money_Sub, Money_Sub ); + + Money_Optr_Table_Cumul : Money_Ops := ( others => Money_Sub ); + + Money_Opnd_Table_Cancel : Money_Opnds := ( 127.10, + 5600.44, + 0.05, + 189662.78, + 226900402.99 ); + + Money_Opnd_Table_Cumul : Money_Opnds := ( 17.99, + 500.41, + 92.78, + 0.38, + 2942.99 ); + + function Test_Money_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Money, + Operator_Ptr => Money_Optr_Ptr, + Operator_Table => Money_Ops, + Operand_Table => Money_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + + type Cash_Ops is array (FXF2A00.Optr_Range) of Cash_Optr_Ptr; + type Cash_Opnds is array (FXF2A00.Opnd_Range) of Cash; + + Cash_Optr_Table_Cancel : Cash_Ops := ( Cash_Add, Cash_Add, + Cash_Sub, Cash_Add, + Cash_Sub, Cash_Sub ); + + Cash_Optr_Table_Cumul : Cash_Ops := ( others => Cash_Add ); + + Cash_Opnd_Table_Cancel : Cash_Opnds := ( 127.10, + 5600.44, + 0.05, + 189662.78, + 226900402.99 ); + + Cash_Opnd_Table_Cumul : Cash_Opnds := ( 3.33, + 100056.14, + 22.87, + 3901.55, + 111.21 ); + + function Test_Cash_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Cash, + Operator_Ptr => Cash_Optr_Ptr, + Operator_Table => Cash_Ops, + Operand_Table => Cash_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + + type Broad_Ops is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr; + type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad; + + Broad_Optr_Table_Cancel : Broad_Ops := ( Broad_Sub, Broad_Add, + Broad_Add, Broad_Sub, + Broad_Sub, Broad_Add ); + + Broad_Optr_Table_Cumul : Broad_Ops := ( others => Broad_Sub ); + + Broad_Opnd_Table_Cancel : Broad_Opnds := ( 1.000009092, + 732919479.445022293, + 89662.787000006, + 660.101010133, + 1121127.999905594 ); + + Broad_Opnd_Table_Cumul : Broad_Opnds := ( 12.000450223, + 479.430320780, + 0.003492096, + 8.112888400, + 1002.994937800 ); + + function Test_Broad_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Broad, + Operator_Ptr => Broad_Optr_Ptr, + Operator_Table => Broad_Ops, + Operand_Table => Broad_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A01_0.CXF2A01_1; + + + --==================================================================-- + + +with CXF2A01_0.CXF2A01_1; + +with Report; +procedure CXF2A01 is + package Data renames CXF2A01_0.CXF2A01_1; + + use type CXF2A01_0.Micro; + use type CXF2A01_0.Money; + use type CXF2A01_0.Cash; + use type CXF2A01_0.Broad; + + Micro_Cancel_Expected : constant CXF2A01_0.Micro := 0.0; + Money_Cancel_Expected : constant CXF2A01_0.Money := 0.0; + Cash_Cancel_Expected : constant CXF2A01_0.Cash := 0.0; + Broad_Cancel_Expected : constant CXF2A01_0.Broad := 0.0; + + Micro_Cumul_Expected : constant CXF2A01_0.Micro := 0.075682140420000000; + Money_Cumul_Expected : constant CXF2A01_0.Money := -21327300.00; + Cash_Cumul_Expected : constant CXF2A01_0.Cash := 624570600.00; + Broad_Cumul_Expected : constant CXF2A01_0.Broad := -9015252.535794000; + + Micro_Actual : CXF2A01_0.Micro; + Money_Actual : CXF2A01_0.Money; + Cash_Actual : CXF2A01_0.Cash; + Broad_Actual : CXF2A01_0.Broad; +begin + + Report.Test ("CXF2A01", "Check decimal addition and subtraction"); + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Micro_Actual := Data.Test_Micro_Ops (0.0, + Data.Micro_Optr_Table_Cancel, + Data.Micro_Opnd_Table_Cancel); + + if Micro_Actual /= Micro_Cancel_Expected then + Report.Failed ("Wrong cancellation result for type Micro"); + end if; + + ---=---=---=---=---=---=--- + + + Micro_Actual := Data.Test_Micro_Ops (0.0, + Data.Micro_Optr_Table_Cumul, + Data.Micro_Opnd_Table_Cumul); + + if Micro_Actual /= Micro_Cumul_Expected then + Report.Failed ("Wrong cumulation result for type Micro"); + end if; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Money_Actual := Data.Test_Money_Ops (0.0, + Data.Money_Optr_Table_Cancel, + Data.Money_Opnd_Table_Cancel); + + if Money_Actual /= Money_Cancel_Expected then + Report.Failed ("Wrong cancellation result for type Money"); + end if; + + ---=---=---=---=---=---=--- + + + Money_Actual := Data.Test_Money_Ops (0.0, + Data.Money_Optr_Table_Cumul, + Data.Money_Opnd_Table_Cumul); + + if Money_Actual /= Money_Cumul_Expected then + Report.Failed ("Wrong cumulation result for type Money"); + end if; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Cash_Actual := Data.Test_Cash_Ops (0.0, + Data.Cash_Optr_Table_Cancel, + Data.Cash_Opnd_Table_Cancel); + + if Cash_Actual /= Cash_Cancel_Expected then + Report.Failed ("Wrong cancellation result for type Cash"); + end if; + + + ---=---=---=---=---=---=--- + + + Cash_Actual := Data.Test_Cash_Ops (0.0, + Data.Cash_Optr_Table_Cumul, + Data.Cash_Opnd_Table_Cumul); + + if Cash_Actual /= Cash_Cumul_Expected then + Report.Failed ("Wrong cumulation result for type Cash"); + end if; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Broad_Actual := Data.Test_Broad_Ops (0.0, + Data.Broad_Optr_Table_Cancel, + Data.Broad_Opnd_Table_Cancel); + + if Broad_Actual /= Broad_Cancel_Expected then + Report.Failed ("Wrong cancellation result for type Broad"); + end if; + + + ---=---=---=---=---=---=--- + + + Broad_Actual := Data.Test_Broad_Ops (0.0, + Data.Broad_Optr_Table_Cumul, + Data.Broad_Opnd_Table_Cumul); + + if Broad_Actual /= Broad_Cumul_Expected then + Report.Failed ("Wrong cumulation result for type Broad"); + end if; + + + ---=---=---=---=---=---=---=---=---=---=--- + + + Report.Result; + +end CXF2A01; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a new file mode 100644 index 000000000..e9977b0f5 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a @@ -0,0 +1,354 @@ +-- CXF2A02.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 multiplying operators for a decimal fixed point type +-- return values that are integral multiples of the small of the type. +-- Check the case where the operand and result types are the same. +-- +-- Check that if the mathematical result is between multiples of the +-- small of the result type, the result is truncated toward zero. +-- +-- TEST DESCRIPTION: +-- The test verifies that decimal multiplication and division behave as +-- expected for types with various digits, delta, and Machine_Radix +-- values. +-- +-- The iteration, operation, and operand counts in the foundation, and +-- the operations and operand tables in the test, are given values such +-- that, when the operations loop is complete, truncation of inexact +-- results should cause the result returned by the operations loop to be +-- the same as that used to initialize the loop's cumulator variable (in +-- this test, one). +-- +-- TEST FILES: +-- This test consists of the following files: +-- +-- FXF2A00.A +-- -> CXF2A02.A +-- +-- APPLICABILITY CRITERIA: +-- This test is only applicable for a compiler attempting validation +-- for the Information Systems Annex. +-- +-- +-- CHANGE HISTORY: +-- 13 Mar 96 SAIC Prerelease version for ACVC 2.1. +-- 04 Aug 96 SAIC Updated prologue. +-- +--! + +package CXF2A02_0 is + + ---=---=---=---=---=---=---=---=---=---=--- + + type Micro is delta 10.0**(-5) digits 6; -- range -9.99999 .. + for Micro'Machine_Radix use 2; -- +9.99999 + + function Multiply (Left, Right : Micro) return Micro; + function Divide (Left, Right : Micro) return Micro; + + + type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro; + + Micro_Mult : Micro_Optr_Ptr := Multiply'Access; + Micro_Div : Micro_Optr_Ptr := Divide'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + + type Basic is delta 0.01 digits 11; -- range -999,999,999.99 .. + for Basic'Machine_Radix use 10; -- +999,999,999.99 + + function Multiply (Left, Right : Basic) return Basic; + function Divide (Left, Right : Basic) return Basic; + + + type Basic_Optr_Ptr is access function (Left, Right : Basic) return Basic; + + Basic_Mult : Basic_Optr_Ptr := Multiply'Access; + Basic_Div : Basic_Optr_Ptr := Divide'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + + type Broad is delta 10.0**(-3) digits 10; -- range -9,999,999.999 .. + for Broad'Machine_Radix use 2; -- +9,999,999.999 + + function Multiply (Left, Right : Broad) return Broad; + function Divide (Left, Right : Broad) return Broad; + + + type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad; + + Broad_Mult : Broad_Optr_Ptr := Multiply'Access; + Broad_Div : Broad_Optr_Ptr := Divide'Access; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A02_0; + + + --==================================================================-- + + +package body CXF2A02_0 is + + ---=---=---=---=---=---=---=---=---=---=--- + + function Multiply (Left, Right : Micro) return Micro is + begin + return (Left * Right); -- Decimal fixed multiplication. + end Multiply; + + function Divide (Left, Right : Micro) return Micro is + begin + return (Left / Right); -- Decimal fixed division. + end Divide; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Multiply (Left, Right : Basic) return Basic is + begin + return (Left * Right); -- Decimal fixed multiplication. + end Multiply; + + function Divide (Left, Right : Basic) return Basic is + begin + return (Left / Right); -- Decimal fixed division. + end Divide; + + ---=---=---=---=---=---=---=---=---=---=--- + + function Multiply (Left, Right : Broad) return Broad is + begin + return (Left * Right); -- Decimal fixed multiplication. + end Multiply; + + function Divide (Left, Right : Broad) return Broad is + begin + return (Left / Right); -- Decimal fixed division. + end Divide; + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A02_0; + + + --==================================================================-- + + +with FXF2A00; +package CXF2A02_0.CXF2A02_1 is + + ---=---=---=---=---=---=---=---=---=---=--- + + type Micro_Ops is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr; + type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro; + + Micro_Mult_Operator_Table : Micro_Ops := ( Micro_Mult, Micro_Mult, + Micro_Mult, Micro_Mult, + Micro_Mult, Micro_Mult ); + + Micro_Div_Operator_Table : Micro_Ops := ( Micro_Div, Micro_Div, + Micro_Div, Micro_Div, + Micro_Div, Micro_Div ); + + Micro_Mult_Operand_Table : Micro_Opnds := ( 2.35119, + 0.05892, + 9.58122, + 0.80613, + 0.93462 ); + + Micro_Div_Operand_Table : Micro_Opnds := ( 0.58739, + 4.90012, + 0.08765, + 0.71577, + 5.53768 ); + + function Test_Micro_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Micro, + Operator_Ptr => Micro_Optr_Ptr, + Operator_Table => Micro_Ops, + Operand_Table => Micro_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + + type Basic_Ops is array (FXF2A00.Optr_Range) of Basic_Optr_Ptr; + type Basic_Opnds is array (FXF2A00.Opnd_Range) of Basic; + + Basic_Mult_Operator_Table : Basic_Ops := ( Basic_Mult, Basic_Mult, + Basic_Mult, Basic_Mult, + Basic_Mult, Basic_Mult ); + + Basic_Div_Operator_Table : Basic_Ops := ( Basic_Div, Basic_Div, + Basic_Div, Basic_Div, + Basic_Div, Basic_Div ); + + Basic_Mult_Operand_Table : Basic_Opnds := ( 127.10, + 0.02, + 0.87, + 45.67, + 0.01 ); + + Basic_Div_Operand_Table : Basic_Opnds := ( 0.03, + 0.08, + 23.57, + 0.11, + 159.11 ); + + function Test_Basic_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Basic, + Operator_Ptr => Basic_Optr_Ptr, + Operator_Table => Basic_Ops, + Operand_Table => Basic_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + + type Broad_Ops is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr; + type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad; + + Broad_Mult_Operator_Table : Broad_Ops := ( Broad_Mult, Broad_Mult, + Broad_Mult, Broad_Mult, + Broad_Mult, Broad_Mult ); + + Broad_Div_Operator_Table : Broad_Ops := ( Broad_Div, Broad_Div, + Broad_Div, Broad_Div, + Broad_Div, Broad_Div ); + + Broad_Mult_Operand_Table : Broad_Opnds := ( 589.720, + 0.106, + 21.018, + 0.002, + 0.381 ); + + Broad_Div_Operand_Table : Broad_Opnds := ( 0.008, + 0.793, + 9.092, + 214.300, + 0.080 ); + + function Test_Broad_Ops is new FXF2A00.Operations_Loop + (Decimal_Fixed => Broad, + Operator_Ptr => Broad_Optr_Ptr, + Operator_Table => Broad_Ops, + Operand_Table => Broad_Opnds); + + ---=---=---=---=---=---=---=---=---=---=--- + +end CXF2A02_0.CXF2A02_1; + + + --==================================================================-- + + +with CXF2A02_0.CXF2A02_1; + +with Report; +procedure CXF2A02 is + package Data renames CXF2A02_0.CXF2A02_1; + + use type CXF2A02_0.Micro; + use type CXF2A02_0.Basic; + use type CXF2A02_0.Broad; + + Micro_Expected : constant CXF2A02_0.Micro := 1.0; + Basic_Expected : constant CXF2A02_0.Basic := 1.0; + Broad_Expected : constant CXF2A02_0.Broad := 1.0; + + Micro_Actual : CXF2A02_0.Micro; + Basic_Actual : CXF2A02_0.Basic; + Broad_Actual : CXF2A02_0.Broad; +begin + + Report.Test ("CXF2A02", "Check decimal multiplication and division, " & + "where the operand and result types are the same"); + + ---=---=---=---=---=---=---=---=---=---=--- + + Micro_Actual := 0.0; + Micro_Actual := Data.Test_Micro_Ops (1.0, + Data.Micro_Mult_Operator_Table, + Data.Micro_Mult_Operand_Table); + + if Micro_Actual /= Micro_Expected then + Report.Failed ("Wrong result for type Micro multiplication"); + end if; + + + Micro_Actual := 0.0; + Micro_Actual := Data.Test_Micro_Ops (1.0, + Data.Micro_Div_Operator_Table, + Data.Micro_Div_Operand_Table); + + if Micro_Actual /= Micro_Expected then + Report.Failed ("Wrong result for type Micro division"); + end if; + + ---=---=---=---=---=---=---=---=---=---=--- + + Basic_Actual := 0.0; + Basic_Actual := Data.Test_Basic_Ops (1.0, + Data.Basic_Mult_Operator_Table, + Data.Basic_Mult_Operand_Table); + + if Basic_Actual /= Basic_Expected then + Report.Failed ("Wrong result for type Basic multiplication"); + end if; + + + Basic_Actual := 0.0; + Basic_Actual := Data.Test_Basic_Ops (1.0, + Data.Basic_Div_Operator_Table, + Data.Basic_Div_Operand_Table); + + if Basic_Actual /= Basic_Expected then + Report.Failed ("Wrong result for type Basic division"); + end if; + + ---=---=---=---=---=---=---=---=---=---=--- + + Broad_Actual := 0.0; + Broad_Actual := Data.Test_Broad_Ops (1.0, + Data.Broad_Mult_Operator_Table, + Data.Broad_Mult_Operand_Table); + + if Broad_Actual /= Broad_Expected then + Report.Failed ("Wrong result for type Broad multiplication"); + end if; + + + Broad_Actual := 0.0; + Broad_Actual := Data.Test_Broad_Ops (1.0, + Data.Broad_Div_Operator_Table, + Data.Broad_Div_Operand_Table); + + if Broad_Actual /= Broad_Expected then + Report.Failed ("Wrong result for type Broad division"); + end if; + + ---=---=---=---=---=---=---=---=---=---=--- + + Report.Result; + +end CXF2A02; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a new file mode 100644 index 000000000..1b9abca15 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a @@ -0,0 +1,192 @@ +-- CXF3001.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 edited output string value returned by Function Image +-- is correct. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. +-- +-- Each picture string is checked for validity, and an invalid picture +-- string will cause immediate test failure on its first pass through +-- the evaluation loop. Inside the evaluation loop, each decimal data +-- item is combined with each of the picture strings as parameters to a +-- call to Image, and the result of each call is compared to an +-- expected edited output result string. +-- +-- +-- CHANGE HISTORY: +-- 24 Feb 95 SAIC Initial prerelease version. +-- 23 Jun 95 SAIC Corrected call to functions Valid and To_Picture. +-- 22 Aug 95 SAIC Test name changed to CXF3001 (from CXF3301) to +-- conform to naming conventions. +-- 24 Feb 97 CTA.PWB Corrected picture strings and expected results. +--! + +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3001 is +begin + + Report.Test ("CXF3001", "Check that the string value returned by " & + "Function Image is correct"); + + Test_Block: + declare + + use Ada.Text_IO; + + Number_Of_Decimal_Items : constant := 5; + Number_Of_Picture_Strings : constant := 4; + Number_Of_Expected_Results : constant := Number_Of_Decimal_Items * + Number_Of_Picture_Strings; + + type String_Pointer_Type is access String; + + -- Define a decimal data type, and instantiate the Decimal_Output + -- generic package for the data type. + + type Decimal_Data_Type is delta 0.01 digits 16; + package Ed_Out is new Editing.Decimal_Output (Decimal_Data_Type); + + -- Define types for the arrays of data that will hold the decimal data + -- values, picture strings, and expected edited output results. + + type Decimal_Data_Array_Type is + array (Integer range <>) of Decimal_Data_Type; + + type Picture_String_Array_Type is + array (Integer range <>) of String_Pointer_Type; + + type Edited_Output_Results_Array_Type is + array (Integer range <>) of String_Pointer_Type; + + -- Define the data arrays for this test. + + Decimal_Data : + Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) := + ( 1 => 5678.90, + 2 => -6789.01, + 3 => 0.00, + 4 => 0.20, + 5 => 3.45 + ); + + Picture_Strings : + Picture_String_Array_Type(1..Number_Of_Picture_Strings) := + ( 1 => new String'("-$$_$$9.99"), + 2 => new String'("-$$_$$$.$$"), + 3 => new String'("-ZZZZ.ZZ"), + 4 => new String'("-$$$_999.99") + ); + + Edited_Output : + Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := + ( 1 => new String'(" $5,678.90"), + 2 => new String'(" $5,678.90"), + 3 => new String'(" 5678.90"), + 4 => new String'(" $5,678.90"), + + 5 => new String'("-$6,789.01"), + 6 => new String'("-$6,789.01"), + 7 => new String'("-6789.01"), + 8 => new String'("- $6,789.01"), + + 9 => new String'(" $0.00"), + 10 => new String'(" "), + 11 => new String'(" "), + 12 => new String'(" $ 000.00"), + + 13 => new String'(" $0.20"), + 14 => new String'(" $.20"), + 15 => new String'(" .20"), + 16 => new String'(" $ 000.20"), + + 17 => new String'(" $3.45"), + 18 => new String'(" $3.45"), + 19 => new String'(" 3.45"), + 20 => new String'(" $ 003.45") + ); + + TC_Picture : Editing.Picture; + TC_Loop_Count : Natural := 0; + + begin + + -- Compare string result of Image with expected edited output string. + + Evaluate_Edited_Output: + for i in 1..Number_Of_Decimal_Items loop + for j in 1..Number_Of_Picture_Strings loop + + TC_Loop_Count := TC_Loop_Count + 1; + + -- Check on the validity of the picture strings prior to + -- processing. + + if Editing.Valid(Picture_Strings(j).all) then + + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(Picture_Strings(j).all); + + -- Compare actual edited output result of Function Image with + -- the expected result. + + if Ed_Out.Image(Decimal_Data(i), TC_Picture) /= + Edited_Output(TC_Loop_Count).all + then + Report.Failed("Incorrect result from Function Image, " & + "when used with decimal data item # " & + Integer'Image(i) & + " and picture string # " & + Integer'Image(j)); + end if; + + else + Report.Failed("Picture String # " & Integer'Image(j) & + "reported as being invalid"); + -- Immediate test failure if a string is invalid. + exit Evaluate_Edited_Output; + end if; + + end loop; + end loop Evaluate_Edited_Output; + + exception + when Editing.Picture_Error => + Report.Failed ("Picture_Error raised in Test_Block"); + when Layout_Error => + Report.Failed ("Layout_Error raised in Test_Block"); + when others => + Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3001; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a new file mode 100644 index 000000000..8444244ef --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a @@ -0,0 +1,231 @@ +-- CXF3002.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 functionality contained in package +-- Ada.Wide_Text_IO.Editing is available and produces correct results. +-- +-- TEST DESCRIPTION: +-- This test is designed to validate the procedures and functions that +-- are found in package Ada.Wide_Text_IO.Editing, the "wide" +-- complementary package to Ada.Text_IO.Editing. The test is similar +-- to CXF3301, which tested a large portion of the Ada.Text_IO.Editing +-- package. Additional testing has been added here to cover the balance +-- of the Wide_Text_IO.Editing child package. + +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. +-- +-- Each picture string is checked for validity, and an invalid picture +-- string will cause immediate test failure on its first pass through +-- the evaluation loop. Inside the evaluation loop, each decimal data +-- item is combined with each of the picture strings as parameters to a +-- call to Image, and the result of each call is compared to an +-- expected edited output result string. +-- +-- Note: Each of the functions Valid, To_Picture, and Pic_String has +-- String (rather than Wide_String) as its parameter or result +-- subtype, since a picture String is not localizable. +-- +-- +-- CHANGE HISTORY: +-- 22 Jun 95 SAIC Initial prerelease version. +-- 22 Aug 95 SAIC Test name changed to CXF3002 (from CXF3401) to +-- conform with naming conventions. +-- 24 Feb 97 PWB.CTA Corrected picture strings and expected values. +--! + +with Ada.Wide_Text_IO.Editing; +with Report; + +procedure CXF3002 is +begin + + Report.Test ("CXF3002", "Check that the functionality contained " & + "in package Ada.Wide_Text_IO.Editing is " & + "available and produces correct results"); + + Test_Block: + declare + + use Ada.Wide_Text_IO; + + Number_Of_Decimal_Items : constant := 5; + Number_Of_Picture_Strings : constant := 4; + Number_Of_Expected_Results : constant := Number_Of_Decimal_Items * + Number_Of_Picture_Strings; + + Def_Cur : constant Wide_String := "$"; + Def_Fill : constant Wide_Character := '*'; + Def_Sep : constant Wide_Character := Editing.Default_Separator; + Def_Radix : constant Wide_Character := Editing.Default_Radix_Mark; + + type String_Pointer_Type is access String; + type Wide_String_Pointer_Type is access Wide_String; + + -- Define a decimal data type, and instantiate the Decimal_Output + -- generic package for the data type. + + type Decimal_Data_Type is delta 0.01 digits 16; + + package Wide_Ed_Out is + new Editing.Decimal_Output(Num => Decimal_Data_Type, + Default_Currency => Def_Cur, + Default_Fill => Def_Fill, + Default_Separator => Def_Sep, + Default_Radix_Mark => Def_Radix); + + -- Define types for the arrays of data that will hold the decimal data + -- values, picture strings, and expected edited output results. + + type Decimal_Data_Array_Type is + array (Integer range <>) of Decimal_Data_Type; + + type Picture_String_Array_Type is + array (Integer range <>) of String_Pointer_Type; + + type Edited_Output_Results_Array_Type is + array (Integer range <>) of Wide_String_Pointer_Type; + + -- Define the data arrays for this test. + + Decimal_Data : + Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) := + ( 1 => 5678.90, + 2 => -6789.01, + 3 => 0.00, + 4 => 0.20, + 5 => 3.45 + ); + + Picture_Strings : + Picture_String_Array_Type(1..Number_Of_Picture_Strings) := + ( 1 => new String'("-$$_$$9.99"), + 2 => new String'("-$$_$$$.$$"), + 3 => new String'("-ZZZZ.ZZ"), + 4 => new String'("-$$$_999.99") + ); + + + Edited_Output : + Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := + ( 1 => new Wide_String'(" $5,678.90"), + 2 => new Wide_String'(" $5,678.90"), + 3 => new Wide_String'(" 5678.90"), + 4 => new Wide_String'(" $5,678.90"), + + 5 => new Wide_String'("-$6,789.01"), + 6 => new Wide_String'("-$6,789.01"), + 7 => new Wide_String'("-6789.01"), + 8 => new Wide_String'("- $6,789.01"), + + 9 => new Wide_String'(" $0.00"), + 10 => new Wide_String'(" "), + 11 => new Wide_String'(" "), + 12 => new Wide_String'(" $ 000.00"), + + 13 => new Wide_String'(" $0.20"), + 14 => new Wide_String'(" $.20"), + 15 => new Wide_String'(" .20"), + 16 => new Wide_String'(" $ 000.20"), + + 17 => new Wide_String'(" $3.45"), + 18 => new Wide_String'(" $3.45"), + 19 => new Wide_String'(" 3.45"), + 20 => new Wide_String'(" $ 003.45") + ); + + TC_Picture : Editing.Picture; + TC_Loop_Count : Natural := 0; + + begin + + -- Compare string result of Image with expected edited output wide + -- string. + + Evaluate_Edited_Output: + for i in 1..Number_Of_Decimal_Items loop + for j in 1..Number_Of_Picture_Strings loop + + TC_Loop_Count := TC_Loop_Count + 1; + + -- Check on the validity of the picture strings prior to + -- processing. + + if Editing.Valid(Picture_Strings(j).all) then + + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(Picture_Strings(j).all); + + -- Check results of function Decimal_Output.Valid. + if not Wide_Ed_Out.Valid(Decimal_Data(i), TC_Picture) then + Report.Failed("Incorrect result from function Valid " & + "when examining the picture string that " & + "was produced from string " & + Integer'Image(j) & " in conjunction with " & + "decimal data item # " & Integer'Image(i)); + end if; + + -- Check results of function Editing.Pic_String. + if Editing.Pic_String(TC_Picture) /= Picture_Strings(j).all then + Report.Failed("Incorrect result from To_Picture/" & + "Pic_String conversion for picture " & + "string # " & Integer'Image(j)); + end if; + + -- Compare actual edited output result of Function Image with + -- the expected result. + + if Wide_Ed_Out.Image(Decimal_Data(i), TC_Picture) /= + Edited_Output(TC_Loop_Count).all + then + Report.Failed("Incorrect result from Function Image, " & + "when used with decimal data item # " & + Integer'Image(i) & + " and picture string # " & + Integer'Image(j)); + end if; + + else + Report.Failed("Picture String # " & Integer'Image(j) & + "reported as being invalid"); + end if; + + end loop; + end loop Evaluate_Edited_Output; + + exception + when Editing.Picture_Error => + Report.Failed ("Picture_Error raised in Test_Block"); + when Layout_Error => + Report.Failed ("Layout_Error raised in Test_Block"); + when others => + Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3002; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a new file mode 100644 index 000000000..7cfce618e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a @@ -0,0 +1,292 @@ +-- CXF3003.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 statically identifiable picture strings can be used to +-- produce correctly formatted edited output. +-- +-- TEST DESCRIPTION: +-- This test defines several picture strings that are statically +-- identifiable, (i.e., Pic : Picture := To_Picture("..."); ). +-- These picture strings are used in conjunction with decimal data +-- as parameters in calls to functions Valid and Image. These +-- functions are created by an instantiation of the generic package +-- Ada.Text_IO.Editing.Decimal_Output. +-- +-- +-- CHANGE HISTORY: +-- 04 Apr 96 SAIC Initial release for 2.1. +-- 13 Feb 97 PWB.CTA corrected incorrect picture strings. +--! + +with Report; +with Ada.Text_IO.Editing; +with Ada.Exceptions; + +procedure CXF3003 is +begin + + Report.Test ("CXF3003", "Check that statically identifiable " & + "picture strings can be used to produce " & + "correctly formatted edited output"); + + Test_Block: + declare + + use Ada.Exceptions; + use Ada.Text_IO.Editing; + + Def_Cur : constant String := "$"; + Def_Fill : constant Character := '*'; + Def_Sep : constant Character := Default_Separator; + Def_Radix : constant Character := + Ada.Text_IO.Editing.Default_Radix_Mark; + + type Str_Ptr is access String; + type Edited_Output_Array_Type is array (Integer range <>) of Str_Ptr; + + -- Define a decimal data type, and instantiate the Decimal_Output + -- generic package for the data type. + + type Decimal_Data_Type is delta 0.01 digits 16; + + package Image_IO is + new Decimal_Output(Num => Decimal_Data_Type, + Default_Currency => Def_Cur, + Default_Fill => '*', + Default_Separator => Default_Separator, + Default_Radix_Mark => Def_Radix); + + + type Decimal_Data_Array_Type is + array (Integer range <>) of Decimal_Data_Type; + + Decimal_Data : Decimal_Data_Array_Type(1..5) := + (1 => 1357.99, + 2 => -9029.01, + 3 => 0.00, + 4 => 0.20, + 5 => 3.45); + + -- Statically identifiable picture strings. + + Picture_1 : Picture := To_Picture("-$$_$$9.99"); + Picture_2 : Picture := To_Picture("-$$_$$$.$$"); + Picture_3 : Picture := To_Picture("-ZZZZ.ZZ"); + Picture_5 : Picture := To_Picture("-$$$_999.99"); + Picture_6 : Picture := To_Picture("-###**_***_**9.99"); + Picture_7 : Picture := To_Picture("-$**_***_**9.99"); + Picture_8 : Picture := To_Picture("-$$$$$$.$$"); + Picture_9 : Picture := To_Picture("-$$$$$$.$$"); + Picture_10 : Picture := To_Picture("+BBBZZ_ZZZ_ZZZ.ZZ"); + Picture_11 : Picture := To_Picture("--_---_---_--9"); + Picture_12 : Picture := To_Picture("-$_$$$_$$$_$$9.99"); + Picture_14 : Picture := To_Picture("$_$$9.99"); + Picture_15 : Picture := To_Picture("$$9.99"); + + + Picture_1_Output : Edited_Output_Array_Type(1..5) := + ( 1 => new String'(" $1,357.99"), + 2 => new String'("-$9,029.01"), + 3 => new String'(" $0.00"), + 4 => new String'(" $0.20"), + 5 => new String'(" $3.45")); + + Picture_2_Output : Edited_Output_Array_Type(1..5) := + (1 => new String'(" $1,357.99"), + 2 => new String'("-$9,029.01"), + 3 => new String'(" "), + 4 => new String'(" $.20"), + 5 => new String'(" $3.45")); + + Picture_3_Output : Edited_Output_Array_Type(1..5) := + (1 => new String'(" 1357.99"), + 2 => new String'("-9029.01"), + 3 => new String'(" "), + 4 => new String'(" .20"), + 5 => new String'(" 3.45")); + + Picture_5_Output : Edited_Output_Array_Type(1..5) := + (1 => new String'(" $1,357.99"), + 2 => new String'("- $9,029.01"), + 3 => new String'(" $ 000.00"), + 4 => new String'(" $ 000.20"), + 5 => new String'(" $ 003.45")); + + begin + + -- Check the results of function Valid, using the first five decimal + -- data items and picture strings. + + if not Image_IO.Valid(Decimal_Data(1), Picture_1) then + Report.Failed("Picture string 1 not valid"); + elsif not Image_IO.Valid(Decimal_Data(2), Picture_2) then + Report.Failed("Picture string 2 not valid"); + elsif not Image_IO.Valid(Decimal_Data(3), Picture_3) then + Report.Failed("Picture string 3 not valid"); + elsif not Image_IO.Valid(Decimal_Data(5), Picture_5) then + Report.Failed("Picture string 5 not valid"); + end if; + + + -- Check the results of function Image, using the picture strings + -- constructed above, with a variety of named vs. positional + -- parameter notation and defaulted parameters. + + for i in 1..5 loop + if Image_IO.Image(Item => Decimal_Data(i), Pic => Picture_1) /= + Picture_1_Output(i).all + then + Report.Failed("Incorrect result from function Image with " & + "decimal data item #" & Integer'Image(i) & ", " & + "combined with Picture_1 picture string." & + "Expected: " & Picture_1_Output(i).all & ", " & + "Found: " & + Image_IO.Image(Decimal_Data(i),Picture_1)); + end if; + + if Image_IO.Image(Decimal_Data(i), Pic => Picture_2) /= + Picture_2_Output(i).all + then + Report.Failed("Incorrect result from function Image with " & + "decimal data item #" & Integer'Image(i) & ", " & + "combined with Picture_2 picture string." & + "Expected: " & Picture_2_Output(i).all & ", " & + "Found: " & + Image_IO.Image(Decimal_Data(i),Picture_2)); + end if; + + if Image_IO.Image(Decimal_Data(i), Picture_3) /= + Picture_3_Output(i).all + then + Report.Failed("Incorrect result from function Image with " & + "decimal data item #" & Integer'Image(i) & ", " & + "combined with Picture_3 picture string." & + "Expected: " & Picture_3_Output(i).all & ", " & + "Found: " & + Image_IO.Image(Decimal_Data(i),Picture_3)); + end if; + + if Image_IO.Image(Decimal_Data(i), Picture_5) /= + Picture_5_Output(i).all + then + Report.Failed("Incorrect result from function Image with " & + "decimal data item #" & Integer'Image(i) & ", " & + "combined with Picture_5 picture string." & + "Expected: " & Picture_5_Output(i).all & ", " & + "Found: " & + Image_IO.Image(Decimal_Data(i),Picture_5)); + end if; + end loop; + + + if Image_IO.Image(Item => 123456.78, + Pic => Picture_6, + Currency => "$", + Fill => Def_Fill, + Separator => Def_Sep, + Radix_Mark => Def_Radix) /= " $***123,456.78" + then + Report.Failed("Incorrect result from Fn. Image using Picture_6"); + end if; + + if Image_IO.Image(123456.78, + Pic => Picture_7, + Currency => Def_Cur, + Fill => '*', + Separator => Def_Sep, + Radix_Mark => Def_Radix) /= " $***123,456.78" + then + Report.Failed("Incorrect result from Fn. Image using Picture_7"); + end if; + + if Image_IO.Image(0.0, + Picture_8, + Currency => "$", + Fill => '*', + Separator => Def_Sep, + Radix_Mark => Def_Radix) /= " " + then + Report.Failed("Incorrect result from Fn. Image using Picture_8"); + end if; + + if Image_IO.Image(0.20, + Picture_9, + Def_Cur, + Fill => Def_Fill, + Separator => Default_Separator, + Radix_Mark => Default_Radix_Mark) /= " $.20" + then + Report.Failed("Incorrect result from Fn. Image using Picture_9"); + end if; + + if Image_IO.Image(123456.00, + Picture_10, + "$", + '*', + Separator => Def_Sep, + Radix_Mark => Def_Radix) /= "+ 123,456.00" + then + Report.Failed("Incorrect result from Fn. Image using Picture_10"); + end if; + + if Image_IO.Image(-123456.78, + Picture_11, + Default_Currency, + Default_Fill, + Default_Separator, + Radix_Mark => Def_Radix) /= " -123,457" + then + Report.Failed("Incorrect result from Fn. Image using Picture_11"); + end if; + + if Image_IO.Image(123456.78, Picture_12, "$", '*', ',', '.') /= + " $123,456.78" + then + Report.Failed("Incorrect result from Fn. Image using Picture_12"); + end if; + + if Image_IO.Image(1.23, + Picture_14, + Currency => Def_Cur, + Fill => Def_Fill) /= " $1.23" + then + Report.Failed("Incorrect result from Fn. Image using Picture_14"); + end if; + + if Image_IO.Image(12.34, Pic => Picture_15) /= "$12.34" + then + Report.Failed("Incorrect result from Fn. Image using Picture_15"); + end if; + + exception + when The_Error : others => + Report.Failed("The following exception was raised in the " & + "Test_Block: " & Exception_Name(The_Error)); + end Test_Block; + + Report.Result; + +end CXF3003; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a new file mode 100644 index 000000000..146047bc8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a @@ -0,0 +1,257 @@ +-- CXF3004.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 statically identifiable picture strings can be used +-- in conjunction with function Image to produce output strings +-- appropriate to foreign currency representations. +-- +-- Check that statically identifiable picture strings will cause +-- function Image to raise Layout_Error under the appropriate +-- conditions. +-- +-- TEST DESCRIPTION: +-- This test defines several picture strings that are statically +-- identifiable, (i.e., Pic : Picture := To_Picture("..."); ). +-- These picture strings are used in conjunction with decimal data +-- as parameters in calls to function Image. +-- +-- +-- CHANGE HISTORY: +-- 11 Apr 96 SAIC Initial release for 2.1. +-- +--! + +with Report; +with Ada.Text_IO.Editing; +with Ada.Exceptions; + +procedure CXF3004 is +begin + + Report.Test ("CXF3004", "Check that statically identifiable " & + "picture strings will cause function Image " & + "to raise Layout_Error under appropriate " & + "conditions"); + + Test_Block: + declare + + use Ada.Exceptions; + use Ada.Text_IO.Editing; + + FF_Currency : constant String := "FF"; + DM_Currency : constant String := "DM"; + FF_Separator : constant Character := '.'; + DM_Separator : constant Character := ','; + FF_Radix : constant Character := ','; + DM_Radix : constant Character := '.'; + Blank_Fill : constant Character := ' '; + Star_Fill : constant Character := '*'; + + + -- Define a decimal data type, and instantiate the Decimal_Output + -- generic package for the data type. + + type Decimal_Data_Type is delta 0.01 digits 16; + + package Image_IO is + new Decimal_Output(Num => Decimal_Data_Type, + Default_Currency => "$", + Default_Fill => Star_Fill, + Default_Separator => Default_Separator, + Default_Radix_Mark => DM_Radix); + + + + -- The following decimal data items are used with picture strings + -- in evaluating use of foreign currency symbols. + + Dec_Data_1 : Decimal_Data_Type := 123456.78; + Dec_Data_2 : Decimal_Data_Type := 32.10; + Dec_Data_3 : Decimal_Data_Type := -1234.57; + Dec_Data_4 : Decimal_Data_Type := 123456.78; + Dec_Data_5 : Decimal_Data_Type := 12.34; + Dec_Data_6 : Decimal_Data_Type := 12.34; + Dec_Data_7 : Decimal_Data_Type := 12345.67; + + + -- Statically identifiable picture strings. + -- These strings are used in conjunction with non-default values + -- for Currency string, Radix mark, and Separator in calls to + -- function Image. + + Picture_1 : Picture := To_Picture("-###**_***_**9.99"); -- FF + Picture_2 : Picture := To_Picture("###z_ZZ9.99"); -- FF + Picture_3 : Picture := To_Picture("<<<<_<<<.<<###>"); -- DM + Picture_4 : Picture := To_Picture("-$_$$$_$$$_$$9.99"); -- DM + Picture_5 : Picture := To_Picture("$Zz9.99"); -- DM + Picture_6 : Picture := To_Picture("$$$9.99"); -- DM + Picture_7 : Picture := To_Picture("###_###_##9.99"); -- CHF + + + -- The following ten edited output strings correspond to the ten + -- foreign currency picture strings. + + Output_1 : constant String := " FF***123.456,78"; + Output_2 : constant String := " FF 32,10"; + Output_3 : constant String := " (1,234.57DM )"; + Output_4 : constant String := " DM123,456.78"; + Output_5 : constant String := "DM 12.34"; + Output_6 : constant String := " DM12.34"; + Output_7 : constant String := " CHF12,345.67"; + + + begin + + -- Check the results of function Image, using the picture strings + -- constructed above, in creating foreign currency edited output + -- strings. + + if Image_IO.Image(Item => Dec_Data_1, + Pic => Picture_1, + Currency => FF_Currency, + Fill => Star_Fill, + Separator => FF_Separator, + Radix_Mark => FF_Radix) /= Output_1 + then + Report.Failed("Incorrect result from Fn. Image using Picture_1"); + end if; + + if Image_IO.Image(Item => Dec_Data_2, + Pic => Picture_2, + Currency => FF_Currency, + Fill => Blank_Fill, + Separator => FF_Separator, + Radix_Mark => FF_Radix) /= Output_2 + then + Report.Failed("Incorrect result from Fn. Image using Picture_2"); + end if; + + if Image_IO.Image(Item => Dec_Data_3, + Pic => Picture_3, + Currency => DM_Currency, + Fill => Blank_Fill, + Separator => DM_Separator, + Radix_Mark => DM_Radix) /= Output_3 + then + Report.Failed("Incorrect result from Fn. Image using Picture_3"); + end if; + + if Image_IO.Image(Item => Dec_Data_4, + Pic => Picture_4, + Currency => DM_Currency, + Fill => Blank_Fill, + Separator => DM_Separator, + Radix_Mark => DM_Radix) /= Output_4 + then + Report.Failed("Incorrect result from Fn. Image using Picture_4"); + end if; + + if Image_IO.Image(Item => Dec_Data_5, + Pic => Picture_5, + Currency => DM_Currency, + Fill => Blank_Fill, + Separator => DM_Separator, + Radix_Mark => DM_Radix) /= Output_5 + then + Report.Failed("Incorrect result from Fn. Image using Picture_5"); + end if; + + if Image_IO.Image(Item => Dec_Data_6, + Pic => Picture_6, + Currency => DM_Currency, + Fill => Blank_Fill, + Separator => DM_Separator, + Radix_Mark => DM_Radix) /= Output_6 + then + Report.Failed("Incorrect result from Fn. Image using Picture_6"); + end if; + + if Image_IO.Image(Item => Dec_Data_7, + Pic => Picture_7, + Currency => "CHF", + Fill => Blank_Fill, + Separator => ',', + Radix_Mark => '.') /= Output_7 + then + Report.Failed("Incorrect result from Fn. Image using Picture_7"); + end if; + + + -- The following calls of Function Image, using the specific + -- decimal values and picture strings provided, will cause + -- a Layout_Error to be raised. + -- Note: The data and the picture strings used in the following + -- evaluations are not themselves erroneous, but when used in + -- combination will cause Layout_Error to be raised. + + Exception_Block_1 : + declare + Erroneous_Data_1 : Decimal_Data_Type := 12.34; + Erroneous_Picture_1 : Picture := To_Picture("9.99"); + N : constant Natural := Image_IO.Length(Erroneous_Picture_1); + TC_String : String(1..N); + begin + TC_String := Image_IO.Image(Erroneous_Data_1, Erroneous_Picture_1); + Report.Failed("Layout_Error not raised by combination of " & + "Erroneous_Picture_1 and Erroneous_Data_1"); + Report.Comment("Should never be printed: " & TC_String); + exception + when Ada.Text_IO.Layout_Error => null; -- OK, expected exception. + when The_Error : others => + Report.Failed + ("The following exception was incorrectly raised in " & + "Exception_Block_1: " & Exception_Name(The_Error)); + end Exception_Block_1; + + Exception_Block_2 : + declare + Erroneous_Data_2 : Decimal_Data_Type := -12.34; + Erroneous_Picture_2 : Picture := To_Picture("99.99"); + N : constant Natural := Image_IO.Length(Erroneous_Picture_2); + TC_String : String(1..N); + begin + TC_String := Image_IO.Image(Erroneous_Data_2, Erroneous_Picture_2); + Report.Failed("Layout_Error not raised by combination of " & + "Erroneous_Picture_2 and Erroneous_Data_2"); + Report.Comment("Should never be printed: " & TC_String); + exception + when Ada.Text_IO.Layout_Error => null; -- OK, expected exception. + when The_Error : others => + Report.Failed + ("The following exception was incorrectly raised in " & + "Exception_Block_2: " & Exception_Name(The_Error)); + end Exception_Block_2; + + exception + when The_Error : others => + Report.Failed("The following exception was raised in the " & + "Test_Block: " & Exception_Name(The_Error)); + end Test_Block; + + Report.Result; + +end CXF3004; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a new file mode 100644 index 000000000..202a6996e --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a @@ -0,0 +1,167 @@ +-- CXF3A01.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 function Ada.Text_IO.Editing.Valid returns False if +-- a) Pic_String is not a well-formed Picture string, or +-- b) the length of Pic_String exceeds Max_Picture_Length, or +-- c) Blank_When_Zero is True and Pic_String contains '*'; +-- Check that Valid otherwise returns True. +-- +-- TEST DESCRIPTION: +-- This test validates the results of function Editing.Valid under a +-- variety of conditions. Both valid and invalid picture strings are +-- provided as input parameters to the function. The use of the +-- Blank_When_Zero parameter is evaluated with strings that contain the +-- zero suppression character '*'. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A01.A +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A01 is +begin + + Report.Test ("CXF3A01", "Check that the Valid function from package " & + "Ada.Text_IO.Editing returns False for strings " & + "that fail to comply with the composition " & + "constraints defined for picture strings. " & + "Check that the Valid function returns True " & + "for strings that conform to the composition " & + "constraints defined for picture strings"); + + Test_Block: + declare + use FXF3A00; + use Ada.Text_IO; + begin + + -- Use a series of picture strings that conform to the composition + -- constraints to validate the Ada.Text_IO.Editing.Valid function. + -- The result for each of these calls should be True. + -- In all the following cases, the default value of the Blank_When_Zero + -- parameter is used. + + for i in 1..FXF3A00.Number_Of_Valid_Strings loop + + if not Editing.Valid(Pic_String => FXF3A00.Valid_Strings(i).all) + then + Report.Failed("Incorrect result from Function Valid using " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end if; + + end loop; + + + for i in 1..FXF3A00.Number_Of_Foreign_Strings loop + + if not Editing.Valid(Pic_String => FXF3A00.Foreign_Strings(i).all) + then + Report.Failed("Incorrect result from Function Valid using " & + "Foreign_String = " & + FXF3A00.Foreign_Strings(i).all); + end if; + + end loop; + + + -- Use a series of picture strings that violate one or more of the + -- composition constraints to validate the Ada.Text_IO.Editing.Valid + -- function. The result for each of these calls should be False. + -- In all the following cases, the default value of the Blank_When_Zero + -- parameter is used. + + for i in 1..FXF3A00.Number_Of_Invalid_Strings loop + + if Editing.Valid(Pic_String => FXF3A00.Invalid_Strings(i).all) + then + Report.Failed("Incorrect result from Function Valid using " & + "Invalid_String = " & + FXF3A00.Invalid_Strings(i).all); + end if; + + end loop; + + + -- In all the following cases, the default value of the Blank_When_Zero + -- parameter is overridden with a True actual parameter value. Using + -- valid picture strings that contain the '*' zero suppression character + -- when this parameter value is True must result in a False result + -- from function Valid. Valid picture strings that do not contain the + -- '*' character should return a function result of True with True + -- provided as the actual parameter to Blank_When_Zero. + + -- Check entries 1, 2, 25, 36 from the Valid_Strings array, all of + -- which contain the '*' zero suppression character. + + if Editing.Valid(Valid_Strings(1).all, Blank_When_Zero => True) or + Editing.Valid(Valid_Strings(2).all, Blank_When_Zero => True) or + Editing.Valid(Valid_Strings(25).all, Blank_When_Zero => True) or + Editing.Valid(Valid_Strings(36).all, Blank_When_Zero => True) + then + Report.Failed + ("Incorrect result from Function Valid when setting " & + "the value of the Blank_When_Zero parameter to True, " & + "and using picture strings with the '*' character"); + end if; + + + -- Check entries from the Valid_Strings array, none of + -- which contain the '*' zero suppression character. + + for i in 3..24 loop + + if not Editing.Valid(Pic_String => Valid_Strings(i).all, + Blank_When_Zero => True) + then + Report.Failed("Incorrect result from Function Valid when " & + "setting the value of the Blank_When_Zero " & + "parameter to True, and using picture strings " & + "without the '*' character, Valid_String = " & + FXF3A00.Valid_Strings(i).all); + end if; + + end loop; + + + exception + when others => Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A01; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a new file mode 100644 index 000000000..4231b56aa --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a @@ -0,0 +1,267 @@ +-- CXF3A02.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 function Ada.Text_IO.Editing.To_Picture raises +-- Picture_Error if the picture string provided as input parameter does +-- not conform to the composition constraints defined for picture +-- strings. +-- Check that when Pic_String is applied to To_Picture, the result +-- is equivalent to the actual string parameter of To_Picture; +-- Check that when Blank_When_Zero is applied to To_Picture, the result +-- is the same value as the Blank_When_Zero parameter of To_Picture. +-- +-- TEST DESCRIPTION: +-- This test validates that function Editing.To_Picture returns a +-- Picture result when provided a valid picture string, and raises a +-- Picture_Error exception when provided an invalid picture string +-- input parameter. In addition, the Picture result of To_Picture is +-- converted back to a picture string value using function Pic_String, +-- and the result of function Blank_When_Zero is validated based on the +-- value of parameter Blank_When_Zero used in the formation of the Picture +-- by function To_Picture. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A02.A +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 11 Mar 97 PWB.CTA Corrected invalid picture string and uppercase +-- problem. +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Ada.Strings.Maps; +with Ada.Strings.Fixed; +with Report; + +procedure CXF3A02 is + + Lower_Alpha : constant String := "abcdefghijklmnopqrstuvwxyz"; + Upper_Alpha : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + function UpperCase ( Source : String ) return String is + begin + return + Ada.Strings.Fixed.Translate + ( Source => Source, + Mapping => Ada.Strings.Maps.To_Mapping + ( From => Lower_Alpha, + To => Upper_Alpha ) ); + end UpperCase; + +begin + + Report.Test ("CXF3A02", "Check that the function " & + "Ada.Text_IO.Editing.To_Picture raises " & + "Picture_Error if the picture string provided " & + "as input parameter does not conform to the " & + "composition constraints defined for picture " & + "strings"); + + Test_Block: + declare + + use Ada.Text_IO; + use FXF3A00; + + TC_Picture : Editing.Picture; + TC_Blank_When_Zero : Boolean; + + begin + + + -- Validate that function To_Picture does not raise Picture_Error when + -- provided a valid picture string as an input parameter. + + for i in 1..FXF3A00.Number_Of_Valid_Strings loop + begin + TC_Picture := + Editing.To_Picture(Pic_String => Valid_Strings(i).all, + Blank_When_Zero => False ); + exception + when Editing.Picture_Error => + Report.Failed + ("Picture_Error raised by function To_Picture " & + "with a valid picture string as input parameter, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + when others => + Report.Failed("Unexpected exception raised - 1, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end; + end loop; + + + + -- Validate that function To_Picture raises Picture_Error when an + -- invalid picture string is provided as an input parameter. + -- Default value used for parameter Blank_When_Zero. + + for i in 1..FXF3A00.Number_Of_Invalid_Strings loop + begin + TC_Picture := + Editing.To_Picture(Pic_String => FXF3A00.Invalid_Strings(i).all); + Report.Failed + ("Picture_Error not raised by function To_Picture " & + "with an invalid picture string as input parameter, " & + "Invalid_String = " & FXF3A00.Invalid_Strings(i).all); + exception + when Editing.Picture_Error => null; -- OK, expected exception. + when others => + Report.Failed("Unexpected exception raised, " & + "Invalid_String = " & + FXF3A00.Invalid_Strings(i).all); + end; + end loop; + + + + -- Validate that To_Picture and Pic_String/Blank_When_Zero provide + -- "inverse" results. + + -- Use the default value of the Blank_When_Zero parameter (False) for + -- these evaluations (some valid strings have the '*' zero suppression + -- character, which would result in an invalid string if used with a + -- True value for the Blank_When_Zero parameter). + + for i in 1..FXF3A00.Number_Of_Valid_Strings loop + begin + + -- Format a picture string using function To_Picture. + + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + -- Reconvert the Picture result from To_Picture to a string value + -- using function Pic_String, and compare to the original string. + + if Editing.Pic_String(Pic => TC_Picture) /= + Uppercase (FXF3A00.Valid_Strings(i).all) + then + Report.Failed + ("Inverse result incorrect from Editing.Pic_String, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end if; + + -- Ensure that function Blank_When_Zero returns the correct value + -- of the Blank_When_Zero parameter used in forming the Picture + -- (default parameter value False used in call to To_Picture + -- above). + + if Editing.Blank_When_Zero(Pic => TC_Picture) then + Report.Failed + ("Inverse result incorrect from Editing.Blank_When_Zero, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end if; + + exception + when others => + Report.Failed("Unexpected exception raised - 2, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end; + end loop; + + + -- Specifically check that any lower case letters in the original + -- picture string have been converted to upper case form following + -- the To_Picture/Pic_String conversion (as shown in previous loop). + + declare + The_Picture : Editing.Picture; + The_Picture_String : constant String := "+bBbZz_zZz_Zz9.99"; + The_Expected_Result : constant String := "+BBBZZ_ZZZ_ZZ9.99"; + begin + -- Convert Picture String to Picture. + The_Picture := Editing.To_Picture(Pic_String => The_Picture_String); + + declare + -- Reconvert the Picture to a Picture String. + The_Result : constant String := Editing.Pic_String(The_Picture); + begin + if The_Result /= The_Expected_Result then + Report.Failed("Conversion to Picture/Reconversion to String " & + "did not produce expected result when Picture " & + "String had lower case letters"); + end if; + end; + end; + + + -- Use a value of True for the Blank_When_Zero parameter for the + -- following evaluations (picture strings that do not have the '*' zero + -- suppression character, which would result in an invalid string when + -- used here with a True value for the Blank_When_Zero parameter). + + for i in 3..24 loop + begin + + -- Format a picture string using function To_Picture. + + TC_Picture := + Editing.To_Picture(Pic_String => Valid_Strings(i).all, + Blank_When_Zero => True); + + -- Reconvert the Picture result from To_Picture to a string value + -- using function Pic_String, and compare to the original string. + + if Editing.Pic_String(Pic => TC_Picture) /= + UpperCase (FXF3A00.Valid_Strings(i).all) + then + Report.Failed + ("Inverse result incorrect from Editing.Pic_String, used " & + "on Picture formed with parameter Blank_When_Zero = True, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end if; + + -- Ensure that function Blank_When_Zero returns the correct value + -- of the Blank_When_Zero parameter used in forming the Picture + -- (default parameter value False overridden in call to + -- To_Picture above). + + if not Editing.Blank_When_Zero(Pic => TC_Picture) then + Report.Failed + ("Inverse result incorrect from Editing.Blank_When_Zero, " & + "used on a Picture formed with parameter Blank_When_Zero " & + "= True, Valid_String = " & FXF3A00.Valid_Strings(i).all); + end if; + + exception + when others => + Report.Failed("Unexpected exception raised - 3, " & + "Valid_String = " & FXF3A00.Valid_Strings(i).all); + end; + end loop; + + + exception + when others => Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A02; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a new file mode 100644 index 000000000..867096014 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a @@ -0,0 +1,429 @@ +-- CXF3A03.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 function Length in the generic package Decimal_Output +-- returns the number of characters in the edited output string +-- produced by function Image, for a particular decimal type, +-- currency string, and radix mark. +-- Check that function Valid in the generic package Decimal_Output +-- returns correct results based on the particular decimal value, +-- and the Picture and Currency string parameters. +-- +-- TEST DESCRIPTION: +-- This test uses two instantiations of package Decimal_Output, one +-- for decimal data with delta 0.01, the other for decimal data with +-- delta 1.0. The functions Length and Valid found in this generic +-- package are evaluated for each instantiation. +-- Function Length is examined with picture and currency string input +-- parameters of different sizes. +-- Function Valid is examined with a decimal type data item, picture +-- object, and currency string, for cases that are both valid and +-- invalid (Layout_Error would result from the particular items as +-- input parameters to function Image). +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A03.A +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A03 is +begin + + Report.Test ("CXF3A03", "Check that function Length returns the " & + "number of characters in the edited output " & + "string produced by function Image, for a " & + "particular decimal type, currency string, " & + "and radix mark. Check that function Valid " & + "returns correct results based on the " & + "particular decimal value, and the Picture " & + "and Currency string parameters"); + + Test_Block: + declare + + use Ada.Text_IO; + use FXF3A00; + + type Instantiation_Type is (NDP, TwoDP); + + -- Defaults used for all other generic parameters in these + -- instantiations. + package Pack_NDP is new Editing.Decimal_Output (Decimal_Type_NDP); + package Pack_2DP is new Editing.Decimal_Output (Decimal_Type_2DP); + + TC_Lower_Bound, + TC_Higher_Bound : Integer := 0; + + TC_Picture : Editing.Picture; + TC_US_String : constant String := "$"; + TC_FF_String : constant String := "FF"; + TC_DM_String : constant String := "DM"; + TC_CHF_String : constant String := "CHF"; + + + function Dollar_Sign_Present (Str : String) return Boolean is + begin + for i in 1..Str'Length loop + if Str(i) = '$' then + return True; + end if; + end loop; + return False; + end Dollar_Sign_Present; + + function V_Present (Str : String) return Boolean is + begin + for i in 1..Str'Length loop + if Str(i) = 'V' or Str(i) = 'v' then + return True; + end if; + end loop; + return False; + end V_Present; + + + function Accurate_Length (Pict_Str : String; + Inst : Instantiation_Type; + Currency_String : String) + return Boolean is + + TC_Length : Natural := 0; + TC_Currency_Length_Adjustment : Natural := 0; + TC_Radix_Adjustment : Natural := 0; + begin + + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(Pict_Str); + + -- Calculate the currency length adjustment. + if Dollar_Sign_Present (Editing.Pic_String(TC_Picture)) then + TC_Currency_Length_Adjustment := Currency_String'Length - 1; + end if; + + -- Calculate the Radix adjustment. + if V_Present (Editing.Pic_String(TC_Picture)) then + TC_Radix_Adjustment := 1; + end if; + + -- Calculate the length, using the version of Length that comes + -- from the appropriate instantiation of Decimal_Output, based + -- on the decimal type used in the instantiation. + if Inst = NDP then + TC_Length := Pack_NDP.Length(TC_Picture, + Currency_String); + else + TC_Length := Pack_2DP.Length(TC_Picture, + Currency_String); + end if; + + return TC_Length = Editing.Pic_String(TC_Picture)'Length + + TC_Currency_Length_Adjustment - + TC_Radix_Adjustment; + end Accurate_Length; + + + begin + + Length_Block: + begin + + -- The first 10 picture strings in the Valid_Strings array correspond + -- to data values of a decimal type with delta 0.01. + -- Note: The appropriate instantiation of the Decimal_Output package + -- (and therefore function Length) is used by function + -- Accurate_Length to calculate length. + + for i in 1..10 loop + if not Accurate_Length (FXF3A00.Valid_Strings(i).all, + TwoDP, + TC_US_String) + then + Report.Failed("Incorrect result from function Length, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_US_String & + " in evaluating picture string " & + FXF3A00.Valid_Strings(i).all ); + end if; + end loop; + + + -- Picture strings 17-20 in the Valid_Strings array correspond + -- to data values of a decimal type with delta 1.0. Again, the + -- instantiation of Decimal_Output used is based on this particular + -- decimal type. + + for i in 17..20 loop + if not Accurate_Length (FXF3A00.Valid_Strings(i).all, + NDP, + TC_US_String) + then + Report.Failed("Incorrect result from function Length, " & + "when used with a decimal type with delta 1.0 " & + "and with the currency string " & TC_US_String & + " in evaluating picture string " & + FXF3A00.Valid_Strings(i).all ); + end if; + end loop; + + + -- The first 4 picture strings in the Foreign_Strings array + -- correspond to data values of a decimal type with delta 0.01, + -- and to the currency string "FF" (two characters). + + for i in 1..FXF3A00.Number_of_FF_Strings loop + if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, + TwoDP, + TC_FF_String) + then + Report.Failed("Incorrect result from function Length, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_FF_String & + " in evaluating picture string " & + FXF3A00.Foreign_Strings(i).all ); + end if; + end loop; + + + -- Picture strings 5-9 in the Foreign_Strings array correspond + -- to data values of a decimal type with delta 0.01, and to the + -- currency string "DM" (two characters). + + TC_Lower_Bound := FXF3A00.Number_of_FF_Strings + 1; + TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + + FXF3A00.Number_of_DM_Strings; + + for i in TC_Lower_Bound..TC_Higher_Bound loop + if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, + TwoDP, + TC_DM_String) + then + Report.Failed("Incorrect result from function Length, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_DM_String & + " in evaluating picture string " & + FXF3A00.Foreign_Strings(i).all ); + end if; + end loop; + + + -- Picture string #10 in the Foreign_Strings array corresponds + -- to a data value of a decimal type with delta 0.01, and to the + -- currency string "CHF" (three characters). + + if not Accurate_Length (FXF3A00.Foreign_Strings(10).all, + TwoDP, + TC_CHF_String) + then + Report.Failed("Incorrect result from function Length, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & + TC_CHF_String); + end if; + + exception + when others => + Report.Failed("Unexpected exception raised in Length_Block"); + end Length_Block; + + + Valid_Block: + declare + + -- This offset value is used to align picture string and decimal + -- data values from package FXF3A00 for proper correspondence for + -- the evaluations below. + + TC_Offset : constant Natural := 10; + + begin + + -- The following four For Loops examine cases where the + -- decimal data/picture string/currency combinations used will + -- generate valid Edited Output strings. These combinations, when + -- provided to the Function Valid (from instantiations of + -- Decimal_Output), should result in a return result of True. + -- The particular instantiated version of Valid used in these loops + -- is that for decimal data with delta 0.01. + + -- The first 4 picture strings in the Foreign_Strings array + -- correspond to data values of a decimal type with delta 0.01, + -- and to the currency string "FF" (two characters). + + for i in 1..FXF3A00.Number_of_FF_Strings loop + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all); + + if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i), + TC_Picture, + TC_FF_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_FF_String & + " in evaluating picture string " & + FXF3A00.Foreign_Strings(i).all ); + end if; + end loop; + + + -- Picture strings 5-9 in the Foreign_Strings array correspond + -- to data values of a decimal type with delta 0.01, and to the + -- currency string "DM" (two characters). + + TC_Lower_Bound := FXF3A00.Number_of_FF_Strings + 1; + TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + + FXF3A00.Number_of_DM_Strings; + + for i in TC_Lower_Bound..TC_Higher_Bound loop + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all); + + if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i), + TC_Picture, + TC_DM_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_DM_String & + " in evaluating picture string " & + FXF3A00.Foreign_Strings(i).all ); + end if; + end loop; + + + -- Picture string #10 in the Foreign_Strings array corresponds + -- to a data value of a decimal type with delta 0.01, and to the + -- currency string "CHF" (three characters). + + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(10).all); + + if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + 10), + TC_Picture, + TC_CHF_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & + TC_CHF_String); + end if; + + + -- The following For Loop examines cases where the + -- decimal data/picture string/currency combinations used will + -- generate valid Edited Output strings. + -- The particular instantiated version of Valid used in this loop + -- is that for decimal data with delta 1.0; the others above have + -- been for decimal data with delta 0.01. + -- Note: TC_Offset is used here to align picture strings from the + -- FXF3A00.Valid_Strings table with the appropriate decimal + -- data in the FXF3A00.Data_With_NDP table. + + for i in 1..FXF3A00.Number_Of_NDP_Items loop + -- Create the picture object from the picture string. + TC_Picture := + Editing.To_Picture(FXF3A00.Valid_Strings(TC_Offset + i).all); + + if not Pack_NDP.Valid (FXF3A00.Data_With_NDP(i), + TC_Picture, + TC_US_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta .01 " & + "and with the currency string " & TC_US_String & + " in evaluating picture string " & + FXF3A00.Valid_Strings(i).all ); + end if; + end loop; + + + -- The following three evaluations of picture strings, used in + -- conjunction with the specific decimal values provided, will cause + -- Editing.Image to raise Layout_Error (to be examined in other + -- tests). Function Valid should return a False result for these + -- combinations. + -- The first two evaluations use the instantiation of Decimal_Output + -- with a decimal type with delta 0.01, while the last evaluation + -- uses the instantiation with decimal type with delta 1.0. + + for i in 1..FXF3A00.Number_of_Erroneous_Conditions loop + + -- Create the picture object from the picture string. + TC_Picture := + Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all); + + if i < 3 then -- Choose the appropriate instantiation. + if Pack_2DP.Valid(Item => FXF3A00.Erroneous_Data(i), + Pic => TC_Picture, + Currency => TC_US_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta " & + "0.01 and with the currency string " & + TC_US_String & + " in evaluating picture string " & + FXF3A00.Valid_Strings(i).all ); + end if; + else + if Pack_NDP.Valid(Item => FXF3A00.Decimal_Type_NDP( + FXF3A00.Erroneous_Data(i)), + Pic => TC_Picture, + Currency => TC_US_String) + then + Report.Failed("Incorrect result from function Valid, " & + "when used with a decimal type with delta " & + "1.0 and with the currency string " & + TC_US_String & + " in evaluating picture string " & + FXF3A00.Valid_Strings(i).all ); + end if; + end if; + end loop; + + exception + when others => + Report.Failed("Unexpected exception raised in Valid_Block"); + end Valid_Block; + + + exception + when others => Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A03; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a new file mode 100644 index 000000000..9eee39bb6 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a @@ -0,0 +1,293 @@ +-- CXF3A04.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 edited output string value returned by Function Image +-- is correct. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. These data tables are found in package FXF3A00. +-- +-- The results of the Image function are examined under a number of +-- circumstances. The generic package Decimal_Output is instantiated +-- twice, for decimal data with delta 0.01 and delta 1.0. Each version +-- of Image is called with both default parameters and user-provided +-- parameters. The results of each call to Image are compared to an +-- expected edited output result string. +-- +-- In addition, three calls to Image are designed to raise Layout_Error, +-- due to the combination of decimal value and picture string provided +-- as input parameters. If Layout_Error is not raised, or an alternate +-- exception is raised instead, test failure results. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A04.A +-- +-- +-- CHANGE HISTORY: +-- 22 JAN 95 SAIC Initial prerelease version. +-- 11 MAR 97 PWB.CTA Corrected incorrect index expression +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A04 is +begin + + Report.Test ("CXF3A04", "Check that the string value returned by " & + "Function Image is correct, based on the " & + "numerical data and picture formatting " & + "parameters provided to the function"); + + Test_Block: + declare + + use Ada.Text_IO; + + -- Instantiate the Decimal_Output generic package for the two data + -- types, using the default values for the Default_Currency, + -- Default_Fill, Default_Separator, and Default_Radix_Mark + -- parameters. + + package Pack_NDP is + new Editing.Decimal_Output (FXF3A00.Decimal_Type_NDP); + + package Pack_2DP is + new Editing.Decimal_Output (FXF3A00.Decimal_Type_2DP); + + TC_Currency : constant String := "$"; + TC_Fill : constant Character := '*'; + TC_Separator : constant Character := ','; + TC_Radix_Mark : constant Character := '.'; + + TC_Picture : Editing.Picture; + + + begin + + Two_Decimal_Place_Data: + -- Use a decimal fixed point type with delta 0.01 (two decimal places) + -- and valid picture strings. Evaluate the result of function Image + -- with the expected edited output result string. + declare + + TC_Loop_End : constant := -- 10 + FXF3A00.Number_Of_2DP_Items - FXF3A00.Number_Of_Foreign_Strings; + + begin + -- The first 10 picture strings in the Valid_Strings array + -- correspond to data values of a decimal type with delta 0.01. + + -- Compare string result of Image with expected edited output + -- string. Evaluate data using both default parameters of Image + -- and user-provided parameter values. + for i in 1..TC_Loop_End loop + + -- Create the picture object from the picture string. + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + -- Use the default parameters for this loop evaluation of Image. + if Pack_2DP.Image(FXF3A00.Data_With_2DP(i), TC_Picture) /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect result from Function Image, " & + "when used with a decimal type with delta " & + "0.01, picture string " & + FXF3A00.Valid_Strings(i).all & + ", and the default parameters of Image"); + end if; + + -- Use user-provided parameters for this loop evaluation of Image. + + if Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => TC_Currency, + Fill => TC_Fill, + Separator => TC_Separator, + Radix_Mark => TC_Radix_Mark) /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect result from Function Image, " & + "when used with a decimal type with delta " & + "0.01, picture string " & + FXF3A00.Valid_Strings(i).all & + ", and user-provided parameters"); + end if; + + end loop; + + exception + when others => + Report.Failed("Exception raised in Two_Decimal_Place_Data block"); + end Two_Decimal_Place_Data; + + + + No_Decimal_Place_Data: + -- Use a decimal fixed point type with delta 1.00 (no decimal places) + -- and valid picture strings. Evaluate the result of function Image + -- with the expected result string. + declare + + use Editing, FXF3A00; + + TC_Offset : constant := 10; + TC_Loop_Start : constant := TC_Offset + 1; -- 11 + TC_Loop_End : constant := TC_Loop_Start + + Number_Of_NDP_Items - 1; -- 22 + + begin + -- The following evaluations correspond to data values of a + -- decimal type with delta 1.0. + + -- Compare string result of Image with expected edited output + -- string. Evaluate data using both default parameters of Image + -- and user-provided parameter values. + -- Note: TC_Offset is used to align corresponding data the various + -- data tables in foundation package FXF3A00. + + for i in TC_Loop_Start..TC_Loop_End loop + + -- Create the picture object from the picture string. + TC_Picture := To_Picture(Valid_Strings(i).all); + + -- Use the default parameters for this loop evaluation of Image. + if not (Pack_NDP.Image(Data_With_NDP(i-TC_Offset), TC_Picture) = + Edited_Output(TC_Offset+i).all) + then + Report.Failed("Incorrect result from Function Image, " & + "when used with a decimal type with delta " & + "1.0, picture string " & + Valid_Strings(i).all & + ", and the default parameters of Image"); + end if; + + -- Use user-provided parameters for this loop evaluation of Image. + if Pack_NDP.Image(Item => Data_With_NDP(i - TC_Offset), + Pic => TC_Picture, + Currency => TC_Currency, + Fill => TC_Fill, + Separator => TC_Separator, + Radix_Mark => TC_Radix_Mark) /= + Edited_Output(TC_Offset+i).all + then + Report.Failed("Incorrect result from Function Image, " & + "when used with a decimal type with delta " & + "1.0, picture string " & + Valid_Strings(i).all & + ", and user-provided parameters"); + end if; + + end loop; + + exception + when others => + Report.Failed("Exception raised in No_Decimal_Place_Data block"); + end No_Decimal_Place_Data; + + + + Exception_Block: + -- The following three calls of Function Image, using the specific + -- decimal values and picture strings provided, will cause + -- a Layout_Error to be raised. + -- The first two evaluations use the instantiation of Decimal_Output + -- with a decimal type with delta 0.01, while the last evaluation + -- uses the instantiation with decimal type with delta 1.0. + + -- Note: The data and the picture strings used in the following + -- evaluations are not themselves erroneous, but when used in + -- combination will cause Layout_Error to be raised. + + begin + + for i in 1..FXF3A00.Number_Of_Erroneous_Conditions loop -- 1..3 + begin + -- Create the picture object from the picture string. + TC_Picture := + Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all); + + -- Layout_Error must be raised by the following calls to + -- Function Image. + + if i < 3 then -- Choose the appropriate instantiation. + declare + N : constant Natural := Pack_2DP.Length(TC_Picture); + TC_String : String(1..N); + begin + TC_String := Pack_2DP.Image(FXF3A00.Erroneous_Data(i), + TC_Picture); + end; + else + declare + use FXF3A00; + N : constant Natural := Pack_NDP.Length(TC_Picture, + TC_Currency); + TC_String : String(1..N); + begin + TC_String := + Pack_NDP.Image(Item => Decimal_Type_NDP( + Erroneous_Data(i)), + Pic => TC_Picture, + Currency => TC_Currency, + Fill => TC_Fill, + Separator => TC_Separator, + Radix_Mark => TC_Radix_Mark); + end; + end if; + + Report.Failed("Layout_Error not raised by combination " & + "# " & Integer'Image(i) & " " & + "of decimal data and picture string"); + + exception + when Layout_Error => null; -- Expected exception. + when others => + Report.Failed("Incorrect exception raised by combination " & + "# " & Integer'Image(i) & " " & + "of decimal data and picture string"); + end; + end loop; + + exception + when others => + Report.Failed("Unexpected exception raised in Exception_Block"); + end Exception_Block; + + + exception + when others => Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A04; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a new file mode 100644 index 000000000..3fb39332a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a @@ -0,0 +1,266 @@ +-- CXF3A05.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 Function Image produces correct results when provided +-- non-default parameters for Currency, Fill, Separator, and +-- Radix_Mark at either the time of package Decimal_Output instantiation, +-- or in a call to Image. Check non-default parameters that are +-- appropriate for foreign currency representations. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. These data tables are found in package FXF3A00. +-- +-- The results of the Image function, resulting from several different +-- instantiations of Decimal_Output, are compared with expected +-- edited output string results. The primary focus of this test is to +-- examine the effect of non-default parameters, provided during the +-- instantiation of package Decimal_Output, or provided as part of a +-- call to Function Image (that resulted from an instantiation of +-- Decimal_Output that used default parameters). The non-default +-- parameters provided correspond to foreign currency representations. +-- +-- For each picture string/decimal data combination examined, two +-- evaluations of Image are performed. These correspond to the two +-- methods of providing the appropriate non-default parameters described +-- above. Both forms of Function Image should produce the same expected +-- edited output string. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A05.A +-- +-- +-- CHANGE HISTORY: +-- 26 JAN 95 SAIC Initial prerelease version. +-- 17 FEB 97 PWB.CTA Correct array indices for Foreign_Strings array +-- references. +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A05 is +begin + + Report.Test ("CXF3A05", "Check that Function Image produces " & + "correct results when provided non-default " & + "parameters for Currency, Fill, Separator, " & + "and Radix_Mark, appropriate to foreign " & + "currency representations"); + + Test_Block: + declare + + use Ada.Text_IO; + + -- Instantiate the Decimal_Output generic package for the several + -- combinations of Default_Currency, Default_Fill, Default_Separator, + -- and Default_Radix_Mark. + + package Pack_Def is -- Uses default parameter values. + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP); + + package Pack_FF is + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP, + Default_Currency => "FF", + Default_Fill => '*', + Default_Separator => '.', + Default_Radix_Mark => ','); + + package Pack_DM is + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP, + Default_Currency => "DM", + Default_Fill => '*', + Default_Separator => ',', + Default_Radix_Mark => '.'); + + package Pack_CHF is + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP, + Default_Currency => "CHF", + Default_Fill => '*', + Default_Separator => ',', + Default_Radix_Mark => '.'); + + + TC_Picture : Editing.Picture; + TC_Start_Loop : constant := 11; + TC_End_Loop : constant := TC_Start_Loop + -- 20 + FXF3A00.Number_Of_Foreign_Strings - 1; + + begin + + -- In the case of each particular type of foreign string examined, + -- two versions of Function Image are examined. First, a version of + -- the function that originated from an instantiation of Decimal_Output + -- with non-default parameters is checked. This version of Image is + -- called making use of default parameters in the actual function call. + -- In addition, a version of Function Image is checked that resulted + -- from an instantiation of Decimal_Output using default parameters, + -- but which uses non-default parameters in the function call. + + for i in TC_Start_Loop..TC_End_Loop loop + + -- Create the picture object from the picture string. + + TC_Picture := Editing.To_Picture + (FXF3A00.Foreign_Strings(i - TC_Start_Loop + 1).all); + + -- Based on the ordering of the specific foreign picture strings + -- in the FXF3A00.Foreign_Strings table, the following conditional + -- is used to determine which type of currency is being examined + -- as the loop executes. + + if i < TC_Start_Loop + FXF3A00.Number_Of_FF_Strings then -- (11-14) + -- Process the FF picture strings. + + -- Check the result of Function Image from an instantiation + -- of Decimal_Output that provided non-default actual + -- parameters at the time of package instantiation, and uses + -- default parameters in the call of Image. + + if Pack_FF.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture) /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with FF " & + "related parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all); + end if; + + -- Check the result of Function Image that originated from + -- an instantiation of Decimal_Output where default parameters + -- were used at the time of package Instantiation, but where + -- non-default parameters are provided in the call of Image. + + if Pack_Def.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => "FF", + Fill => '*', + Separator => '.', + Radix_Mark => ',') /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with default " & + "parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all & + ", and FF related parameters in call to Image"); + end if; + + + elsif i < TC_Start_Loop + -- (15-19) + FXF3A00.Number_Of_FF_Strings + + FXF3A00.Number_Of_DM_Strings then + -- Process the DM picture strings. + + -- Non-default instantiation parameters, default function call + -- parameters. + + if Pack_DM.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture) /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with DM " & + "related parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all); + end if; + + -- Default instantiation parameters, non-default function call + -- parameters. + + if Pack_Def.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => "DM", + Fill => '*', + Separator => ',', + Radix_Mark => '.') /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with default " & + "parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all & + ", and DM related parameters in call to Image"); + end if; + + + else -- (i=20) + -- Process the CHF string. + + -- Non-default instantiation parameters, default function call + -- parameters. + + if Pack_CHF.Image(FXF3A00.Data_With_2DP(i), TC_Picture) /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with CHF " & + "related parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all); + end if; + + -- Default instantiation parameters, non-default function call + -- parameters. + + if Pack_Def.Image(FXF3A00.Data_With_2DP(i), + TC_Picture, + "CHF", + '*', + ',', + '.') /= + FXF3A00.Edited_Output(i).all + then + Report.Failed("Incorrect output from Function Image " & + "from package instantiated with default " & + "parameters, using picture string " & + FXF3A00.Foreign_Strings + (i - TC_Start_Loop + 1).all & + ", and CHF related parameters in call to Image"); + end if; + + end if; + + end loop; + + exception + when others => Report.Failed ("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A05; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a new file mode 100644 index 000000000..7b769ba96 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a @@ -0,0 +1,302 @@ +-- CXF3A06.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 Ada.Text_IO.Editing.Put and Ada.Text_IO.Put have the same +-- effect. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. These data tables are found in package FXF3A00. +-- +-- The testing approach used in this test is that of writing edited +-- output data to a text file, using two different approaches. First, +-- Ada.Text_IO.Put is used, with a call to an instantiated version of +-- Function Image supplied as the actual for parameter Item. The +-- second approach is to use a version of Function Put from an +-- instantiation of Ada.Text_IO.Editing.Decimal_Output, with the +-- appropriate parameters for decimal data, picture, and format +-- specific parameters. A call to New_Line follows each Put, so that +-- each entry is placed on a separate line in the text file. +-- +-- Edited output for decimal data with two decimal places is in the +-- first loop, and once the data has been written to the file, the +-- text file is closed, then opened in In_File mode. The edited +-- output data is read from the file, and data on successive lines +-- is compared with the expected edited output result. The edited +-- output data produced by both of the Put procedures should be +-- identical. +-- +-- This process is repeated for decimal data with no decimal places. +-- The file is reopened in Append_File mode, and the edited output +-- data is added to the file in the same manner as described above. +-- The file is closed, and reopened to verify the data written. +-- The data written above (with two decimal places) is skipped, then +-- the data to be verified is extracted as above and verified against +-- the expected edited output string values. +-- +-- APPLICABILITY CRITERIA: +-- This test is applicable only to implementations that support +-- external text files. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A06.A +-- +-- +-- CHANGE HISTORY: +-- 26 JAN 95 SAIC Initial prerelease version. +-- 26 FEB 97 PWB.CTA Made input buffers sufficiently long +-- and removed code depending on shorter buffers +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A06 is + use Ada; +begin + + Report.Test ("CXF3A06", "Check that Ada.Text_IO.Editing.Put and " & + "Ada.Text_IO.Put have the same effect"); + + Test_for_Text_IO_Support: + declare + Text_File : Ada.Text_IO.File_Type; + Text_Filename : constant String := Report.Legal_File_Name(1); + begin + + -- Use_Error will be raised if Text_IO operations or external files + -- are not supported. + + Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename); + + Test_Block: + declare + use Ada.Text_IO; + + -- Instantiate the Decimal_Output generic package for two + -- different decimal data types. + + package Pack_2DP is -- Uses decimal type with delta 0.01. + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP); + + package Pack_NDP is -- Uses decimal type with delta 1.0. + new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP, + Default_Currency => "$", + Default_Fill => '*', + Default_Separator => ',', + Default_Radix_Mark => '.'); + + TC_Picture : Editing.Picture; + TC_Start_Loop : constant := 1; + TC_End_Loop_1 : constant := FXF3A00.Number_Of_2DP_Items - -- 20-10 + FXF3A00.Number_Of_Foreign_Strings; + TC_End_Loop_2 : constant := FXF3A00.Number_Of_NDP_Items; -- 12 + TC_Offset : constant := FXF3A00.Number_Of_2DP_Items; -- 20 + + TC_String_1, TC_String_2 : String(1..255) := (others => ' '); + TC_Last_1, TC_Last_2 : Natural := 0; + + begin + + -- Use the two versions of Put, for data with two decimal points, + -- to write edited output strings to the text file. Use a separate + -- line for each string entry. + + for i in TC_Start_Loop..TC_End_Loop_1 loop -- 1..10 + + -- Create the picture object from the picture string. + + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + -- Use the Text_IO version of Put to place an edited output + -- string into a text file. Use default parameters in the call + -- to Image for Currency, Fill, Separator, and Radix_Mark. + + Text_IO.Put(Text_File, + Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture)); + Text_IO.New_Line(Text_File); + + -- Use the version of Put from the instantiation of + -- Decimal_Output to place an edited output string on a separate + -- line of the Text_File. Use default parameters for Currency, + -- Fill, Separator, and Radix_Mark. + + Pack_2DP.Put(File => Text_File, + Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture); + Text_IO.New_Line(Text_File); + + end loop; + + Text_IO.Close(Text_File); + + -- Reopen the text file in In_File mode, and verify the edited + -- output found on consecutive lines of the file. + + Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename); + + for i in TC_Start_Loop..TC_End_Loop_1 loop + -- Read successive lines in the text file. + Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1); + Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2); + + -- Compare the two strings for equality with the expected edited + -- output result. Failure results if strings don't match, or if + -- a reading error occurred from the attempted Get_Line resulting + -- from an improperly formed edited output string. + + if TC_String_1(1..TC_Last_1) /= FXF3A00.Edited_Output(i).all or + TC_String_2(1..TC_Last_2) /= FXF3A00.Edited_Output(i).all + then + Report.Failed("Failed comparison of two edited output " & + "strings from data with two decimal points " & + ", loop number = " & Integer'Image(i)); + end if; + end loop; + + Text_IO.Close(Text_File); + + -- Reopen the text file in Append_File mode. + -- Use the two versions of Put, for data with no decimal points, + -- to write edited output strings to the text file. Use a separate + -- line for each string entry. + + Text_IO.Open(Text_File, Text_IO.Append_File, Text_Filename); + + for i in TC_Start_Loop..TC_End_Loop_2 loop -- 1..12 + + -- Create the picture object from the picture string specific to + -- data with no decimal points. Use appropriate offset into the + -- Valid_Strings array to account for the string data used above. + + TC_Picture := + Editing.To_Picture(FXF3A00.Valid_Strings(i+TC_End_Loop_1).all); + + -- Use the Text_IO version of Put to place an edited output + -- string into a text file. Use non-default parameters in the + -- call to Image for Currency, Fill, Separator, and Radix_Mark. + + Text_IO.Put(Text_File, + Pack_NDP.Image(Item => FXF3A00.Data_With_NDP(i), + Pic => TC_Picture, + Currency => "$", + Fill => '*', + Separator => ',', + Radix_Mark => '.')); + Text_IO.New_Line(Text_File); + + -- Use the version of Put from the instantiation of + -- Decimal_Output to place an edited output string on a separate + -- line of the Text_File. Use non-default parameters for + -- Currency, Fill, Separator, and Radix_Mark. + + Pack_NDP.Put(File => Text_File, + Item => FXF3A00.Data_With_NDP(i), + Pic => TC_Picture, + Currency => "$", + Fill => '*', + Separator => ',', + Radix_Mark => '.'); + Text_IO.New_Line(Text_File); + + end loop; + + Text_IO.Close(Text_File); + + -- Reopen the text file in In_File mode, and verify the edited + -- output found on consecutive lines of the file. + + Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename); + + -- Read past data that has been verified above, skipping two lines + -- of the data file for each loop. + + for i in TC_Start_Loop..TC_End_Loop_1 loop -- 1..10 + Text_IO.Skip_Line(Text_File, 2); + end loop; + + -- Verify the last data set that was written to the file. + + for i in TC_Start_Loop..TC_End_Loop_2 loop -- 1..12 + Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1); + Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2); + + -- Compare the two strings for equality with the expected edited + -- output result. Failure results if strings don't match, or if + -- a reading error occurred from the attempted Get_Line resulting + -- from an improperly formed edited output string. + + if TC_String_1(1..TC_Last_1) /= + FXF3A00.Edited_Output(i+TC_Offset).all or + TC_String_2(1..TC_Last_2) /= + FXF3A00.Edited_Output(i+TC_Offset).all + then + Report.Failed("Failed comparison of two edited output " & + "strings from data with no decimal points " & + ", loop number = " & + Integer'Image(i)); + end if; + + end loop; + + exception + when others => Report.Failed("Exception raised in Test_Block"); + end Test_Block; + + -- Delete the external file. + if Text_IO.Is_Open (Text_File) then + Text_IO.Delete (Text_File); + else + Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename); + Text_IO.Delete (Text_File); + end if; + + exception + + -- Since Use_Error can be raised if, for the specified mode, + -- the environment does not support Text_IO operations, the + -- following handlers are included: + + when Text_IO.Use_Error => + Report.Not_Applicable ("Use_Error raised on Text_IO Create"); + + when Text_IO.Name_Error => + Report.Not_Applicable ("Name_Error raised on Text_IO Create"); + + when others => + Report.Failed ("Unexpected exception raised in Create block"); + + end Test_for_Text_IO_Support; + + Report.Result; + +end CXF3A06; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a new file mode 100644 index 000000000..7cb2c360c --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a @@ -0,0 +1,337 @@ +-- CXF3A07.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 Ada.Text_IO.Editing.Put and Ada.Strings.Fixed.Move +-- have the same effect in putting edited output results into string +-- variables. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. These data tables are found in package FXF3A00. +-- +-- The operation of the two above subprograms are examined twice, first +-- with the output of an edited output string to a receiving string +-- object of equal size, the other to a receiving string object of +-- larger size, where justification and padding are considered. +-- The procedure Editing.Put will place an edited output string into +-- a larger receiving string with right justification and blank fill. +-- Procedure Move has parameter control of justification and fill, and +-- in this test will mirror Put by specifying right justification and +-- blank fill. +-- +-- In the cases where the edited output string is of shorter length +-- than the receiving string object, a blank-filled constant string +-- will be catenated to the front of the expected edited output string +-- for comparison with the receiving string object, enabling direct +-- string comparison for result verification. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A07.A +-- +-- +-- CHANGE HISTORY: +-- 30 JAN 95 SAIC Initial prerelease version. +-- 11 MAR 97 PWB.CTA Fixed string lengths +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Ada.Strings.Fixed; +with Report; + +procedure CXF3A07 is +begin + + Report.Test ("CXF3A07", "Check that Ada.Text_IO.Editing.Put and " & + "Ada.Strings.Fixed.Move have the same " & + "effect in putting edited output results " & + "into string variables"); + Test_Block: + declare + + use Ada.Text_IO; + + -- Instantiate the Decimal_Output generic package for two + -- different decimal data types. + + package Pack_2DP is -- Uses decimal type with delta 0.01. + new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP); + + package Pack_NDP is -- Uses decimal type with delta 1.0. + new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP, + Default_Currency => "$", + Default_Fill => '*', + Default_Separator => ',', + Default_Radix_Mark => '.'); + + TC_Picture : Editing.Picture; + TC_Start_Loop : Integer := 0; + TC_End_Loop : Integer := 0; + TC_Offset : Integer := 0; + TC_Length : Natural := 0; + + TC_Put_String_20, -- Longer than the longest edited + TC_Move_String_20 : String(1..20); -- output string. + + TC_Put_String_17, -- Exact length of longest edited + TC_Move_String_17 : String(1..17); -- output string in 2DP-US data set. + + TC_Put_String_8, -- Exact length of longest edited + TC_Move_String_8 : String(1..8); -- output string in NDP-US data set. + + + begin + + -- Examine cases where the output string is longer than the length + -- of the edited output result. Use the instantiation of + -- Decimal_Output specific to data with two decimal places. + + TC_Start_Loop := 1; + TC_End_Loop := FXF3A00.Number_of_2DP_Items - -- 10 + FXF3A00.Number_Of_Foreign_Strings; + + for i in TC_Start_Loop..TC_End_Loop loop -- 1..10 + + -- Create the picture object from the picture string. + + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all, + Blank_When_Zero => False); + + -- Determine the actual length of the edited output string + -- that is expected from Put and Image. + + TC_Length := Pack_2DP.Length(Pic => TC_Picture, + Currency => "$"); + + -- Determine the difference in length between the receiving string + -- object and the expected length of the edited output string. + -- Define a blank filled string constant with length equal to this + -- length difference. + + declare + TC_Length_Diff : Integer := TC_Put_String_20'Length - + TC_Length; + TC_Buffer_String : constant String(1..TC_Length_Diff) := + (others => ' '); + begin + + -- Fill the two receiving string objects with edited output, + -- using the two different methods (Put and Move). + + Pack_2DP.Put(To => TC_Put_String_20, + Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => "$", + Fill => '*', + Separator => ',', + Radix_Mark => '.'); + + + Ada.Strings.Fixed.Move + (Source => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => "$", + Fill => '*', + Separator => ',', + Radix_Mark => '.'), + Target => TC_Move_String_20, + Drop => Ada.Strings.Error, + Justify => Ada.Strings.Right, + Pad => Ada.Strings.Space); + + -- Each receiving string object is now filled with the edited + -- output result, right justified. + -- Compare these two string objects with the expected edited + -- output value, which is appended to the blank filled string + -- whose length is the difference between the expected edited + -- output length and the length of the receiving strings. + + if TC_Buffer_String & FXF3A00.Edited_Output(i).all /= + TC_Put_String_20 or + TC_Buffer_String & FXF3A00.Edited_Output(i).all /= + TC_Move_String_20 + then + Report.Failed("Failed case where the output string is " & + "longer than the length of the edited " & + "output result, loop #" & Integer'Image(i)); + end if; + + exception + when Layout_Error => + Report.Failed("Layout_Error raised when the output string " & + "is longer than the length of the edited " & + "output result, loop #" & Integer'Image(i)); + when others => + Report.Failed("Exception raised when the output string is " & + "longer than the length of the edited " & + "output result, loop #" & Integer'Image(i)); + end; + end loop; + + + -- Repeat the above loop, but only evaluate three cases - those where + -- the length of the expected edited output string is the exact length + -- of the receiving strings (no justification will be required within + -- the string. This series of evaluations again uses decimal data + -- with two decimal places. + + for i in TC_Start_Loop..TC_End_Loop loop -- 1..10 + + case i is + when 1 | 5 | 7 => + + -- Create the picture object from the picture string. + TC_Picture := + Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + -- Fill the two receiving string objects with edited output, + -- using the two different methods (Put and Move). + -- Use default parameters in the various calls where possible. + + Pack_2DP.Put(To => TC_Put_String_17, + Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture); + + + Ada.Strings.Fixed.Move + (Source => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture), + Target => TC_Move_String_17); + + -- Each receiving string object is now filled with the edited + -- output result. Compare these two string objects with the + -- expected edited output value. + + if FXF3A00.Edited_Output(i).all /= TC_Put_String_17 or + FXF3A00.Edited_Output(i).all /= TC_Move_String_17 + then + Report.Failed("Failed case where the output string is " & + "the exact length of the edited output " & + "result, loop #" & Integer'Image(i)); + end if; + + when others => null; + end case; + end loop; + + + -- Evaluate a mix of cases, where the expected edited output string + -- length is either exactly as long or shorter than the receiving + -- output string parameter. This series of evaluations uses decimal + -- data with no decimal places. + + TC_Start_Loop := TC_End_Loop + 1; -- 11 + TC_End_Loop := TC_Start_Loop + -- 22 + FXF3A00.Number_of_NDP_Items - 1; + TC_Offset := FXF3A00.Number_of_Foreign_Strings; -- 10 + -- This offset is required due to the arrangement of data within the + -- tables found in FXF3A00. + + for i in TC_Start_Loop..TC_End_Loop loop -- 11..22 + + -- Create the picture object from the picture string. + + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + -- Determine the actual length of the edited output string + -- that is expected from Put and Image. + + TC_Length := Pack_NDP.Length(TC_Picture); + + -- Fill the two receiving string objects with edited output, + -- using the two different methods (Put and Move). + + Pack_NDP.Put(TC_Put_String_8, + FXF3A00.Data_With_NDP(i-TC_Offset), + TC_Picture); + + Ada.Strings.Fixed.Move + (Pack_NDP.Image(FXF3A00.Data_With_NDP(i-TC_Offset), TC_Picture), + TC_Move_String_8, + Ada.Strings.Error, + Ada.Strings.Right, + Ada.Strings.Space); + + -- Determine if there is a difference in length between the + -- receiving string object and the expected length of the edited + -- output string. If so, then define a blank filled string constant + -- with length equal to this length difference. + + if TC_Length < TC_Put_String_8'Length then + declare + TC_Length_Diff : Integer := TC_Put_String_8'Length - + TC_Length; + TC_Buffer_String : constant String(1..TC_Length_Diff) := + (others => ' '); + begin + + -- Each receiving string object is now filled with the edited + -- output result, right justified. + -- Compare these two string objects with the expected edited + -- output value, which is appended to the blank filled string + -- whose length is the difference between the expected edited + -- output length and the length of the receiving strings. + + if TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /= + TC_Put_String_8 or + TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /= + TC_Move_String_8 + then + Report.Failed("Failed case where the output string is " & + "longer than the length of the edited " & + "output result, loop #" & Integer'Image(i) & + ", using data with no decimal places"); + end if; + end; + else + + -- Compare these two string objects with the expected edited + -- output value, which is appended to the blank filled string + -- whose length is the difference between the expected edited + -- output length and the length of the receiving strings. + + if FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Put_String_8 or + FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Move_String_8 + then + Report.Failed("Failed case where the output string is " & + "the same length as the edited output " & + "result, loop #" & Integer'Image(i) & + ", using data with no decimal places"); + end if; + end if; + end loop; + + exception + when others => Report.Failed("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A07; diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a b/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a new file mode 100644 index 000000000..871ab5600 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a @@ -0,0 +1,289 @@ +-- CXF3A08.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 version of Ada.Text_IO.Editing.Put with an out +-- String parameter propagates Layout_Error if the edited output string +-- result of Put exceeds the length of the out String parameter. +-- +-- TEST DESCRIPTION: +-- This test is structured using tables of data, consisting of +-- numerical values, picture strings, and expected image +-- result strings. These data tables are found in package FXF3A00. +-- +-- This test examines the case of the out string parameter to Procedure +-- Put being insufficiently long to hold the entire edited output +-- string result of the procedure. In this case, Layout_Error is to be +-- raised. Test failure results if Layout_Error is not raised, or if an +-- exception other than Layout_Error is raised. +-- +-- A number of data combinations are examined, using instantiations +-- of Package Decimal_Output with different decimal data types and +-- both default and non-default parameters as generic actual parameters. +-- In addition, calls to Procedure Put are performed using default +-- parameters, non-default parameters, and non-default parameters that +-- override the generic actual parameters provided at the time of +-- instantiation of Decimal_Output. +-- +-- TEST FILES: +-- The following files comprise this test: +-- +-- FXF3A00.A (foundation code) +-- => CXF3A08.A +-- +-- +-- CHANGE HISTORY: +-- 31 JAN 95 SAIC Initial prerelease version. +-- +--! + +with FXF3A00; +with Ada.Text_IO.Editing; +with Report; + +procedure CXF3A08 is +begin + + Report.Test ("CXF3A08", "Check that the version of " & + "Ada.Text_IO.Editing.Put with an out " & + "String parameter propagates Layout_Error " & + "if the output string exceeds the length " & + "of the out String parameter"); + + Test_Block: + declare + + use Ada.Text_IO; + + -- Instantiate the Decimal_Output generic package for two + -- different decimal data types. + -- Uses decimal type with delta 0.01 and + package Pack_2DP is -- non-default generic actual parameters. + new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP, + Default_Currency => "$", + Default_Fill => '*', + Default_Separator => ',', + Default_Radix_Mark => '.'); + + package Pack_NDP is -- Uses decimal type with delta 1.0. + new Editing.Decimal_Output(FXF3A00.Decimal_Type_NDP); + + TC_Picture : Editing.Picture; + TC_Start_Loop : Integer := 0; + TC_End_Loop : Integer := 0; + TC_Offset : Integer := 0; + + TC_Short_String : String(1..4); -- Shorter than the shortest edited + -- output string result. + + begin + + -- Examine cases where the out string parameter is shorter than + -- the length of the edited output result. Use the instantiation of + -- Decimal_Output specific to data with two decimal places. + + TC_Start_Loop := 1; + TC_End_Loop := FXF3A00.Number_of_2DP_Items - -- 10 + FXF3A00.Number_Of_Foreign_Strings; + + for i in TC_Start_Loop..TC_End_Loop loop -- 1..10 + + -- Create the picture object from the picture string. + + TC_Picture := + Editing.To_Picture(Pic_String => FXF3A00.Valid_Strings(i).all, + Blank_When_Zero => False); + + -- The out parameter string provided in the call to Put is + -- shorter than the edited output result of the procedure. + -- This will result in a Layout_Error being raised and handled. + -- Test failure results from no exception being raised, or from + -- the wrong exception being raised. + + begin + + -- Use the instantiation of Decimal_Output specific to decimal + -- data with two decimal places, as well as non-default + -- parameters and named parameter association. + + Pack_2DP.Put(To => TC_Short_String, + Item => FXF3A00.Data_With_2DP(i), + Pic => TC_Picture, + Currency => "$", + Fill => '*', + Separator => ',', + Radix_Mark => '.'); + + -- Test failure if exception not raised. + + Report.Failed + ("Layout_Error not raised, decimal data with two decimal " & + "places, loop #" & Integer'Image(i)); + + exception + when Layout_Error => null; -- OK, expected exception. + when others => + Report.Failed + ("Incorrect exception raised, Layout_Error expected, " & + "decimal data with two decimal places, loop #" & + Integer'Image(i)); + end; + end loop; + + + -- Perform similar evaluations as above, but use the instantiation + -- of Decimal_Output specific to decimal data with no decimal places. + + TC_Start_Loop := TC_End_Loop + 1; -- 11 + TC_End_Loop := TC_Start_Loop + -- 22 + FXF3A00.Number_of_NDP_Items - 1; + TC_Offset := FXF3A00.Number_of_Foreign_Strings; -- 10 + -- This offset is required due to the arrangement of data within the + -- tables found in FXF3A00. + + for i in TC_Start_Loop..TC_End_Loop loop -- 11..22 + + -- Create the picture object from the picture string. + + TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all); + + begin + + -- Use the instantiation of Decimal_Output specific to decimal + -- data with no decimal places, as well as default parameters + -- and positional parameter association. + + Pack_NDP.Put(TC_Short_String, + FXF3A00.Data_With_NDP(i-TC_Offset), + TC_Picture); + + -- Test failure if exception not raised. + + Report.Failed + ("Layout_Error not raised, decimal data with no decimal " & + "places, loop #" & Integer'Image(i)); + + exception + when Layout_Error => null; -- OK, expected exception. + when others => + Report.Failed + ("Incorrect exception raised, Layout_Error expected, " & + "decimal data with no decimal places, loop #" & + Integer'Image(i)); + end; + + end loop; + + + -- Check that Layout_Error is raised by Put resulting from an + -- instantiation of Decimal_Output specific to foreign currency + -- representations. + -- Note: Both of the following evaluation sets use decimal data with + -- two decimal places. + + declare + + package Pack_FF is + new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP, + Default_Currency => "FF", + Default_Fill => '*', + Default_Separator => '.', + Default_Radix_Mark => ','); + + begin + + TC_Offset := FXF3A00.Number_Of_2DP_Items - -- 10 + FXF3A00.Number_Of_Foreign_Strings; + + for i in 1..FXF3A00.Number_Of_FF_Strings loop -- 1..4 + begin + + -- Create the picture object from the picture string. + TC_Picture := + Editing.To_Picture(FXF3A00.Foreign_Strings(i).all); + + Pack_FF.Put(To => TC_Short_String, + Item => FXF3A00.Data_With_2DP(i+TC_Offset), + Pic => TC_Picture); + + Report.Failed("Layout_Error was not raised by Put from " & + "an instantiation of Decimal_Output using " & + "non-default parameters specific to FF " & + "currency, loop #" & Integer'Image(i)); + + exception + when Layout_Error => null; -- OK, expected exception. + when others => + Report.Failed("Incorrect exception raised by Put from " & + "an instantiation of Decimal_Output using " & + "non-default parameters specific to FF " & + "currency, loop #" & Integer'Image(i)); + end; + end loop; + + + -- These evaluations use a version of Put resulting from a + -- non-default instantiation of Decimal_Output, but which has + -- specific foreign currency parameters provided in the call that + -- override the generic actual parameters provided at instantiation. + + TC_Offset := TC_Offset + FXF3A00.Number_Of_FF_Strings; -- 14 + + for i in 1..FXF3A00.Number_Of_DM_Strings loop -- 1..5 + begin + TC_Picture := + Editing.To_Picture(FXF3A00.Foreign_Strings + (i+FXF3A00.Number_Of_FF_Strings).all); + + Pack_2DP.Put(To => TC_Short_String, + Item => FXF3A00.Data_With_2DP(i+TC_Offset), + Pic => TC_Picture, + Currency => "DM", + Fill => '*', + Separator => ',', + Radix_Mark => '.'); + + Report.Failed("Layout_Error was not raised by Put using " & + "non-default parameters specific to DM " & + "currency, loop #" & Integer'Image(i)); + + exception + when Layout_Error => null; -- OK, expected exception. + when others => + Report.Failed("Incorrect exception raised by Put using " & + "non-default parameters specific to DM " & + "currency, loop #" & Integer'Image(i)); + end; + end loop; + + end; + + exception + when others => Report.Failed("Exception raised in Test_Block"); + end Test_Block; + + Report.Result; + +end CXF3A08; |