diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxf')
20 files changed, 0 insertions, 6661 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a b/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a deleted file mode 100644 index be7e5069252..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a +++ /dev/null @@ -1,261 +0,0 @@ --- 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 deleted file mode 100644 index 96d0a0a17d3..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a +++ /dev/null @@ -1,755 +0,0 @@ --- 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 deleted file mode 100644 index 984daa97bca..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a +++ /dev/null @@ -1,352 +0,0 @@ --- 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 deleted file mode 100644 index 133dc48e6c2..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a +++ /dev/null @@ -1,363 +0,0 @@ --- 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 deleted file mode 100644 index 9651384ce7e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a +++ /dev/null @@ -1,513 +0,0 @@ --- 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 deleted file mode 100644 index 71cd5bb31b5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a +++ /dev/null @@ -1,293 +0,0 @@ --- 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 deleted file mode 100644 index 002c59d6c8e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a +++ /dev/null @@ -1,448 +0,0 @@ --- 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 deleted file mode 100644 index e9977b0f502..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a +++ /dev/null @@ -1,354 +0,0 @@ --- 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 deleted file mode 100644 index 1b9abca153f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a +++ /dev/null @@ -1,192 +0,0 @@ --- 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 deleted file mode 100644 index 8444244ef5c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a +++ /dev/null @@ -1,231 +0,0 @@ --- 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 deleted file mode 100644 index 7cfce618e7c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a +++ /dev/null @@ -1,292 +0,0 @@ --- 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 deleted file mode 100644 index 146047bc824..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a +++ /dev/null @@ -1,257 +0,0 @@ --- 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 deleted file mode 100644 index 202a6996e32..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a +++ /dev/null @@ -1,167 +0,0 @@ --- 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 deleted file mode 100644 index 4231b56aa46..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a +++ /dev/null @@ -1,267 +0,0 @@ --- 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 deleted file mode 100644 index 86709601464..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a +++ /dev/null @@ -1,429 +0,0 @@ --- 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 deleted file mode 100644 index 9eee39bb694..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a +++ /dev/null @@ -1,293 +0,0 @@ --- 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 deleted file mode 100644 index 3fb39332a50..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a +++ /dev/null @@ -1,266 +0,0 @@ --- 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 deleted file mode 100644 index 7b769ba96bf..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a +++ /dev/null @@ -1,302 +0,0 @@ --- 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 deleted file mode 100644 index 7cb2c360c97..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a +++ /dev/null @@ -1,337 +0,0 @@ --- 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 deleted file mode 100644 index 871ab5600a9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a +++ /dev/null @@ -1,289 +0,0 @@ --- 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; |