diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa')
87 files changed, 0 insertions, 31680 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a b/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a deleted file mode 100644 index 9c7e25b977c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a +++ /dev/null @@ -1,507 +0,0 @@ --- CXA3001.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 character classification functions defined in --- package Ada.Characters.Handling produce correct results when provided --- constant arguments from package Ada.Characters.Latin_1. --- --- TEST DESCRIPTION: --- This test checks the character classification functions of package --- Ada.Characters.Handling. In the evaluation of each function, loops --- are constructed to examine the function with as many values of type --- Character (Ada.Characters.Latin_1 constants) as possible in an --- amount of code that is about equal to the amount of code required --- to examine the function with a few representative input values and --- endpoint values. --- The usage paradigm being demonstrated by this test is that of the --- functions being used to assign to boolean variables, as well as --- serving as boolean conditions. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 29 Apr 95 SAIC Fixed subtest checking Is_Graphic function. --- ---! - -with Ada.Characters.Latin_1; -with Ada.Characters.Handling; -with Report; - -procedure CXA3001 is - -begin - - Report.Test ("CXA3001", "Check that the character classification " & - "functions defined in package " & - "Ada.Characters.Handling produce " & - "correct results when provided constant " & - "arguments from package Ada.Characters.Latin_1"); - - Test_Block: - declare - - package AC renames Ada.Characters; - package ACH renames Ada.Characters.Handling; - - TC_Boolean : Boolean := False; - - begin - - -- Over the next six statements/blocks of code, evaluate functions - -- Is_Control and Is_Graphic with control character and non-control - -- character values. - - for i in Character'Pos(AC.Latin_1.NUL) .. - Character'Pos(AC.Latin_1.US) loop - if not ACH.Is_Control(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Control - 1"); - end if; - if ACH.Is_Graphic(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Graphic - 1"); - end if; - end loop; - - - for i in Character'Pos(AC.Latin_1.Space) .. - Character'Pos(AC.Latin_1.Tilde) loop - if not ACH.Is_Graphic(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Graphic - 2"); - end if; - if ACH.Is_Control(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Control - 2"); - end if; - end loop; - - - for i in Character'Pos(AC.Latin_1.Reserved_128) .. - Character'Pos(AC.Latin_1.APC) loop - if not ACH.Is_Control(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Control - 3"); - end if; - TC_Boolean := ACH.Is_Graphic(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect result from function Is_Graphic - 3"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.No_Break_Space) .. - Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop - TC_Boolean := ACH.Is_Control(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect result from function Is_Control - 4"); - TC_Boolean := False; - end if; - if not ACH.Is_Graphic(Character'Val(i)) then - Report.Failed ("Incorrect result from function Is_Graphic - 4"); - end if; - end loop; - - -- Check renamed constants. - - if not (ACH.Is_Control(AC.Latin_1.IS4) and - ACH.Is_Control(AC.Latin_1.IS3) and - ACH.Is_Control(AC.Latin_1.IS2) and - ACH.Is_Control(AC.Latin_1.IS1)) or - (ACH.Is_Control(AC.Latin_1.NBSP) or - ACH.Is_Control(AC.Latin_1.Paragraph_Sign) or - ACH.Is_Control(AC.Latin_1.Minus_Sign) or - ACH.Is_Control(AC.Latin_1.Ring_Above)) - then - Report.Failed ("Incorrect result from function Is_Control - 5"); - end if; - - if (ACH.Is_Graphic(AC.Latin_1.IS4) or - ACH.Is_Graphic(AC.Latin_1.IS3) or - ACH.Is_Graphic(AC.Latin_1.IS2) or - ACH.Is_Graphic(AC.Latin_1.IS1)) or - not (ACH.Is_Graphic(AC.Latin_1.NBSP) and - ACH.Is_Graphic(AC.Latin_1.Paragraph_Sign) and - ACH.Is_Graphic(AC.Latin_1.Minus_Sign) and - ACH.Is_Graphic(AC.Latin_1.Ring_Above)) - then - Report.Failed ("Incorrect result from function Is_Graphic - 5"); - end if; - - - -- Evaluate function Is_Letter with letter/non-letter inputs. - - for i in Character'Pos('A') .. Character'Pos('Z') loop - if not ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 1"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_Z) loop - if not ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 2"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. - Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop - if not ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 3"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop - if not ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 4"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop - if not ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 5"); - end if; - end loop; - - -- Check for rejection of non-letters. - for i in Character'Pos(AC.Latin_1.NUL) .. - Character'Pos(AC.Latin_1.Commercial_At) loop - if ACH.Is_Letter(Character'Val(i)) then - Report.Failed ("Incorrect Is_Letter result - 6"); - end if; - end loop; - - - -- Evaluate function Is_Lower with lower case/non-lower case inputs. - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_Z) loop - if not ACH.Is_Lower(Character'Val(i)) then - Report.Failed ("Incorrect Is_Lower result - 1"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_A_Grave) .. - Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop - if not ACH.Is_Lower(Character'Val(i)) then - Report.Failed ("Incorrect Is_Lower result - 2"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop - if not ACH.Is_Lower(Character'Val(i)) then - Report.Failed ("Incorrect Is_Lower result - 3"); - end if; - end loop; - - if ACH.Is_Lower('A') or - ACH.Is_Lower(AC.Latin_1.UC_Icelandic_Eth) or - ACH.Is_Lower(AC.Latin_1.Number_Sign) or - ACH.Is_Lower(AC.Latin_1.Cedilla) or - ACH.Is_Lower(AC.Latin_1.SYN) or - ACH.Is_Lower(AC.Latin_1.ESA) - then - Report.Failed ("Incorrect Is_Lower result - 4"); - end if; - - - -- Evaluate function Is_Upper with upper case/non-upper case inputs. - - for i in Character'Pos('A') .. Character'Pos('Z') loop - if not ACH.Is_Upper(Character'Val(i)) then - Report.Failed ("Incorrect Is_Upper result - 1"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. - Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop - if not ACH.Is_Upper(Character'Val(i)) then - Report.Failed ("Incorrect Is_Upper result - 2"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.UC_Icelandic_Thorn) loop - if not ACH.Is_Upper(Character'Val(i)) then - Report.Failed ("Incorrect Is_Upper result - 3"); - end if; - end loop; - - if ACH.Is_Upper('8') or - ACH.Is_Upper(AC.Latin_1.LC_A_Ring ) or - ACH.Is_Upper(AC.Latin_1.Dollar_Sign) or - ACH.Is_Upper(AC.Latin_1.Broken_Bar) or - ACH.Is_Upper(AC.Latin_1.ETB) or - ACH.Is_Upper(AC.Latin_1.VTS) - then - Report.Failed ("Incorrect Is_Upper result - 4"); - end if; - - - for i in Character'Pos('a') .. Character'Pos('z') loop - if ACH.Is_Upper(Character'Val(i)) then - Report.Failed ("Incorrect Is_Upper result - 5"); - end if; - end loop; - - - -- Evaluate function Is_Basic with basic/non-basic inputs. - -- (Note: Basic letters are those without diacritical marks.) - - for i in Character'Pos('A') .. Character'Pos('Z') loop - if not ACH.Is_Basic(Character'Val(i)) then - Report.Failed ("Incorrect Is_Basic result - 1"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_Z) loop - if not ACH.Is_Basic(Character'Val(i)) then - Report.Failed ("Incorrect Is_Basic result - 2"); - end if; - end loop; - - - if not (ACH.Is_Basic(AC.Latin_1.UC_AE_Diphthong) and - ACH.Is_Basic(AC.Latin_1.LC_AE_Diphthong) and - ACH.Is_Basic(AC.Latin_1.LC_German_Sharp_S) and - ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Eth) and - ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Thorn) and - ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Eth) and - ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Thorn)) - then - Report.Failed ("Incorrect Is_Basic result - 3"); - end if; - - -- Check for rejection of non-basics. - if ACH.Is_Basic(AC.Latin_1.UC_A_Tilde) or - ACH.Is_Basic(AC.Latin_1.LC_A_Grave) or - ACH.Is_Basic(AC.Latin_1.Ampersand) or - ACH.Is_Basic(AC.Latin_1.Yen_Sign) or - ACH.Is_Basic(AC.Latin_1.NAK) or - ACH.Is_Basic(AC.Latin_1.SS2) - then - Report.Failed ("Incorrect Is_Basic result - 4"); - end if; - - - - for i in Character'Pos(AC.Latin_1.NUL) .. - Character'Pos(AC.Latin_1.Commercial_At) loop - if ACH.Is_Basic(Character'Val(i)) then - Report.Failed ("Incorrect Is_Basic result - 5"); - end if; - end loop; - - - -- Evaluate functions Is_Digit and Is_Decimal_Digit (a rename of - -- Is_Digit) with decimal digit/non-digit inputs. - - - if not (ACH.Is_Digit('0') and - ACH.Is_Decimal_Digit('9')) or - ACH.Is_Digit ('a') or -- Hex digits. - ACH.Is_Decimal_Digit ('f') or - ACH.Is_Decimal_Digit ('A') or - ACH.Is_Digit ('F') - then - Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 1"); - end if; - - if ACH.Is_Digit (AC.Latin_1.Full_Stop) or - ACH.Is_Decimal_Digit (AC.Latin_1.Dollar_Sign) or - ACH.Is_Digit (AC.Latin_1.Number_Sign) or - ACH.Is_Decimal_Digit (AC.Latin_1.Left_Parenthesis) or - ACH.Is_Digit (AC.Latin_1.Right_Parenthesis) - then - Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 2"); - end if; - - - -- Evaluate functions Is_Hexadecimal_Digit with hexadecimal digit and - -- non-hexadecimal digit inputs. - - for i in Character'Pos('0') .. Character'Pos('9') loop - if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then - Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 1"); - end if; - end loop; - - for i in Character'Pos('A') .. Character'Pos('F') loop - if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then - Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 2"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_F) loop - if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then - Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 3"); - end if; - end loop; - - - if ACH.Is_Hexadecimal_Digit (AC.Latin_1.Minus_Sign) or - ACH.Is_Hexadecimal_Digit (AC.Latin_1.Hyphen) or - ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_G) or - ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_Z) or - ACH.Is_Hexadecimal_Digit ('G') or - ACH.Is_Hexadecimal_Digit (AC.Latin_1.Cent_Sign) or - ACH.Is_Hexadecimal_Digit (AC.Latin_1.Pound_Sign) - then - Report.Failed ("Incorrect Is_HexaDecimal_Digit result - 4"); - end if; - - - -- Evaluate functions Is_Alphanumeric and Is_Special with - -- letters, digits, and non-alphanumeric inputs. - - for i in Character'Pos(AC.Latin_1.NUL) .. - Character'Pos(AC.Latin_1.US) loop - if ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 1"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 1"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.Reserved_128) .. - Character'Pos(AC.Latin_1.APC) loop - TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Alphanumeric result - 2"); - TC_Boolean := False; - end if; - if ACH.Is_Special(Character'Val(i)) then - Report.Failed ("Incorrect Is_Special result - 2"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.Space) .. - Character'Pos(AC.Latin_1.Solidus) loop - TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Alphanumeric result - 3"); - TC_Boolean := False; - end if; - if not ACH.Is_Special(Character'Val(i)) then - Report.Failed ("Incorrect Is_Special result - 3"); - end if; - end loop; - - for i in Character'Pos('A') .. Character'Pos('Z') loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 4"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 4"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos('0') .. Character'Pos('9') loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 5"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 5"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_Z) loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 6"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 6"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.No_Break_Space) .. - Character'Pos(AC.Latin_1.Inverted_Question) loop - TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Alphanumeric result - 7"); - TC_Boolean := False; - end if; - if not ACH.Is_Special(Character'Val(i)) then - Report.Failed ("Incorrect Is_Special result - 7"); - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. - Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 8"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 8"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 9"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 9"); - TC_Boolean := False; - end if; - end loop; - - for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. - Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop - if not ACH.Is_Alphanumeric(Character'Val(i)) then - Report.Failed ("Incorrect Is_Alphanumeric result - 10"); - end if; - TC_Boolean := ACH.Is_Special(Character'Val(i)); - if TC_Boolean then - Report.Failed ("Incorrect Is_Special result - 10"); - TC_Boolean := False; - end if; - end loop; - - - exception - when others => Report.Failed ("Exception raised during processing"); - end Test_Block; - - - Report.Result; - -end CXA3001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a b/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a deleted file mode 100644 index 12d98fdfe70..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a +++ /dev/null @@ -1,318 +0,0 @@ --- CXA3002.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 conversion functions for Characters and Strings --- defined in package Ada.Characters.Handling provide correct results --- when given character/string input parameters. --- --- TEST DESCRIPTION: --- This test checks the output of the To_Lower, To_Upper, and --- To_Basic functions for both Characters and Strings. Each function --- is called with input parameters that are within the appropriate --- range of values, and also with values outside the specified --- range (i.e., lower case 'a' to To_Lower). The functions are also --- used in combination with one another, with the result of one function --- providing the actual input parameter value to another. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 22 Dec 94 SAIC Corrected evaluations of Functions In Combination. --- ---! - -with Ada.Characters.Latin_1; -with Ada.Characters.Handling; -with Report; - -procedure CXA3002 is - - package AC renames Ada.Characters; - package ACH renames Ada.Characters.Handling; - -begin - - Report.Test ("CXA3002", "Check that the conversion functions for " & - "Characters and Strings defined in package " & - "Ada.Characters.Handling provide correct " & - "results when given character/string input " & - "parameters"); - - - Character_Block: - declare - Offset : constant Integer := Character'Pos('a') - Character'Pos('A'); - begin - - -- Function To_Lower for Characters - - if ACH.To_Lower('A') /= 'a' or ACH.To_Lower('Z') /= 'z' then - Report.Failed ("Incorrect operation of function To_Lower - 1"); - end if; - - - for i in Character'Pos('A') .. Character'Pos('Z') loop - if ACH.To_Lower(Character'Val(i)) /= Character'Val(i + Offset) then - Report.Failed ("Incorrect operation of function To_Lower - 2"); - end if; - end loop; - - - if (ACH.To_Lower(AC.Latin_1.UC_A_Grave) /= - AC.Latin_1.LC_A_Grave) or - (ACH.To_Lower(AC.Latin_1.UC_Icelandic_Thorn) /= - AC.Latin_1.LC_Icelandic_Thorn) - then - Report.Failed ("Incorrect operation of function To_Lower - 3"); - end if; - - - if ACH.To_Lower('c') /= 'c' or - ACH.To_Lower('w') /= 'w' or - ACH.To_Lower(AC.Latin_1.CR) /= AC.Latin_1.CR or - ACH.To_Lower(AC.Latin_1.LF) /= AC.Latin_1.LF or - ACH.To_Lower(AC.Latin_1.Comma) /= AC.Latin_1.Comma or - ACH.To_Lower(AC.Latin_1.Question) /= AC.Latin_1.Question or - ACH.To_Lower('0') /= '0' or - ACH.To_Lower('9') /= '9' - then - Report.Failed ("Incorrect operation of function To_Lower - 4"); - end if; - - - --- Function To_Upper for Characters - - - if not (ACH.To_Upper('b') = 'B') and (ACH.To_Upper('y') = 'Y') then - Report.Failed ("Incorrect operation of function To_Upper - 1"); - end if; - - - for i in Character'Pos(AC.Latin_1.LC_A) .. - Character'Pos(AC.Latin_1.LC_Z) loop - if ACH.To_Upper(Character'Val(i)) /= Character'Val(i - Offset) then - Report.Failed ("Incorrect operation of function To_Upper - 2"); - end if; - end loop; - - - if (ACH.To_Upper(AC.Latin_1.LC_U_Diaeresis) /= - AC.Latin_1.UC_U_Diaeresis) or - (ACH.To_Upper(AC.Latin_1.LC_A_Ring) /= - AC.Latin_1.UC_A_Ring) - then - Report.Failed ("Incorrect operation of function To_Upper - 3"); - end if; - - - if not (ACH.To_Upper('F') = 'F' and - ACH.To_Upper('U') = 'U' and - ACH.To_Upper(AC.Latin_1.LC_German_Sharp_S) = - AC.Latin_1.LC_German_Sharp_S and - ACH.To_Upper(AC.Latin_1.LC_Y_Diaeresis) = - AC.Latin_1.LC_Y_Diaeresis) - then - Report.Failed ("Incorrect operation of function To_Upper - 4"); - end if; - - - --- Function To_Basic for Characters - - - if ACH.To_Basic(AC.Latin_1.LC_A_Circumflex) /= - ACH.To_Basic(AC.Latin_1.LC_A_Tilde) or - ACH.To_Basic(AC.Latin_1.LC_E_Grave) /= - ACH.To_Basic(AC.Latin_1.LC_E_Acute) or - ACH.To_Basic(AC.Latin_1.LC_I_Circumflex) /= - ACH.To_Basic(AC.Latin_1.LC_I_Diaeresis) or - ACH.To_Basic(AC.Latin_1.UC_O_Tilde) /= - ACH.To_Basic(AC.Latin_1.UC_O_Acute) or - ACH.To_Basic(AC.Latin_1.UC_U_Grave) /= - ACH.To_Basic(AC.Latin_1.UC_U_Acute) or - ACH.To_Basic(AC.Latin_1.LC_Y_Acute) /= - ACH.To_Basic(AC.Latin_1.LC_Y_Diaeresis) - then - Report.Failed ("Incorrect operation of function To_Basic - 1"); - end if; - - - if ACH.To_Basic('Y') /= 'Y' or - ACH.To_Basic(AC.Latin_1.LC_E_Acute) /= 'e' or - ACH.To_Basic('6') /= '6' or - ACH.To_Basic(AC.Latin_1.LC_R) /= 'r' - then - Report.Failed ("Incorrect operation of function To_Basic - 2"); - end if; - - - -- Using Functions (for Characters) in Combination - - - if (ACH.To_Upper(ACH.To_Lower('A')) /= 'A' ) or - (ACH.To_Upper(ACH.To_Lower(AC.Latin_1.UC_A_Acute)) /= - AC.Latin_1.UC_A_Acute ) - then - Report.Failed("Incorrect operation of functions in combination - 1"); - end if; - - - if ACH.To_Basic(ACH.To_Lower(ACH.To_Upper(AC.Latin_1.LC_U_Grave))) /= - 'u' - then - Report.Failed("Incorrect operation of functions in combination - 2"); - end if; - - - if ACH.To_Lower (ACH.To_Basic - (ACH.To_Upper(AC.Latin_1.LC_O_Diaeresis))) /= 'o' - then - Report.Failed("Incorrect operation of functions in combination - 3"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Character_Block"); - end Character_Block; - - - String_Block: - declare - - LC_String : constant String := "az" & - AC.Latin_1.LC_A_Grave & - AC.Latin_1.LC_C_Cedilla; - - UC_String : constant String := "AZ" & - AC.Latin_1.UC_A_Grave & - AC.Latin_1.UC_C_Cedilla; - - LC_Basic_String : constant String := "aei" & 'o' & 'u'; - - LC_NonBasic_String : constant String := AC.Latin_1.LC_A_Diaeresis & - AC.Latin_1.LC_E_Circumflex & - AC.Latin_1.LC_I_Acute & - AC.Latin_1.LC_O_Tilde & - AC.Latin_1.LC_U_Grave; - - UC_Basic_String : constant String := "AEIOU"; - - UC_NonBasic_String : constant String := AC.Latin_1.UC_A_Tilde & - AC.Latin_1.UC_E_Acute & - AC.Latin_1.UC_I_Grave & - AC.Latin_1.UC_O_Diaeresis & - AC.Latin_1.UC_U_Circumflex; - - LC_Special_String : constant String := "ab" & - AC.Latin_1.LC_German_Sharp_S & - AC.Latin_1.LC_Y_Diaeresis; - - UC_Special_String : constant String := "AB" & - AC.Latin_1.LC_German_Sharp_S & - AC.Latin_1.LC_Y_Diaeresis; - - begin - - -- Function To_Lower for Strings - - - if ACH.To_Lower (UC_String) /= LC_String or - ACH.To_Lower (LC_String) /= LC_String - then - Report.Failed ("Incorrect result from To_Lower for strings - 1"); - end if; - - - if ACH.To_Lower (UC_Basic_String) /= LC_Basic_String then - Report.Failed ("Incorrect result from To_Lower for strings - 2"); - end if; - - - -- Function To_Upper for Strings - - - if not (ACH.To_Upper (LC_String) = UC_String) then - Report.Failed ("Incorrect result from To_Upper for strings - 1"); - end if; - - - if ACH.To_Upper (LC_Basic_String) /= UC_Basic_String or - ACH.To_Upper (UC_String) /= UC_String - then - Report.Failed ("Incorrect result from To_Upper for strings - 2"); - end if; - - - if ACH.To_Upper (LC_Special_String) /= UC_Special_String then - Report.Failed ("Incorrect result from To_Upper for strings - 3"); - end if; - - - - -- Function To_Basic for Strings - - - if (ACH.To_Basic (LC_String) /= "azac") or - (ACH.To_Basic (UC_String) /= "AZAC") - then - Report.Failed ("Incorrect result from To_Basic for Strings - 1"); - end if; - - - if ACH.To_Basic (LC_NonBasic_String) /= LC_Basic_String then - Report.Failed ("Incorrect result from To_Basic for Strings - 2"); - end if; - - - if ACH.To_Basic (UC_NonBasic_String) /= UC_Basic_String then - Report.Failed ("Incorrect result from To_Basic for Strings - 3"); - end if; - - - -- Using Functions (for Strings) in Combination - - - if ACH.To_Upper(ACH.To_Lower(UC_Basic_String)) /= UC_Basic_String or - ACH.To_Lower(ACH.To_Upper(LC_Basic_String)) /= LC_Basic_String - then - Report.Failed ("Incorrect operation of functions in combination - 4"); - end if; - - - if (ACH.To_Basic(ACH.To_Lower(UC_NonBasic_String)) /= LC_Basic_String) or - (ACH.To_Basic(ACH.To_Upper(LC_NonBasic_String)) /= UC_Basic_String) - then - Report.Failed ("Incorrect operation of functions in combination - 5"); - end if; - - - exception - when others => Report.Failed ("Exception raised in String_Block"); - end String_Block; - - - Report.Result; - -end CXA3002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a b/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a deleted file mode 100644 index f469ef8b539..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a +++ /dev/null @@ -1,243 +0,0 @@ --- CXA3003.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 functions defined in package Ada.Characters.Handling --- for use in classifying and converting characters between the ISO 646 --- and type Character sets produce the correct results with both --- Character and String input values. --- --- TEST DESCRIPTION: --- This test is designed to exercise the classification and conversion --- functions (between Character and ISO_646 types) found in package --- Ada.Characters.Handling. Two subprograms are defined, a procedure for --- characters, a function for strings, that will utilize these functions --- to validate and change characters in variables. In the procedure, if --- a character argument is found to be outside the subtype ISO_646, this --- character is evaluated to determine whether it is also a letter. --- If it is a letter, the character is converted to a basic character and --- returned. If it is not a letter, the character is exchanged with an --- asterisk. In the case of the function subprogram designed for strings, --- if a character component of a string argument is outside the subtype --- ISO_646, that character is substituted with an asterisk. --- --- Arguments for the defined subprograms consist of ISO_646 characters, --- non-ISO_646 characters, strings with only ISO_646 characters, and --- strings with non-ISO_646 characters. The character and string values --- are then validated to determine that the expected results were --- obtained. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 29 Apr 95 SAIC Modified identifier string lengths. --- 31 Oct 95 SAIC Update and repair for ACVC 2.0.1. --- ---! - -with Ada.Characters.Latin_1; -with Ada.Characters.Handling; -with Report; - -procedure CXA3003 is - -begin - - Report.Test ("CXA3003", "Check that the functions defined in package " & - "Ada.Characters.Handling for use in " & - "classifying and converting characters " & - "between the ISO 646 and type Character sets " & - "produce the correct results with both " & - "Character and String input values" ); - - Test_Block: - declare - - -- ISO_646 Characters - - Char_1, - TC_Char_1 : Character := Ada.Characters.Latin_1.NUL; -- Control Char - Char_2, - TC_Char_2 : Character := Ada.Characters.Latin_1.Colon; -- Graphic Char - Char_3, - TC_Char_3 : Character := '4'; - Char_4, - TC_Char_4 : Character := 'Z'; - Char_5, - TC_Char_5 : Character := Ada.Characters.Latin_1.LC_W; -- w - - New_ISO_646_Char : Character := '*'; - - - -- Non-ISO_646 Characters - - Char_Array : array (6..10) of Character := - (Ada.Characters.Latin_1.SSA, - Ada.Characters.Latin_1.Cent_Sign, - Ada.Characters.Latin_1.Cedilla, - Ada.Characters.Latin_1.UC_A_Ring, - Ada.Characters.Latin_1.LC_A_Ring); - - TC_Char : constant Character := '*'; - - -- ISO_646 Strings - - Str_1, - TC_Str_1 : String (1..5) := "ABCDE"; - - Str_2, - TC_Str_2 : String (1..5) := "#$%^&"; - - - -- Non-ISO_646 Strings - - Str_3 : String (1..8) := "$123.45" & - Ada.Characters.Latin_1.Cent_Sign; - TC_Str_3 : String (1..8) := "$123.45*"; - - Str_4 : String (1..7) := "abc" & - Ada.Characters.Latin_1.Cedilla & - "efg"; - TC_Str_4 : String (1..7) := "abc*efg"; - - Str_5 : String (1..3) := Ada.Characters.Latin_1.LC_E_Grave & - Ada.Characters.Latin_1.LC_T & - Ada.Characters.Latin_1.LC_E_Acute; - TC_Str_5 : String (1..3) := "*t*"; - - --- - - procedure Validate_Character (Char : in out Character) is - -- If parameter Char is an ISO_646 character, Char will be returned, - -- otherwise the following constant will be returned. - Star : constant Ada.Characters.Handling.ISO_646 := - Ada.Characters.Latin_1.Asterisk; - begin - if Ada.Characters.Handling.Is_ISO_646(Char) then - -- Check that the Is_ISO_646 function provide a correct result. - if Character'Pos(Char) > 127 then - Report.Failed("Is_ISO_646 returns a false positive result"); - end if; - else - if Character'Pos(Char) < 128 then - Report.Failed("Is_ISO_646 returns a false negative result"); - end if; - end if; - -- Cross-check Is_ISO_646 with To_ISO_646. '*' will be returned - -- if Char is not in the ISO_646 set. - Char := Ada.Characters.Handling.To_ISO_646(Char, Star); - exception - when others => Report.Failed ("Exception in Validate_Character"); - end Validate_Character; - - --- - - function Validate_String (Str : String) return String is - New_ISO_646_Char : constant Ada.Characters.Handling.ISO_646 := - Ada.Characters.Latin_1.Asterisk; - begin - -- Checking that the string contains non-ISO_646 characters at this - -- point is not strictly necessary, since the function To_ISO_646 - -- will perform that check as part of its processing, and would - -- return the original string if no modification were necessary. - -- However, this format allows for the testing of both functions. - - if not Ada.Characters.Handling.Is_ISO_646(Str) then - return Ada.Characters.Handling.To_ISO_646 - (Item => Str, Substitute => New_ISO_646_Char); - else - return Str; - end if; - exception - when others => Report.Failed ("Exception in Validate_String"); - return Str; - end Validate_String; - - - begin - - -- Check each character in turn, and if the character does not belong - -- to the ISO_646 subset of type Character, replace it with an - -- asterisk. If the character is a member of the subset, the character - -- should be returned unchanged. - - Validate_Character (Char_1); - Validate_Character (Char_2); - Validate_Character (Char_3); - Validate_Character (Char_4); - Validate_Character (Char_5); - - if Char_1 /= TC_Char_1 or Char_2 /= TC_Char_2 or - Char_3 /= TC_Char_3 or Char_4 /= TC_Char_4 or - Char_5 /= TC_Char_5 - then - Report.Failed ("Incorrect ISO_646 character substitution"); - end if; - - -- Non-ISO_646 characters - - for i in 6..10 loop - Validate_Character (Char_Array(i)); - end loop; - - for i in 6..10 loop - if Char_Array(i) /= TC_Char then - Report.Failed ("Character position " & Integer'Image(i) & - " not replaced correctly"); - end if; - end loop; - - - - -- Check each string, and if the string contains characters that do not - -- belong to the ISO_646 subset of type Character, replace that character - -- in the string with an asterisk. If the string is comprised of only - -- ISO_646 characters, the string should be returned unchanged. - - - Str_1 := Validate_String (Str_1); - Str_2 := Validate_String (Str_2); - Str_3 := Validate_String (Str_3); - Str_4 := Validate_String (Str_4); - Str_5 := Validate_String (Str_5); - - - if Str_1 /= TC_Str_1 or - Str_2 /= TC_Str_2 or - Str_3 /= TC_Str_3 or - Str_4 /= TC_Str_4 or - Str_5 /= TC_Str_5 - then - Report.Failed ("Incorrect ISO_646 character substitution in string"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA3003; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a b/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a deleted file mode 100644 index ed2023e37e5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa3004.a +++ /dev/null @@ -1,235 +0,0 @@ --- CXA3004.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 functions defined in package Ada.Characters.Handling --- for classification of and conversion between Wide_Character and --- Character values produce correct results when given the appropriate --- Character and String inputs. --- --- TEST DESCRIPTION: --- This test demonstrates the functions defined in package --- Ada.Characters.Handling which provide for the classification of and --- conversion between Wide_Characters and Characters, in character --- variables and strings. --- Each of the functions is provided with input values that are of the --- appropriate range. The results of the function processing are --- subsequently evaluated. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations using the Latin_1 set as the --- definition of Character. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Dec 94 SAIC Corrected variable names. --- ---! - -with Report; -with Ada.Characters.Handling; - -procedure CXA3004 is -begin - - Report.Test ("CXA3004", "Check that the functions defined in package " & - "Ada.Characters.Handling for classification " & - "of and conversion between Wide_Character and " & - "Character values produce correct results " & - "when given the appropriate Character " & - "and String inputs"); - - Test_Block: - declare - - package ACH renames Ada.Characters.Handling; - - Char_End : Integer := 255; - WC_Start : Integer := 256; - Sub_Char : Character := '*'; - - Blank : Character := ' '; - First_Char : Character := Character'First; - Last_Char : Character := Character'Last; - F_Char : Character := 'F'; - - - First_Wide_Char : Wide_Character := Wide_Character'First; - Last_Non_Wide_Char : Wide_Character := Wide_Character'Val(Char_End); - First_Unique_Wide_Char : Wide_Character := Wide_Character'Val(WC_Start); - Last_Wide_Char : Wide_Character := Wide_Character'Last; - - A_String : String (1..3) := First_Char & 'X' & Last_Char; - A_Wide_String : Wide_String (1..3) := First_Wide_Char & - ACH.To_Wide_Character('X') & - ACH.To_Wide_Character(Last_Char); - - Unique_Wide_String : Wide_String (1..2) := First_Unique_Wide_Char & - Last_Wide_Char; - - Mixed_Wide_String : Wide_String (1..6) := ACH.To_Wide_Character('A') & - First_Wide_Char & - Last_Non_Wide_Char & - First_Unique_Wide_Char & - Last_Wide_Char & - ACH.To_Wide_Character('Z'); - - - Basic_Char : Character := 'A'; - Basic_Wide_Char : Wide_Character := 'A'; - Basic_String : String (1..6) := "ABCXYZ"; - Basic_Wide_String : Wide_String (1..6) := "ABCXYZ"; - - begin - - - -- Function Is_Character - - - if not ACH.Is_Character(First_Wide_Char) then - Report.Failed ("Incorrect result from Is_Character - 1"); - end if; - - - if ACH.Is_Character(First_Unique_Wide_Char) or - ACH.Is_Character(Last_Wide_Char) - then - Report.Failed ("Incorrect result from Is_Character - 2"); - end if; - - - -- Function Is_String - - - if not ACH.Is_String(A_Wide_String) then - Report.Failed ("Incorrect result from Is_String - 1"); - end if; - - - if ACH.Is_String(Unique_Wide_String) or - ACH.Is_String(Mixed_Wide_String) - then - Report.Failed ("Incorrect result from Is_String - 2"); - end if; - - - -- Function To_Character - - - -- Use default substitution character in call of To_Character. - - if ACH.To_Character(First_Wide_Char) /= First_Char or - ACH.To_Character(Last_Non_Wide_Char) /= Last_Char - then - Report.Failed ("Incorrect result from To_Character - 1"); - end if; - - - -- Provide a substitution character for use with To_Character. - - if ACH.To_Character(First_Unique_Wide_Char, Blank) /= Blank or - ACH.To_Character(First_Unique_Wide_Char, Sub_Char) /= Sub_Char or - ACH.To_Character(Last_Wide_Char) /= ' ' -- default - then - Report.Failed ("Incorrect result from To_Character - 2"); - end if; - - - -- Function To_String - - - if ACH.To_String(A_Wide_String) /= A_String then - Report.Failed ("Incorrect result from To_String - 1"); - end if; - - - if ACH.To_String(Unique_Wide_String, Sub_Char) /= "**" then - Report.Failed ("Incorrect result from To_String - 2"); - end if; - - - - if ACH.To_String(Mixed_Wide_String, Sub_Char) /= - ('A' & First_Char & Last_Char & "**" & 'Z') or - ACH.To_String(Mixed_Wide_String, Sub_Char) /= - (ACH.To_Character(Mixed_Wide_String(1), Sub_Char) & - ACH.To_Character(Mixed_Wide_String(2), Sub_Char) & - ACH.To_Character(Mixed_Wide_String(3), Sub_Char) & - ACH.To_Character(Mixed_Wide_String(4), Sub_Char) & - ACH.To_Character(Mixed_Wide_String(5), Sub_Char) & - ACH.To_Character(Mixed_Wide_String(6), Sub_Char)) - then - Report.Failed ("Incorrect result from To_String - 3"); - end if; - - - -- Function To_Wide_Character - - - if ACH.To_Wide_Character(Basic_Char) /= Basic_Wide_Char then - Report.Failed ("Incorrect result from To_Wide_Character"); - end if; - - - -- Function To_Wide_String - - - if not (ACH.To_Wide_String(Basic_String) = Basic_Wide_String) then - Report.Failed ("Incorrect result from To_Wide_String"); - end if; - - - -- Functions Used In Combination - - if not ACH.Is_Character (ACH.To_Wide_Character ( - ACH.To_Character(First_Wide_Char))) - then - Report.Failed ("Incorrect result from functions in combination - 1"); - end if; - - - if not ACH.Is_String(ACH.To_Wide_String(ACH.To_String(A_Wide_String))) - then - Report.Failed ("Incorrect result from functions in combination - 2"); - end if; - - - if ACH.To_String(ACH.To_Wide_Character('A') & - ACH.To_Wide_Character(F_Char) & - ACH.To_Wide_Character('Z')) /= "AFZ" - then - Report.Failed ("Incorrect result from functions in combination - 3"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA3004; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a deleted file mode 100644 index d850acd4a72..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a +++ /dev/null @@ -1,218 +0,0 @@ --- CXA4001.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 types, operations, and other entities defined within --- the package Ada.Strings.Maps are available and/or produce correct --- results. --- --- TEST DESCRIPTION: --- This test demonstrates the availability and function of the types and --- operations defined in package Ada.Strings.Maps. It demonstrates the --- use of these types and functions as they would be used in common --- programming practice. --- Character set creation, assignment, and comparison are evaluated --- in this test. Each of the functions provided in package --- Ada.Strings.Maps is utilized in creating or manipulating set objects, --- and the function results are evaluated for correctness. --- Character sequences are examined using the functions provided for --- manipulating objects of this type. Likewise, character maps are --- created, and their contents evaluated. Exception raising conditions --- from the function To_Mapping are also created. --- Note: Throughout this test, the set logical operators are printed in --- capital letters to enhance their visibility. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Strings.Maps; -with Report; - -procedure CXA4001 is - - use Ada.Strings; - use type Maps.Character_Set; - -begin - - Report.Test ("CXA4001", "Check that the types, operations, and other " & - "entities defined within the package " & - "Ada.Strings.Maps are available and/or produce " & - "correct results"); - - Test_Block: - declare - - MidPoint_Letter : constant := 13; - Last_Letter : constant := 26; - - Vowels : constant Maps.Character_Sequence := "aeiou"; - Quasi_Vowel : constant Character := 'y'; - - Alphabet : Maps.Character_Sequence (1..Last_Letter); - Half_Alphabet : Maps.Character_Sequence (1..MidPoint_Letter); - Inverse_Alphabet : Maps.Character_Sequence (1..Last_Letter); - - Alphabet_Set, - Consonant_Set, - Vowel_Set, - Full_Vowel_Set, - First_Half_Set, - Second_Half_Set : Maps.Character_Set; - - begin - - -- Load the alphabet string for use in creating sets. - - - for i in 0..12 loop - Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i); - end loop; - - for i in 0..25 loop - Alphabet(i+1) := Character'Val(Character'Pos('a') + i); - end loop; - - - -- Initialize a series of Character_Set objects. - - Alphabet_Set := Maps.To_Set(Alphabet); - Vowel_Set := Maps.To_Set(Vowels); - Full_Vowel_Set := Vowel_Set OR Maps.To_Set(Quasi_Vowel); - Consonant_Set := Vowel_Set XOR Alphabet_Set; - - First_Half_Set := Maps.To_Set(Half_Alphabet); - Second_Half_Set := Alphabet_Set XOR First_Half_Set; - - - -- Evaluation of Set objects, operators, and functions. - - if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then - Report.Failed("Incorrect set combinations using OR operator"); - end if; - - - for i in 1..5 loop - if not Maps.Is_In(Vowels(i), Vowel_Set) or - not Maps.Is_In(Vowels(i), Alphabet_Set) or - Maps.Is_In(Vowels(i), Consonant_Set) - then - Report.Failed("Incorrect function Is_In use with set " & - "combinations - " & Integer'Image(i)); - end if; - end loop; - - - if Maps.Is_Subset(Vowel_Set, First_Half_Set) or - Maps."<="(Vowel_Set, Second_Half_Set) or - not Maps.Is_Subset(Vowel_Set, Alphabet_Set) - then - Report.Failed("Incorrect set evaluation using Is_Subset function"); - end if; - - - if not (Full_Vowel_Set = Maps.To_Set("aeiouy")) then - Report.Failed("Incorrect result for ""="" set operator"); - end if; - - - if not ((Vowel_Set AND First_Half_Set) OR - (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then - Report.Failed - ("Incorrect result for AND, OR, or ""="" set operators"); - end if; - - - if (Alphabet_Set AND Maps.Null_Set) /= Maps.Null_Set or - (Alphabet_Set OR Maps.Null_Set) /= Alphabet_Set - then - Report.Failed("Incorrect result for AND or OR set operators"); - end if; - - - Vowel_Set := Full_Vowel_Set; - Vowel_Set := Vowel_Set AND (NOT Maps.To_Set(Quasi_Vowel)); - - if not (Vowels = Maps.To_Sequence(Vowel_Set)) then - Report.Failed("Incorrect Set to Sequence translation"); - end if; - - - for i in 1..26 loop - Inverse_Alphabet(i) := Alphabet(27-i); - end loop; - - declare - Inverse_Map : Maps.Character_Mapping := - Maps.To_Mapping(Alphabet, Inverse_Alphabet); - begin - if Maps.Value(Maps.Identity, 'b') /= Maps.Value(Inverse_Map,'y') - then - Report.Failed("Incorrect Inverse mapping"); - end if; - end; - - - -- Check that Translation_Error is raised when a character is - -- repeated in the parameter "From" string. - declare - Bad_Map : Maps.Character_Mapping; - begin - Bad_Map := Maps.To_Mapping(From => "aa", To => "yz"); - Report.Failed("Exception not raised with repeated character"); - exception - when Translation_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised in To_Mapping with " & - "a repeated character"); - end; - - - -- Check that Translation_Error is raised when the parameters of the - -- function To_Mapping are of unequal lengths. - declare - Bad_Map : Maps.Character_Mapping; - begin - Bad_Map := Maps.To_Mapping("abc", "yz"); - Report.Failed("Exception not raised with unequal parameter lengths"); - exception - when Translation_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised in To_Mapping with " & - "unequal parameter lengths"); - end; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a deleted file mode 100644 index 583621ab4d9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a +++ /dev/null @@ -1,182 +0,0 @@ --- CXA4002.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 subprograms defined in package Ada.Strings.Fixed are --- available, and that they produce correct results. Specifically, --- check the subprograms Index, "*" (string constructor function), --- Count, Trim, and Replace_Slice. --- --- TEST DESCRIPTION: --- This test demonstrates how certain Fixed string functions are used --- to eliminate specific substrings from portions of text. A procedure --- is defined that will take as parameters a source string along with --- a substring that is to be completely removed from the source string. --- The source string is parsed using the Index function, and any substring --- slices are replaced in the source string by a series of X's (based on --- the length of the substring.) --- Three lines of text are provided to this procedure, and the resulting --- substitutions are compared with expected results to validate the --- string processing. --- A global accumulator is updated with the number of occurrences of the --- substring in the source string. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Strings; -with Ada.Strings.Fixed; -with Ada.Strings.Maps; -with Report; - -procedure CXA4002 is - -begin - - Report.Test ("CXA4002", "Check that the subprograms defined in package " & - "Ada.Strings.Fixed are available, and that " & - "they produce correct results"); - - Test_Block: - declare - - TC_Total : Natural := 0; - Number_Of_Lines : constant := 3; - - type Restricted_Words_Array_Type is array (1..10) of String (1..10); - - Restricted_Words : Restricted_Words_Array_Type := - (" platoon", " marines ", " Marines ", - "north ", "south ", " east", - " beach ", " airport", "airfield ", - " road "); - - subtype Line_Of_Text_Type is String(1..25); - type Page_Of_Text_Type is array (1..Number_Of_Lines) - of Line_Of_Text_Type; - - Text_Page : Page_Of_Text_Type := ("The platoon of Marines ", - "moved south on the south ", - "road to the airfield. "); - - TC_Revised_Line_1 : constant String := "The XXXXXXX of XXXXXXX "; - TC_Revised_Line_2 : constant String := "moved XXXXX on the XXXXX "; - TC_Revised_Line_3 : constant String := "XXXX to the XXXXXXXX. "; - - --- - - procedure Censor (Source_String : in out String; - Pattern_String : in String) is - - -- Create a replacement string that is the same length as the - -- pattern string being removed. - Replacement : constant String := -- "*" - Ada.Strings.Fixed."*"(Pattern_String'Length, 'X'); - - Going : Ada.Strings.Direction := Ada.Strings.Forward; - Map : constant Ada.Strings.Maps.Character_Mapping := - Ada.Strings.Maps.Identity; - Start_Pos, - Index : Natural := Source_String'First; - - - begin -- Censor - - -- Accumulate count of total replacement operations. - - TC_Total := TC_Total + -- Count - Ada.Strings.Fixed.Count (Source => Source_String, - Pattern => Pattern_String, - Mapping => Map); - loop - - Index := Ada.Strings.Fixed.Index -- Index - (Source_String(Start_Pos..Source_String'Last), - Pattern_String, - Going, - Map); - - exit when Index = 0; -- No matches, exit loop. - - -- if a match was found, modify the substring. - Ada.Strings.Fixed.Replace_Slice -- Replace_Slice - (Source_String, - Index, - Index + Pattern_String'Length - 1, - Replacement); - Start_Pos := Index + Pattern_String'Length; - - end loop; - - end Censor; - - - begin - - -- Invoke Censor subprogram to cleanse text. - -- Loop through each line of text, and check for the presence of each - -- restricted word. - -- Use the Trim function to eliminate leading or trailing blanks from - -- the restricted word parameters. - - for Line in 1..Number_Of_Lines loop - for Word in Restricted_Words'Range loop - Censor (Text_Page(Line), - Ada.Strings.Fixed.Trim(Restricted_Words(Word), -- Trim - Ada.Strings.Both)); - end loop; - end loop; - - - -- Validate results. - - if TC_Total /= 6 then - Report.Failed ("Incorrect number of substitutions performed"); - end if; - - if Text_Page(1) /= TC_Revised_Line_1 then - Report.Failed ("Incorrect substitutions on Line 1"); - end if; - - if Text_Page(2) /= TC_Revised_Line_2 then - Report.Failed ("Incorrect substitutions on Line 2"); - end if; - - if Text_Page(3) /= TC_Revised_Line_3 then - Report.Failed ("Incorrect substitutions on Line 3"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a deleted file mode 100644 index cd57a929616..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a +++ /dev/null @@ -1,326 +0,0 @@ --- CXA4003.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 subprograms defined in package Ada.Strings.Fixed are --- available, and that they produce correct results. Specifically, --- check the subprograms Index, Index_Non_Blank, Head, Tail, Translate, --- Find_Token, Move, Overwrite, and Replace_Slice. --- --- TEST DESCRIPTION: --- This test demonstrates how certain fixed string operations could be --- used in string information processing. A procedure is defined that --- will extract portions of a 50 character string that correspond to --- certain data items (i.e., name, address, state, zip code). These --- parsed items will then be added to the appropriate fields of data --- base elements. These data base elements are then compared for --- accuracy against a similar set of predefined data base elements. --- --- A variety of fixed string processing subprograms are used in this --- test. Each parsing operation uses a different combination --- of the available subprograms to accomplish the same goal, therefore --- continuity of approach to string parsing is not seen in this test. --- However, a wide variety of possible approaches are demonstrated, while --- exercising a large number of the total predefined subprograms of --- package Ada.Strings.Fixed. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Strings.Fixed; -with Ada.Strings.Maps; -with Report; - -procedure CXA4003 is - -begin - - Report.Test ("CXA4003", "Check that the subprograms defined in package " & - "Ada.Strings.Fixed are available, and that they " & - "produce correct results"); - - Test_Block: - declare - - Number_Of_Info_Strings : constant Natural := 3; - DB_Size : constant Natural := Number_Of_Info_Strings; - Count : Natural := 0; - Finished_Processing : Boolean := False; - Blank_String : constant String := " "; - - subtype Info_String_Type is String (1..50); - type Info_String_Storage_Type is - array (1..Number_Of_Info_Strings) of Info_String_Type; - - - subtype Name_Type is String (1..10); - subtype Street_Number_Type is String (1..5); - subtype Street_Name_Type is String (1..10); - subtype City_Type is String (1..10); - subtype State_Type is String (1..2); - subtype Zip_Code_Type is String (1..5); - - type Data_Base_Element_Type is - record - Name : Name_Type := (others => ' '); - Street_Number : Street_Number_Type := (others => ' '); - Street_Name : Street_Name_Type := (others => ' '); - City : City_Type := (others => ' '); - State : State_Type := (others => ' '); - Zip_Code : Zip_Code_Type := (others => ' '); - end record; - - type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type; - - Data_Base : Data_Base_Type; - - --- - - Info_String_1 : Info_String_Type := - "Joe_Jones 123 Sixth_St San_Diego CA 98765"; - - Info_String_2 : Info_String_Type := - "Sam_Smith 56789 S._Seventh Carlsbad CA 92177"; - - Info_String_3 : Info_String_Type := - "Jane_Brown 1219 Info_Lane Tuscon AZ 85643"; - - - Info_Strings : Info_String_Storage_Type := (1 => Info_String_1, - 2 => Info_String_2, - 3 => Info_String_3); - - - - TC_DB_Element_1 : Data_Base_Element_Type := - ("Joe Jones ", "123 ", "Sixth St ", "San Diego ", "CA", "98765"); - - TC_DB_Element_2 : Data_Base_Element_Type := - ("Sam Smith ", "56789", "S. Seventh", "Carlsbad ", "CA", "92177"); - - TC_DB_Element_3 : Data_Base_Element_Type := - ("Jane Brown", "1219 ", "Info Lane ", "Tuscon ", "AZ", "85643"); - - TC_Data_Base : Data_Base_Type := (TC_DB_Element_1, - TC_DB_Element_2, - TC_DB_Element_3); - - --- - - - procedure Store_Information - (Info_String : in Info_String_Type; - DB_Record : in out Data_Base_Element_Type) is - - package AS renames Ada.Strings; - use type AS.Maps.Character_Set; - - UnderScore : AS.Maps.Character_Sequence := "_"; - Blank : AS.Maps.Character_Sequence := " "; - - Start, - Stop : Natural := 0; - - Underscore_to_Blank_Map : constant AS.Maps.Character_Mapping := - AS.Maps.To_Mapping(From => UnderScore, - To => Blank); - - Numeric_Set : constant AS.Maps.Character_Set := - AS.Maps.To_Set("0123456789"); - - Cal : constant AS.Maps.Character_Sequence := "CA"; - California_Set : constant AS.Maps.Character_Set := - AS.Maps.To_Set(Cal); - Arizona_Set : constant AS.Maps.Character_Set := - AS.Maps.To_Set("AZ"); - Nevada_Set : constant AS.Maps.Character_Set := - AS.Maps.To_Set("NV"); - - begin - - -- Find the starting position of the name field (first non-blank), - -- then, from that position, find the end of the name field (first - -- blank). - - Start := AS.Fixed.Index_Non_Blank(Info_String); - Stop := AS.Fixed.Index (Info_String(Start..Info_String'Length), - AS.Maps.To_Set(' '), - AS.Inside, - AS.Forward) - 1 ; - - -- Store the name field in the data base element field for "Name". - - DB_Record.Name := AS.Fixed.Head(Info_String(1..Stop), - DB_Record.Name'Length); - - -- Replace any underscore characters in the name field - -- that were used to separate first/middle/last names. - - AS.Fixed.Translate (DB_Record.Name, Underscore_to_Blank_Map); - - - -- Continue the extraction process; now find the position of - -- the street number in the string. - - Start := Stop + 1; - - AS.Fixed.Find_Token(Info_String(Start..Info_String'Length), - Numeric_Set, - AS.Inside, - Start, - Stop); - - -- Store the street number field in the appropriate data base - -- element. - -- No modification of the default parameters of procedure Move - -- is required. - - AS.Fixed.Move(Source => Info_String(Start..Stop), - Target => DB_Record.Street_Number); - - - -- Continue the extraction process; find the street name in the - -- info string. Skip blanks to the start of the street name, then - -- search for the index of the next blank character in the string. - - Start := - AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); - - Stop := - AS.Fixed.Index(Info_String(Start..Info_String'Length), - Blank_String) - 1; - - -- Store the street name in the appropriate data base element field. - - AS.Fixed.Overwrite(DB_Record.Street_Name, - 1, - Info_String(Start..Stop)); - - -- Replace any underscore characters in the street name field - -- that were used as word separation. - - DB_Record.Street_Name := AS.Fixed.Translate(DB_Record.Street_Name, - Underscore_to_Blank_Map); - - - -- Continue the extraction; remove the city name from the string. - - Start := - AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); - - Stop := - AS.Fixed.Index(Info_String(Start..Info_String'Length), - Blank_String) - 1; - - -- Store the city name field in the appropriate data base element. - - AS.Fixed.Replace_Slice(DB_Record.City, - 1, - DB_Record.City'Length, - Info_String(Start..Stop)); - - -- Replace any underscore characters in the city name field - -- that were used as word separation. - - AS.Fixed.Translate (DB_Record.City, Underscore_to_Blank_Map); - - - -- Continue the extraction; remove the state identifier from the - -- info string. - - Start := Stop + 1; - - AS.Fixed.Find_Token(Info_String(Start..Info_String'Length), - AS.Maps."OR"(California_Set, - AS.Maps."OR"(Nevada_Set, Arizona_Set)), - AS.Inside, - Start, - Stop); - - -- Store the state indicator into the data base element. - - AS.Fixed.Move(Source => Info_String(Start..Stop), - Target => DB_Record.State, - Drop => Ada.Strings.Right, - Justify => Ada.Strings.Left, - Pad => AS.Space); - - - -- Continue the extraction process; remove the final data item in - -- the info string, the zip code, and place it into the - -- corresponding data base element. - - DB_Record.Zip_Code := AS.Fixed.Tail(Info_String, - DB_Record.Zip_Code'Length); - - exception - when AS.Length_Error => - Report.Failed ("Length_Error raised in procedure"); - when AS.Pattern_Error => - Report.Failed ("Pattern_Error raised in procedure"); - when AS.Translation_Error => - Report.Failed ("Translation_Error raised in procedure"); - when others => - Report.Failed ("Exception raised in procedure"); - end Store_Information; - - - begin - - -- Loop thru the information strings, extract the name and address - -- information, place this info into elements of the data base. - - while not Finished_Processing loop - - Count := Count + 1; - - Store_Information (Info_Strings(Count), Data_Base(Count)); - - Finished_Processing := (Count = Number_Of_Info_Strings); - - end loop; - - - -- Verify that the string processing was successful. - - for i in 1..DB_Size loop - if Data_Base(i) /= TC_Data_Base(i) then - Report.Failed - ("Data processing error on record " & Integer'Image(i)); - end if; - end loop; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4003; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a deleted file mode 100644 index ec11f7d50f9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a +++ /dev/null @@ -1,431 +0,0 @@ --- CXA4004.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 subprograms defined in package Ada.Strings.Fixed are --- available, and that they produce correct results. Specifically, check --- the subprograms Count, Find_Token, Index, Index_Non_Blank, and Move. --- --- TEST DESCRIPTION: --- This test, when combined with tests CXA4002,3, and 5 will provide --- thorough coverage of the functionality found in Ada.Strings.Fixed. --- This test contains many small, specific test cases, situations that --- although common in user environments, are often difficult to generate --- in large numbers in a application-based test. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 10 Apr 95 SAIC Corrected subtest for Move, Drop=Right. --- ---! - -with Report; -with Ada.Strings; -with Ada.Strings.Fixed; -with Ada.Strings.Maps; - -procedure CXA4004 is -begin - - Report.Test("CXA4004", "Check that the subprograms defined in " & - "package Ada.Strings.Fixed are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASF renames Ada.Strings.Fixed; - package Maps renames Ada.Strings.Maps; - - Result_String : String(1..10) := (others => Ada.Strings.Space); - - Source_String1 : String(1..5) := "abcde"; -- odd length string - Source_String2 : String(1..6) := "abcdef"; -- even length string - Source_String3 : String(1..12) := "abcdefghijkl"; - Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad - Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad - Source_String6 : String(1..12) := "abcdefabcdef"; - - Location : Natural := 0; - Slice_Start : Positive; - Slice_End, - Slice_Count : Natural := 0; - - CD_Set : Maps.Character_Set := Maps.To_Set("cd"); - ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); - A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef"); - - CD_to_XY_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - begin - - -- Procedure Move - - -- Evaluate the Procedure Move with various combinations of - -- parameters. - - -- Justify = Left (default case) - - ASF.Move(Source => Source_String1, -- "abcde" - Target => Result_String); - - if Result_String /= "abcde " then - Report.Failed("Incorrect result from Move with Justify = Left"); - end if; - - -- Justify = Right - - ASF.Move(Source => Source_String2, -- "abcdef" - Target => Result_String, - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= " abcdef" then - Report.Failed("Incorrect result from Move with Justify = Right"); - end if; - - -- Justify = Center (two cases, odd and even pad lengths) - - ASF.Move(Source_String1, -- "abcde" - Result_String, - Ada.Strings.Error, - Ada.Strings.Center, - 'x'); -- non-default padding. - - if Result_String /= "xxabcdexxx" then -- Unequal padding added right - Report.Failed("Incorrect result from Move with Justify = Center-1"); - end if; - - ASF.Move(Source_String2, -- "abcdef" - Result_String, - Ada.Strings.Error, - Ada.Strings.Center); - - if Result_String /= " abcdef " then -- Equal padding added on L/R. - Report.Failed("Incorrect result from Move with Justify = Center-2"); - end if; - - -- When the source string is longer than the target string, several - -- cases can be examined, with the results depending on the value of - -- the Drop parameter. - - -- Drop = Left - - ASF.Move(Source => Source_String3, -- "abcdefghijkl" - Target => Result_String, - Drop => Ada.Strings.Left); - - if Result_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Move with Drop = Left"); - end if; - - -- Drop = Right - - ASF.Move(Source_String3, Result_String, Ada.Strings.Right); - - if Result_String /= "abcdefghij" then - Report.Failed("Incorrect result from Move with Drop = Right"); - end if; - - -- Drop = Error - -- The effect in this case depends on the value of the justify - -- parameter, and on whether any characters in Source other than - -- Pad would fail to be copied. - - -- Drop = Error, Justify = Left, right overflow characters are pad. - - ASF.Move(Source => Source_String4, -- "abcdefghij " - Target => Result_String, - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Left); - - if not(Result_String = "abcdefghij") then -- leftmost 10 characters - Report.Failed("Incorrect result from Move with Drop = Error - 1"); - end if; - - -- Drop = Error, Justify = Right, left overflow characters are pad. - - ASF.Move(Source_String5, -- " cdefghijkl" - Result_String, - Ada.Strings.Error, - Ada.Strings.Right); - - if Result_String /= "cdefghijkl" then -- rightmost 10 characters - Report.Failed("Incorrect result from Move with Drop = Error - 2"); - end if; - - -- In other cases of Drop=Error, Length_Error is propagated, such as: - - begin - - ASF.Move(Source_String3, -- 12 characters, no Pad. - Result_String, -- 10 characters - Ada.Strings.Error, - Ada.Strings.Left); - - Report.Failed("Length_Error not raised by Move - 1"); - - exception - when Ada.Strings.Length_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised by Move - 1"); - end; - - - - -- Function Index - -- (Other usage examples of this function found in CXA4002-3.) - -- Check when the pattern is not found in the source. - - if ASF.Index("abcdef", "gh") /= 0 or - ASF.Index("abcde", "abcdef") /= 0 or -- pattern > source - ASF.Index("xyz", - "abcde", - Ada.Strings.Backward) /= 0 or - ASF.Index("", "ab") /= 0 or -- null source string. - ASF.Index("abcde", " ") /= 0 -- blank pattern. - then - Report.Failed("Incorrect result from Index, no pattern match"); - end if; - - -- Check that Pattern_Error is raised when the pattern is the - -- null string. - begin - Location := ASF.Index(Source_String6, -- "abcdefabcdef" - "", -- null pattern string. - Ada.Strings.Forward); - Report.Failed("Pattern_Error not raised by Index"); - exception - when Ada.Strings.Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Index, null pattern"); - end; - - -- Use the search direction "backward" to locate the particular - -- pattern within the source string. - - Location := ASF.Index(Source_String6, -- "abcdefabcdef" - "de", -- slice 4..5, 10..11 - Ada.Strings.Backward); -- search from right end. - - if Location /= 10 then - Report.Failed("Incorrect result from Index going Backward"); - end if; - - -- Using the version of Index testing character set membership, - -- check combinations of forward/backward, inside/outside parameter - -- configurations. - - if ASF.Index(Source => Source_String1, -- "abcde" - Set => CD_Set, - Test => Ada.Strings.Inside, - Going => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3. - ASF.Index(Source_String6, -- "abcdefabcdef" - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Backward) /= 12 or -- 'f' at position 12 - ASF.Index(Source_String6, -- "abcdefabcdef" - CD_Set, - Ada.Strings.Inside, - Ada.Strings.Backward) /= 10 or -- 'd' at position 10 - ASF.Index("cdcdcdcdacdcdcdcd", - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Forward) /= 9 -- 'a' at position 9 - then - Report.Failed("Incorrect result from function Index for sets - 1"); - end if; - - -- Additional interesting uses/combinations using Index for sets. - - if ASF.Index("cd", -- same size, str-set - CD_Set, - Ada.Strings.Inside, - Ada.Strings.Forward) /= 1 or -- 'c' at position 1 - ASF.Index("abcd", -- same size, str-set, - Maps.To_Set("efgh"), -- different contents. - Ada.Strings.Outside, - Ada.Strings.Forward) /= 1 or - ASF.Index("abccd", -- set > string - Maps.To_Set("acegik"), - Ada.Strings.Inside, - Ada.Strings.Backward) /= 4 or -- 'c' at position 4 - ASF.Index("abcde", - Maps.Null_Set) /= 0 or - ASF.Index("", -- Null string. - CD_Set) /= 0 or - ASF.Index("abc ab", -- blank included - Maps.To_Set("e "), -- in string and set. - Ada.Strings.Inside, - Ada.Strings.Backward) /= 4 -- blank in string. - then - Report.Failed("Incorrect result from function Index for sets - 2"); - end if; - - - - -- Function Index_Non_Blank. - -- (Other usage examples of this function found in CXA4002-3.) - - - if ASF.Index_Non_Blank(Source => Source_String4, -- "abcdefghij " - Going => Ada.Strings.Backward) /= 10 or - ASF.Index_Non_Blank("abc def ghi jkl ", - Ada.Strings.Backward) /= 15 or - ASF.Index_Non_Blank(" abcdef") /= 3 or - ASF.Index_Non_Blank(" ") /= 0 - then - Report.Failed("Incorrect result from Index_Non_Blank"); - end if; - - - - -- Function Count - -- (Other usage examples of this function found in CXA4002-3.) - - if ASF.Count("abababa", "aba") /= 2 or - ASF.Count("abababa", "ab" ) /= 3 or - ASF.Count("babababa", "ab") /= 3 or - ASF.Count("abaabaaba", "aba") /= 3 or - ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy") /= 1 or - ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x") /= 20 - then - Report.Failed("Incorrect result from Function Count"); - end if; - - -- Determine the number of slices of Source that when mapped to a - -- non-identity map, match the pattern string. - - Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef" - "xy", - CD_to_XY_Map); -- maps 'c' to 'x', 'd' to 'y' - - if Slice_Count /= 2 then -- two slices "xy" in "mapped" Source_String6 - Report.Failed("Incorrect result from Count with non-identity map"); - end if; - - -- If the pattern supplied to Function Count is the null string, then - -- Pattern_Error is propagated. - - declare - The_Null_String : constant String := ""; - begin - Slice_Count := ASF.Count(Source_String6, The_Null_String); - Report.Failed("Pattern_Error not raised by Function Count"); - exception - when Ada.Strings.Pattern_Error => null; -- OK - when others => - Report.Failed("Incorrect exception from Count with null pattern"); - end; - - - -- Function Count returning the number of characters in a particular - -- set that are found in source string. - - if ASF.Count(Source_String6, CD_Set) /= 4 then -- 2 'c' and 'd' chars. - Report.Failed("Incorrect result from Count with set"); - end if; - - - - -- Function Find_Token. - -- (Other usage examples of this function found in CXA4002-3.) - - ASF.Find_Token(Source => Source_String6, -- First slice with no - Set => ABCD_Set, -- 'a', 'b', 'c', or 'd' - Test => Ada.Strings.Outside, -- is "ef" at 5..6. - First => Slice_Start, - Last => Slice_End); - - if Slice_Start /= 5 or Slice_End /= 6 then - Report.Failed("Incorrect result from Find_Token - 1"); - end if; - - -- If no appropriate slice is contained by the source string, then the - -- value returned in Last is zero, and the value in First is - -- Source'First. - - ASF.Find_Token(Source_String6, -- "abcdefabcdef" - A_to_F_Set, -- Set of characters 'a' thru 'f'. - Ada.Strings.Outside, -- No characters outside this set. - Slice_Start, - Slice_End); - - if Slice_Start /= Source_String6'First or Slice_End /= 0 then - Report.Failed("Incorrect result from Find_Token - 2"); - end if; - - -- Additional testing of Find_Token. - - ASF.Find_Token("eabcdabcddcab", - ABCD_Set, - Ada.Strings.Inside, - Slice_Start, - Slice_End); - - if Slice_Start /= 2 or Slice_End /= 13 then - Report.Failed("Incorrect result from Find_Token - 3"); - end if; - - ASF.Find_Token("efghijklabcdabcd", - ABCD_Set, - Ada.Strings.Outside, - Slice_Start, - Slice_End); - - if Slice_Start /= 1 or Slice_End /= 8 then - Report.Failed("Incorrect result from Find_Token - 4"); - end if; - - ASF.Find_Token("abcdefgabcdabcd", - ABCD_Set, - Ada.Strings.Outside, - Slice_Start, - Slice_End); - - if Slice_Start /= 5 or Slice_End /= 7 then - Report.Failed("Incorrect result from Find_Token - 5"); - end if; - - ASF.Find_Token("abcdcbabcdcba", - ABCD_Set, - Ada.Strings.Inside, - Slice_Start, - Slice_End); - - if Slice_Start /= 1 or Slice_End /= 13 then - Report.Failed("Incorrect result from Find_Token - 6"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4004; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a deleted file mode 100644 index d61f853ca0e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a +++ /dev/null @@ -1,683 +0,0 @@ --- CXA4005.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 subprograms defined in package Ada.Strings.Fixed are --- available, and that they produce correct results. Specifically, --- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice, --- Tail, Trim, and "*". --- --- TEST DESCRIPTION: --- This test, when combined with tests CXA4002-4 will provide coverage --- of the functionality found in Ada.Strings.Fixed. --- This test contains many small, specific test cases, situations that --- although common in user environments, are often difficult to generate --- in large numbers in a application-based test. They represent --- individual usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 11 Apr 95 SAIC Corrected acceptance conditions of certain --- subtests. --- 06 Nov 95 SAIC Fixed bugs for ACVC 2.0.1. --- 22 Feb 01 PHL Check that the lower bound of the result is 1. --- 13 Mar 01 RLB Fixed a couple of ACATS style violations; --- removed pointless checks of procedures. --- Added checks of other functions. These changes --- were made to test Defect Report 8652/0049, as --- reflected in Technical Corrigendum 1. --- ---! - -with Report; -with Ada.Strings; -with Ada.Strings.Fixed; -with Ada.Strings.Maps; - -procedure CXA4005 is - - type TC_Name_Holder is access String; - Name : TC_Name_Holder; - - function TC_Check (S : String) return String is - begin - if S'First /= 1 then - Report.Failed ("Lower bound of result of function " & Name.all & - " is" & Integer'Image (S'First)); - end if; - return S; - end TC_Check; - - procedure TC_Set_Name (N : String) is - begin - Name := new String'(N); - end TC_Set_Name; - -begin - - Report.Test("CXA4005", "Check that the subprograms defined in " & - "package Ada.Strings.Fixed are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASF renames Ada.Strings.Fixed; - package Maps renames Ada.Strings.Maps; - - Result_String, - Delete_String, - Insert_String, - Trim_String, - Overwrite_String : String(1..10) := (others => Ada.Strings.Space); - - Source_String1 : String(1..5) := "abcde"; -- odd length string - Source_String2 : String(1..6) := "abcdef"; -- even length string - Source_String3 : String(1..12) := "abcdefghijkl"; - Source_String4 : String(1..12) := "abcdefghij "; -- last two ch pad - Source_String5 : String(1..12) := " cdefghijkl"; -- first two ch pad - Source_String6 : String(1..12) := "abcdefabcdef"; - - Location : Natural := 0; - Slice_Start : Positive; - Slice_End, - Slice_Count : Natural := 0; - - CD_Set : Maps.Character_Set := Maps.To_Set("cd"); - X_Set : Maps.Character_Set := Maps.To_Set('x'); - ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); - A_to_F_Set : Maps.Character_Set := Maps.To_Set("abcdef"); - - CD_to_XY_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - begin - - -- Procedure Replace_Slice - -- The functionality of this procedure - -- is similar to procedure Move, and - -- is tested here in the same manner, evaluated - -- with various combinations of parameters. - - -- Index_Error propagation when Low > Source'Last + 1 - - begin - ASF.Replace_Slice(Result_String, - Result_String'Last + 2, -- should raise exception - Result_String'Last, - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 1"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 1"); - end; - - -- Index_Error propagation when High < Source'First - 1 - - begin - ASF.Replace_Slice(Result_String(5..10), - 5, - 3, -- should raise exception since < 'First - 1. - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 2"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 2"); - end; - - -- Justify = Left (default case) - - Result_String := "XXXXXXXXXX"; - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => 10, - By => Source_String1); -- "abcde" - - if Result_String /= "abcde " then - Report.Failed("Incorrect result from Replace_Slice - Justify = Left"); - end if; - - -- Justify = Right - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String2, -- "abcdef" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= " abcdef" then - Report.Failed("Incorrect result from Replace_Slice - Justify=Right"); - end if; - - -- Justify = Center (two cases, odd and even pad lengths) - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String1, -- "abcde" - Ada.Strings.Error, - Ada.Strings.Center, - 'x'); -- non-default padding. - - if Result_String /= "xxabcdexxx" then -- Unequal padding added right - Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1"); - end if; - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String2, -- "abcdef" - Ada.Strings.Error, - Ada.Strings.Center); - - if Result_String /= " abcdef " then -- Equal padding added on L/R. - Report.Failed("Incorrect result from Replace_Slice with " & - "Justify = Center - 2"); - end if; - - -- When the source string is longer than the target string, several - -- cases can be examined, with the results depending on the value of - -- the Drop parameter. - - -- Drop = Left - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Left); - - if Result_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Replace_Slice - Drop=Left"); - end if; - - -- Drop = Right - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Ada.Strings.Right); - - if Result_String /= "abcdefghij" then - Report.Failed("Incorrect result, Replace_Slice with Drop=Right"); - end if; - - -- Drop = Error - - -- The effect in this case depends on the value of the justify - -- parameter, and on whether any characters in Source other than - -- Pad would fail to be copied. - - -- Drop = Error, Justify = Left, right overflow characters are pad. - - ASF.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String4, -- "abcdefghij " - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Left); - - if not(Result_String = "abcdefghij") then -- leftmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1"); - end if; - - -- Drop = Error, Justify = Right, left overflow characters are pad. - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String5, -- " cdefghijkl" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= "cdefghijkl" then -- rightmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2"); - end if; - - -- In other cases of Drop=Error, Length_Error is propagated, such as: - - begin - - ASF.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Error); - - Report.Failed("Length_Error not raised by Replace_Slice - 1"); - - exception - when Ada.Strings.Length_Error => null; -- OK - when others => - Report.Failed("Incorrect exception from Replace_Slice - 3"); - end; - - - -- Function Replace_Slice - - TC_Set_Name ("Replace_Slice"); - - if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x")) - /= "abxde" or -- High = Low - TC_Check (ASF.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or - TC_Check (ASF.Replace_Slice("abcd", 4, 1, "xy")) - /= "abcxyd" or -- High < Low - TC_Check (ASF.Replace_Slice("abc", 2, 3, "x")) /= "ax" or - TC_Check (ASF.Replace_Slice("a", 1, 1, "z")) /= "z" - then - Report.Failed("Incorrect result from Function Replace_Slice - 1"); - end if; - - if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z")) - /= "abcdz" or -- By length 1 - TC_Check (ASF.Replace_Slice("abc", 1, 3, "xyz")) - /= "xyz" or -- High > Low - TC_Check (ASF.Replace_Slice("abc", 3, 2, "xy")) - /= "abxyc" or -- insert - TC_Check (ASF.Replace_Slice("a", 1, 1, "xyz")) /= "xyz" - then - Report.Failed("Incorrect result from Function Replace_Slice - 2"); - end if; - - - - -- Function Insert. - - TC_Set_Name ("Insert"); - - declare - New_String : constant String := - TC_Check ( - ASF.Insert(Source => Source_String1(2..5), -- "bcde" - Before => 3, - New_Item => Source_String2)); -- "abcdef" - begin - if New_String /= "babcdefcde" then - Report.Failed("Incorrect result from Function Insert - 1"); - end if; - end; - - if TC_Check (ASF.Insert("a", 1, "z")) /= "za" or - TC_Check (ASF.Insert("abc", 3, "")) /= "abc" or - TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc" - then - Report.Failed("Incorrect result from Function Insert - 2"); - end if; - - begin - if TC_Check (ASF.Insert(Source => Source_String1(2..5), -- "bcde" - Before => Report.Ident_Int(7), - New_Item => Source_String2)) -- "abcdef" - /= "babcdefcde" then - Report.Failed("Index_Error not raised by Insert - 3A"); - else - Report.Failed("Index_Error not raised by Insert - 3B"); - end if; - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Insert - 3"); - end; - - - -- Procedure Insert - - -- Drop = Right - - ASF.Insert(Source => Insert_String, - Before => 6, - New_Item => Source_String2, -- "abcdef" - Drop => Ada.Strings.Right); - - if Insert_String /= " abcde" then -- last char of New_Item dropped. - Report.Failed("Incorrect result from Insert with Drop = Right"); - end if; - - -- Drop = Left - - ASF.Insert(Source => Insert_String, -- 10 char string - Before => 2, -- 9 chars, 2..10 available - New_Item => Source_String3, -- 12 characters long. - Drop => Ada.Strings.Left); -- truncate from Left. - - if Insert_String /= "l abcde" then -- 10 chars, leading blank. - Report.Failed("Incorrect result from Insert with Drop=Left"); - end if; - - -- Drop = Error - - begin - ASF.Insert(Source => Result_String, -- 10 chars - Before => Result_String'Last, - New_Item => "abcdefghijk", - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Insert"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception - when others => - Report.Failed("Incorrect exception raised by Procedure Insert"); - end; - - - - -- Function Overwrite - - TC_Set_Name ("Overwrite"); - - Overwrite_String := TC_Check ( - ASF.Overwrite(Result_String, -- 10 chars - 1, -- starting at pos=1 - Source_String3(1..10))); - - if Overwrite_String /= Source_String3(1..10) then - Report.Failed("Incorrect result from Function Overwrite - 1"); - end if; - - - if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or - TC_Check (ASF.Overwrite("a", 1, "xyz")) - /= "xyz" or -- chars appended - TC_Check (ASF.Overwrite("abc", 3, " ")) - /= "ab " or -- blanks appended - TC_Check (ASF.Overwrite("abcde", 1, "z" )) /= "zbcde" - then - Report.Failed("Incorrect result from Function Overwrite - 2"); - end if; - - - - -- Procedure Overwrite, with truncation. - - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Left); - - if Overwrite_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Overwrite with Drop=Left"); - end if; - - -- The default drop value is Right, used here. - - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3); -- 12 characters. - - if Overwrite_String /= "abcdefghij" then - Report.Failed("Incorrect result from Overwrite with Drop=Right"); - end if; - - -- Drop = Error - - begin - ASF.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Overwrite"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Incorrect exception raised by Procedure Overwrite"); - end; - - Overwrite_String := "ababababab"; - ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z"); - ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z"); - ASF.Overwrite(Overwrite_String, 5, "zz"); - - if Overwrite_String /= "zbabzzabaz" then - Report.Failed("Incorrect result from Procedure Overwrite"); - end if; - - - - -- Function Delete - - TC_Set_Name ("Delete"); - - declare - New_String1 : constant String := -- This returns a 4 char string. - TC_Check (ASF.Delete(Source => Source_String3, - From => 3, - Through => 10)); - New_String2 : constant String := -- This returns Source. - TC_Check (ASF.Delete(Source_String3, 10, 3)); - begin - if New_String1 /= "abkl" or - New_String2 /= Source_String3 - then - Report.Failed("Incorrect result from Function Delete - 1"); - end if; - end; - - if TC_Check (ASF.Delete("a", 1, 1)) - /= "" or -- Source length = 1 - TC_Check (ASF.Delete("abc", 1, 2)) - /= "c" or -- From = Source'First - TC_Check (ASF.Delete("abc", 3, 3)) - /= "ab" or -- From = Source'Last - TC_Check (ASF.Delete("abc", 3, 1)) - /= "abc" -- From > Through - then - Report.Failed("Incorrect result from Function Delete - 2"); - end if; - - - - -- Procedure Delete - - -- Justify = Left - - Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij" - - ASF.Delete(Source => Delete_String, - From => 6, - Through => Delete_String'Last, - Justify => Ada.Strings.Left, - Pad => 'x'); -- pad with char 'x' - - if Delete_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Delete - Justify = Left"); - end if; - - -- Justify = Right - - ASF.Delete(Source => Delete_String, -- Remove x"s from end and - From => 6, -- shift right. - Through => Delete_String'Last, - Justify => Ada.Strings.Right, - Pad => 'x'); -- pad with char 'x' on left. - - if Delete_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Delete - Justify = Right"); - end if; - - -- Justify = Center - - ASF.Delete(Source => Delete_String, - From => 1, - Through => 5, - Justify => Ada.Strings.Center, - Pad => 'z'); - - if Delete_String /= "zzabcdezzz" then -- extra pad char on right side. - Report.Failed("Incorrect result from Delete - Justify = Center"); - end if; - - - - -- Function Trim - -- Use non-identity character sets to perform the trim operation. - - TC_Set_Name ("Trim"); - - Trim_String := "cdabcdefcd"; - - -- Remove the "cd" from each end of the string. This will not effect - -- the "cd" slice at 5..6. - - declare - New_String : constant String := - TC_Check (ASF.Trim(Source => Trim_String, - Left => CD_Set, Right => CD_Set)); - begin - if New_String /= Source_String2 then -- string "abcdef" - Report.Failed("Incorrect result from Trim with character sets"); - end if; - end; - - if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set)) - /= "abcdef" then - Report.Failed("Incorrect result from Trim with Null sets"); - end if; - - if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then - Report.Failed("Incorrect result from Trim, string removal"); - end if; - - - -- Procedure Trim - - -- Justify = Right - - ASF.Trim(Source => Trim_String, - Left => CD_Set, - Right => CD_Set, - Justify => Ada.Strings.Right, - Pad => 'x'); - - if Trim_String /= "xxxxabcdef" then - Report.Failed("Incorrect result from Trim with Justify = Right"); - end if; - - -- Justify = Left - - ASF.Trim(Source => Trim_String, - Left => X_Set, - Right => Maps.Null_Set, - Justify => Ada.Strings.Left, - Pad => Ada.Strings.Space); - - if Trim_String /= "abcdef " then -- Padded with 4 blanks on right. - Report.Failed("Incorrect result from Trim with Justify = Left"); - end if; - - -- Justify = Center - - ASF.Trim(Source => Trim_String, - Left => ABCD_Set, - Right => CD_Set, - Justify => Ada.Strings.Center, - Pad => 'x'); - - if Trim_String /= "xxef xx" then -- Padded with 2 pad chars on L/R - Report.Failed("Incorrect result from Trim with Justify = Center"); - end if; - - - - -- Function Head, demonstrating use of padding. - - TC_Set_Name ("Head"); - - -- Use the characters of Source_String1 ("abcde") and pad the - -- last five characters of Result_String with 'x' characters. - - - Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x')); - - if Result_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Function Head with padding"); - end if; - - if TC_Check (ASF.Head(" ab ", 2)) /= " " or - TC_Check (ASF.Head("a", 6, 'A')) /= "aAAAAA" or - TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc" or - TC_Check (ASF.Head(ASF.Head("abc ", 7, 'x'), 10, 'X')) - /= "abc xxXXX" - then - Report.Failed("Incorrect result from Function Head"); - end if; - - - - -- Function Tail, demonstrating use of padding. - - TC_Set_Name ("Tail"); - - -- Use the characters of Source_String1 ("abcde") and pad the - -- first five characters of Result_String with 'x' characters. - - Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x')); - - if Result_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Function Tail with padding"); - end if; - - if TC_Check (ASF.Tail("abcde ", 5)) - /= "cde " or -- blanks, back - TC_Check (ASF.Tail(" abc ", 8, ' ')) - /= " abc " or -- blanks, front/back - TC_Check (ASF.Tail("", 5, 'Z')) - /= "ZZZZZ" or -- pad characters only - TC_Check (ASF.Tail("abc", 0)) - /= "" or -- null result - TC_Check (ASF.Tail("abcdefgh", 3)) - /= "fgh" or - TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'), - 10, - 'X')) /= "XXXXx abc " - then - Report.Failed("Incorrect result from Function Tail"); - end if; - - - -- Function "*" - with (Natural, String) parameters - - TC_Set_Name ("""*"""); - - if TC_Check (ASF."*"(3, Source_String1)) /= "abcdeabcdeabcde" or - TC_Check (ASF."*"(2, Source_String2)) /= Source_String6 or - TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab" or - TC_Check (ASF."*"(0, Source_String1)) /= "" - then - Report.Failed("Incorrect result from Function ""*"" with strings"); - end if; - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4005; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a deleted file mode 100644 index e1d7f46f5ae..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a +++ /dev/null @@ -1,319 +0,0 @@ --- CXA4006.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 subprograms defined in package Ada.Strings.Bounded are --- available, and that they produce correct results. Specifically, check --- the subprograms Length, Slice, "&", To_Bounded_String, Append, Index, --- To_String, Replace_Slice, Trim, Overwrite, Delete, Insert, and --- Translate. --- --- TEST DESCRIPTION: --- This test demonstrates the uses of a variety of the string functions --- found in the package Ada.Strings.Bounded, simulating the operations --- found in a text processing package. --- With bounded strings, the length of each "line" of text can vary up --- to the instantiated maximum, allowing one to view a page of text as --- a series of expandable lines. This provides flexibility in text --- formatting of individual lines (strings). --- Several subprograms are defined, all of which attempt to take advantage --- of as many different bounded string utilities as possible. Often, --- an operation that is being performed in a subprogram using a certain --- bounded string utility could more efficiently be performed using a --- a different utility. However, in the interest of including as broad --- coverage as possible, a mixture of utilities is invoked in this test. --- A simulated page of text is provided as a parameter to the test --- defined subprograms, and the appropriate processing performed. The --- processed page of text is then compared to a predefined "finished" --- page, and test passage/failure is based on the results of this --- comparison. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Strings; -with Ada.Strings.Bounded; -with Ada.Strings.Maps; -with Report; - -procedure CXA4006 is - -begin - - Report.Test ("CXA4006", "Check that the subprograms defined in package " & - "Ada.Strings.Bounded are available, and that " & - "they produce correct results"); - - Test_Block: - declare - - Characters_Per_Line : constant Positive := 40; - Lines_Per_Page : constant Natural := 4; - - package BS_40 is new - Ada.Strings.Bounded.Generic_Bounded_Length(Characters_Per_Line); - use type BS_40.Bounded_String; - - type Page_Type is array (1..Lines_Per_Page) of BS_40.Bounded_String; - - -- Note: Misspellings below are intentional. - - Line1 : BS_40.Bounded_String := - BS_40.To_Bounded_String("ada is a progrraming language designed"); - Line2 : BS_40.Bounded_String := - BS_40.To_Bounded_String("to support the construction of long-"); - Line3 : BS_40.Bounded_String := - BS_40.To_Bounded_String("lived, highly reliabel software "); - Line4 : BS_40.Bounded_String := - BS_40.To_Bounded_String("systems"); - - Page : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4); - - Finished_Page : Page_Type := - (BS_40.To_Bounded_String("Ada is a programming language designed"), - BS_40.To_Bounded_String("to support the construction of long-"), - BS_40.To_Bounded_String("lived, HIGHLY RELIABLE software systems."), - BS_40.To_Bounded_String("")); - - --- - - procedure Compress (Page : in out Page_Type) is - Clear_Line : Natural := Lines_Per_Page; - begin - -- If two consecutive lines on the page are together less than the - -- maximum line length, then append those two lines, move up all - -- lower lines on the page, and blank out the last line. - for i in 1..Lines_Per_Page - 1 loop - if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <= - BS_40.Max_Length - then - Page(i) := BS_40."&"(Page(i), - Page(i+1)); -- "&" (bounded, bounded) - - for j in i+1..Lines_Per_Page - 1 loop - Page(j) := - BS_40.To_Bounded_String - (BS_40.Slice(Page(j+1), - 1, - BS_40.Length(Page(j+1)))); - Clear_Line := j + 1; - end loop; - Page(Clear_Line) := BS_40.Null_Bounded_String; - end if; - end loop; - end Compress; - - --- - - procedure Format (Page : in out Page_Type) is - Sm_Ada : BS_40.Bounded_String := BS_40.To_Bounded_String("ada"); - Cap_Ada : constant String := "Ada"; - Char_Pos : Natural := 0; - Finished : Boolean := False; - Line : Natural := Page_Type'Last; - begin - - -- Add a period to the end of the last line. - while Line >= Page_Type'First and not Finished loop - if Page(Line) /= BS_40.Null_Bounded_String and - BS_40.Length(Page(Line)) <= BS_40.Max_Length - then - Page(Line) := BS_40.Append(Page(Line), '.'); - Finished := True; - end if; - Line := Line - 1; - end loop; - - -- Replace all occurrences of "ada" with "Ada". - for Line in Page_Type'First .. Page_Type'Last loop - Finished := False; - while not Finished loop - Char_Pos := BS_40.Index(Source => Page(Line), - Pattern => BS_40.To_String(Sm_Ada), - Going => Ada.Strings.Backward); - -- A zero is returned by function Index if no occurrences of - -- the pattern string are found. - Finished := (Char_Pos = 0); - if not Finished then - BS_40.Replace_Slice - (Source => Page(Line), - Low => Char_Pos, - High => Char_Pos + BS_40.Length(Sm_Ada) - 1, - By => Cap_Ada); - end if; - end loop; -- while loop - end loop; -- for loop - - end Format; - - --- - - procedure Spell_Check (Page : in out Page_Type) is - type Spelling_Type is (Incorrect, Correct); - type Word_Array_Type is array (Spelling_Type) - of BS_40.Bounded_String; - type Dictionary_Type is array (1..2) of Word_Array_Type; - - -- Note that the "words" in the dictionary will require various - -- amounts of Trimming prior to their use in the string functions. - Dictionary : Dictionary_Type := - (1 => (BS_40.To_Bounded_String(" reliabel "), - BS_40.To_Bounded_String(" reliable ")), - 2 => (BS_40.To_Bounded_String(" progrraming "), - BS_40.To_Bounded_String(" programming "))); - - Pos : Natural := Natural'First; - Finished : Boolean := False; - - begin - - for Line in Page_Type'Range loop - - -- Search for the first incorrectly spelled word in the Dictionary, - -- if it is found, replace it with the correctly spelled word, - -- using the Overwrite function. - - while not Finished loop - Pos := - BS_40.Index(Page(Line), - BS_40.To_String( - BS_40.Trim(Dictionary(1)(Incorrect), - Ada.Strings.Both)), - Ada.Strings.Forward); - Finished := (Pos = 0); - if not Finished then - Page(Line) := - BS_40.Overwrite(Page(Line), - Pos, - BS_40.To_String - (BS_40.Trim(Dictionary(1)(Correct), - Ada.Strings.Both))); - end if; - end loop; - - Finished := False; - - -- Search for the second incorrectly spelled word in the - -- Dictionary, if it is found, replace it with the correctly - -- spelled word, using the Delete procedure and Insert function. - - while not Finished loop - Pos := - BS_40.Index(Page(Line), - BS_40.To_String( - BS_40.Trim(Dictionary(2)(Incorrect), - Ada.Strings.Both)), - Ada.Strings.Forward); - - Finished := (Pos = 0); - - if not Finished then - BS_40.Delete - (Page(Line), - Pos, - Pos + BS_40.To_String - (BS_40.Trim(Dictionary(2)(Incorrect), - Ada.Strings.Both))'Length-1); - Page(Line) := - BS_40.Insert(Page(Line), - Pos, - BS_40.To_String - (BS_40.Trim(Dictionary(2)(Correct), - Ada.Strings.Both))); - end if; - end loop; - - Finished := False; - - end loop; - end Spell_Check; - - --- - - procedure Bold (Page : in out Page_Type) is - Key_Word : constant String := "highly reliable"; - Bold_Mapping : constant Ada.Strings.Maps.Character_Mapping := - Ada.Strings.Maps.To_Mapping(From => " abcdefghijklmnopqrstuvwxyz", - To => " ABCDEFGHIJKLMNOPQRSTUVWXYZ"); - Pos : Natural := Natural'First; - Finished : Boolean := False; - begin - -- This procedure is designed to change the case of the phrase - -- "highly reliable" into upper case (a type of "Bolding"). - -- All instances of the phrase on all lines of the page will be - -- modified. - - for Line in Page_Type'First .. Page_Type'Last loop - while not Finished loop - Pos := BS_40.Index(Page(Line), Key_Word); - Finished := (Pos = 0); - if not Finished then - - BS_40.Overwrite - (Page(Line), - Pos, - BS_40.To_String - (BS_40.Translate - (BS_40.To_Bounded_String - (BS_40.Slice(Page(Line), - Pos, - Pos + Key_Word'Length - 1)), - Bold_Mapping))); - - end if; - end loop; - Finished := False; - end loop; - end Bold; - - - begin - - Compress(Page); - Format(Page); - Spell_Check(Page); - Bold(Page); - - for i in 1..Lines_Per_Page loop - if BS_40.To_String(Page(i)) /= BS_40.To_String(Finished_Page(i)) or - BS_40.Length(Page(i)) /= BS_40.Length(Finished_Page(i)) - then - Report.Failed("Incorrect modification of Page, Line " & - Integer'Image(i)); - end if; - end loop; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4006; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a deleted file mode 100644 index fca15d367b5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a +++ /dev/null @@ -1,334 +0,0 @@ --- CXA4007.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 subprograms defined in package Ada.Strings.Bounded are --- available, and that they produce correct results. Specifically, check --- the subprograms Append, Count, Element, Find_Token, Head, --- Index_Non_Blank, Replace_Element, Replicate, Tail, To_Bounded_String, --- "&", ">", "<", ">=", "<=", and "*". --- --- TEST DESCRIPTION: --- This test, when taken in conjunction with tests CXA400[6,8,9], will --- constitute a test of all the functionality contained in package --- Ada.Strings.Bounded. This test uses a variety of the --- subprograms defined in the bounded string package in ways typical --- of common usage. Different combinations of available subprograms --- are used to accomplish similar bounded string processing goals. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 22 Dec 94 SAIC Changed obsolete constant to Ada.Strings.Space. --- ---! - -with Ada.Strings; -with Ada.Strings.Bounded; -with Ada.Strings.Maps; -with Report; - -procedure CXA4007 is - -begin - - Report.Test ("CXA4007", "Check that the subprograms defined in package " & - "Ada.Strings.Bounded are available, and that " & - "they produce correct results"); - - Test_Block: - declare - - package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80); - use type BS80.Bounded_String; - - Part1 : constant String := "Rum"; - Part2 : Character := 'p'; - Part3 : BS80.Bounded_String := BS80.To_Bounded_String("el"); - Part4 : Character := 's'; - Part5 : BS80.Bounded_String := BS80.To_Bounded_String("tilt"); - Part6 : String(1..3) := "ski"; - - Full_Catenate_String, - Full_Append_String, - Constructed_String, - Drop_String, - Replicated_String, - Token_String : BS80.Bounded_String; - - CharA : Character := 'A'; - CharB : Character := 'B'; - CharC : Character := 'C'; - CharD : Character := 'D'; - CharE : Character := 'E'; - CharF : Character := 'F'; - - ABStr : String(1..15) := "AAAAABBBBBBBBBB"; - StrB : String(1..2) := "BB"; - StrE : String(1..2) := "EE"; - - - begin - - -- Evaluation of the overloaded forms of the "&" operator defined - -- for instantiations of Bounded Strings. - - Full_Catenate_String := - BS80."&"(Part2, -- Char & Bnd Str - BS80."&"(Part3, -- Bnd Str & Bnd Str - BS80."&"(Part4, -- Char & Bnd Str - BS80."&"(Part5, -- Bnd Str & Bnd Str - BS80.To_Bounded_String(Part6))))); - - Full_Catenate_String := - Part1 & Full_Catenate_String; -- Str & Bnd Str - Full_Catenate_String := - Full_Catenate_String & 'n'; -- Bnd Str & Char - - - -- Evaluation of the overloaded forms of function Append. - - Full_Append_String := - BS80.Append(Part2, -- Char,Bnd - BS80.Append(Part3, -- Bnd, Bnd - BS80.Append(Part4, -- Char,Bnd - BS80.Append(BS80.To_String(Part5), -- Str,Bnd - BS80.To_Bounded_String(Part6))))); - - Full_Append_String := - BS80.Append(BS80.To_Bounded_String(Part1), -- Bnd , Str - BS80.To_String(Full_Append_String)); - - Full_Append_String := - BS80.Append(Left => Full_Append_String, - Right => 'n'); -- Bnd, Char - - - -- Validate the resulting bounded strings. - - if Full_Catenate_String < Full_Append_String or - Full_Catenate_String > Full_Append_String or - not (Full_Catenate_String = Full_Append_String and - Full_Catenate_String <= Full_Append_String and - Full_Catenate_String >= Full_Append_String) - then - Report.Failed("Incorrect results from bounded string catenation" & - " and comparison"); - end if; - - - -- Evaluate the overloaded forms of the Constructor function "*" and - -- the Replicate function. - - Constructed_String := - (2 * CharA) & -- "AA" - (2 * StrB) & -- "AABBBB" - (3 * BS80."*"(2, CharC)) & -- "AABBBBCCCCCC" - BS80.Replicate(3, - BS80.Replicate(2, CharD)) & -- "AABBBBCCCCCCDDDDDD" - BS80.Replicate(2, StrE) & -- "AABBBBCCCCCCDDDDDDEEEE" - BS80.Replicate(2, CharF); -- "AABBBBCCCCCCDDDDDDEEEEFF" - - - -- Use of Function Replicate that involves dropping characters. The - -- attempt to replicate the 15 character string six times will exceed - -- the 80 character bound of the string. Therefore, the result should - -- be the catenation of 5 copies of the 15 character string, followed - -- by 5 'A' characters (the first five characters of the 6th - -- replication) with the remaining characters of the 6th replication - -- dropped. - - Drop_String := - BS80.Replicate(Count => 6, - Item => ABStr, -- "AAAAABBBBBBBBBB" - Drop => Ada.Strings.Right); - - if BS80.Element(Drop_String, 1) /= 'A' or - BS80.Element(Drop_String, 6) /= 'B' or - BS80.Element(Drop_String, 76) /= 'A' or - BS80.Element(Drop_String, 80) /= 'A' - then - Report.Failed("Incorrect result from Replicate with Drop"); - end if; - - - -- Use function Index_Non_Blank in the evaluation of the - -- Constructed_String. - - if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward) /= - BS80.To_String(Constructed_String)'First or - BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /= - BS80.Length(Constructed_String) - then - Report.Failed("Incorrect results from constructor functions"); - end if; - - - - declare - - -- Define character set objects for use with the Count function. - -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above. - - A_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,1)); - B_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,3)); - C_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,7)); - D_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,13)); - E_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,19)); - F_Set : Ada.Strings.Maps.Character_Set := - Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,23)); - - - Start : Positive; - Stop : Natural := 0; - - begin - - -- Evaluate the results from function Count by comparing the number - -- of A's to the number of F's, B's to E's, and C's to D's in the - -- Constructed_String. - -- There should be an equal number of each of the characters that - -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc) - - if BS80.Count(Constructed_String, A_Set) /= - BS80.Count(Constructed_String, F_Set) or - BS80.Count(Constructed_String, B_Set) /= - BS80.Count(Constructed_String, E_Set) or - not (BS80.Count(Constructed_String, C_Set) = - BS80.Count(Constructed_String, D_Set)) - then - Report.Failed("Incorrect result from function Count"); - end if; - - - -- Evaluate the functions Head, Tail, and Find_Token. - -- Create the Token_String from the Constructed_String above. - - Token_String := - BS80.Tail(BS80.Head(Constructed_String, 3), 2) & -- "AB" & - BS80.Head(BS80.Tail(Constructed_String, 13), 2) & -- "CD" & - BS80.Head(BS80.Tail(Constructed_String, 3), 2); -- "EF" - - if Token_String /= BS80.To_Bounded_String("ABCDEF") then - Report.Failed("Incorrect result from Catenation of Token_String"); - end if; - - - -- Find the starting/ending position of the first A in the - -- Token_String (both should be 1, only one A appears in string). - -- The Function Head uses the default pad character to return a - -- bounded string longer than its input parameter bounded string. - - BS80.Find_Token(BS80.Head(Token_String, 10), -- Default pad. - A_Set, - Ada.Strings.Inside, - Start, - Stop); - - if Start /= 1 and Stop /= 1 then - Report.Failed("Incorrect result from Find_Token - 1"); - end if; - - - -- Find the starting/ending position of the first non-AB slice in - -- the "head" five characters of Token_String (slice CDE at - -- positions 3-5) - - BS80.Find_Token(BS80.Head(Token_String, 5), -- "ABCDE" - Ada.Strings.Maps."OR"(A_Set, B_Set), -- Set (AB) - Ada.Strings.Outside, - Start, - Stop); - - if Start /= 3 and Stop /= 5 then - Report.Failed("Incorrect result from Find_Token - 2"); - end if; - - - -- Find the starting/ending position of the first CD slice in - -- the "tail" eight characters (including two pad characters) - -- of Token_String (slice CD at positions 5-6 of the tail - -- portion specified) - - BS80.Find_Token(BS80.Tail(Token_String, 8, - Ada.Strings.Space), -- " ABCDEF" - Ada.Strings.Maps."OR"(C_Set, D_Set), -- Set (CD) - Ada.Strings.Inside, - Start, - Stop); - - if Start /= 5 and Stop /= 6 then - Report.Failed("Incorrect result from Find_Token - 3"); - end if; - - - -- Evaluate the Replace_Element procedure. - - -- Token_String = "ABCDEF" - - BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4)); - - -- Token_String = "ABDDEF" - - BS80.Replace_Element(Source => Token_String, - Index => 2, - By => BS80.Element(Token_String, 5)); - - -- Token_String = "AEDDEF" - - BS80.Replace_Element(Token_String, - 1, - BS80.Element(BS80.Tail(Token_String, 2), 2)); - - -- Token_String = "FEDDEF" - -- Evaluate this result. - - if BS80.Element(Token_String, BS80.To_String(Token_String)'First) /= - BS80.Element(Token_String, BS80.To_String(Token_String)'Last) or - BS80.Count(Token_String, D_Set) /= - BS80.Count(Token_String, E_Set) or - BS80.Index_Non_Blank(BS80.Head(Token_String,6)) /= - BS80.Index_Non_Blank(BS80.Tail(Token_String,6)) or - BS80.Head(Token_String, 1) /= - BS80.Tail(Token_String, 1) - then - Report.Failed("Incorrect result from operations in combination"); - end if; - - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4007; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a deleted file mode 100644 index 629305f767a..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a +++ /dev/null @@ -1,662 +0,0 @@ --- CXA4008.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 subprograms defined in package Ada.Strings.Bounded are --- available, and that they produce correct results, especially under --- conditions where truncation of the result is required. Specifically, --- check the subprograms Append, Count with non-Identity maps, Index with --- non-Identity maps, Index with Set parameters, Insert (function and --- procedure), Replace_Slice (function and procedure), To_Bounded_String, --- and Translate. --- --- TEST DESCRIPTION: --- This test, in conjunction with tests CXA4006, CXA4007, and CXA4009, --- will provide coverage of the most common usages of the functionality --- found in the Ada.Strings.Bounded package. It deals in large part --- with truncation effects and options. This test contains many small, --- specific test cases, situations that are often difficult to generate --- in large numbers in an application-based test. These cases represent --- specific usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 10 Apr 95 SAIC Corrected acceptance condition of subtest for --- Function Append with Truncation = Left. --- 31 Oct 95 SAIC Update and repair for ACVC 2.0.1. --- ---! - -with Report; -with Ada.Strings.Maps.Constants; -with Ada.Strings.Bounded; -with Ada.Strings.Maps; - -procedure CXA4008 is - -begin - - Report.Test("CXA4008", "Check that the subprograms defined in " & - "package Ada.Strings.Bounded are available, " & - "and that they produce correct results, " & - "especially under conditions where " & - "truncation of the result is required"); - - Test_Block: - declare - - package AS renames Ada.Strings; - package ASB renames Ada.Strings.Bounded; - package ASC renames Ada.Strings.Maps.Constants; - package Maps renames Ada.Strings.Maps; - - package B10 is new ASB.Generic_Bounded_Length(Max => 10); - use type B10.Bounded_String; - - Result_String : B10.Bounded_String; - Test_String : B10.Bounded_String; - AtoE_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("abcde"); - FtoJ_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("fghij"); - AtoJ_Bnd_Str : B10.Bounded_String := - B10.To_Bounded_String("abcdefghij"); - - Location : Natural := 0; - Total_Count : Natural := 0; - - CD_Set : Maps.Character_Set := Maps.To_Set("cd"); - - AB_to_YZ_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "ab", To => "yz"); - - CD_to_XY_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - - begin - -- Function To_Bounded_String with Truncation - -- Evaluate the function Append with parameters that will - -- cause the truncation of the result. - - -- Drop = Error (default case, Length_Error will be raised) - - begin - Test_String := - B10.To_Bounded_String("Much too long for this bounded string"); - Report.Failed("Length Error not raised by To_Bounded_String"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by To_Bounded_String"); - end; - - -- Drop = Left - - Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn", - Drop => Ada.Strings.Left); - - if Test_String /= B10.To_Bounded_String("efghijklmn") then - Report.Failed - ("Incorrect result from To_Bounded_String, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn", - Drop => Ada.Strings.Right); - - if not(Test_String = AtoJ_Bnd_Str) then - Report.Failed - ("Incorrect result from To_Bounded_String, Drop = Right"); - end if; - - - - - -- Function Append with Truncation - -- Evaluate the function Append with parameters that will - -- cause the truncation of the result. - - -- Drop = Error (default case, Length_Error will be raised) - - begin - -- Append (Bnd Str, Bnd Str); - Result_String := - B10.Append(B10.To_Bounded_String("abcde"), - B10.To_Bounded_String("fghijk")); -- 11 char - Report.Failed("Length_Error not raised by Append - 1"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 1"); - end; - - begin - -- Append (Str, Bnd Str); - Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str), - B10.To_Bounded_String("fghijk"), - AS.Error); - Report.Failed("Length_Error not raised by Append - 2"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 2"); - end; - - begin - -- Append (Bnd Str, Char); - Result_String := - B10.Append(B10.To_Bounded_String("abcdefghij"), 'k'); - Report.Failed("Length_Error not raised by Append - 3"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 3"); - end; - - -- Drop = Left - - -- Append (Bnd Str, Bnd Str) - Result_String := B10.Append(B10.To_Bounded_String("abcdefgh"), -- 8 chs - B10.To_Bounded_String("ijklmn"), -- 6 chs - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("efghijklmn") then -- 10 chars - Report.Failed("Incorrect truncation performed by Append - 4"); - end if; - - -- Append (Bnd Str, Str) - Result_String := - B10.Append(B10.To_Bounded_String("abcdefghij"), - "xyz", - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("defghijxyz") then - Report.Failed("Incorrect truncation performed by Append - 5"); - end if; - - -- Append (Char, Bnd Str) - - Result_String := B10.Append('A', - B10.To_Bounded_String("abcdefghij"), - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("abcdefghij") then - Report.Failed("Incorrect truncation performed by Append - 6"); - end if; - - -- Drop = Right - - -- Append (Bnd Str, Bnd Str) - Result_String := B10.Append(FtoJ_Bnd_Str, - AtoJ_Bnd_Str, - Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("fghijabcde") then - Report.Failed("Incorrect truncation performed by Append - 7"); - end if; - - -- Append (Str, Bnd Str) - Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str), - AtoJ_Bnd_Str, - Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("abcdeabcde") then - Report.Failed("Incorrect truncation performed by Append - 8"); - end if; - - -- Append (Char, Bnd Str) - Result_String := B10.Append('A', AtoJ_Bnd_Str, Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("Aabcdefghi") then - Report.Failed("Incorrect truncation performed by Append - 9"); - end if; - - - -- Function Index with non-Identity map. - -- Evaluate the function Index with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the index position search. - - Location := B10.Index(Source => AtoJ_Bnd_Str, -- "abcdefghij" - Pattern => "xy", - Going => Ada.Strings.Forward, - Mapping => CD_to_XY_Map); -- change "cd" to "xy" - - if Location /= 3 then - Report.Failed("Incorrect result from Index, non-Identity map - 1"); - end if; - - Location := B10.Index(B10.To_Bounded_String("AND IF MAN"), - "an", - Ada.Strings.Backward, - ASC.Lower_Case_Map); - - if Location /= 9 then - Report.Failed("Incorrect result from Index, non-Identity map - 2"); - end if; - - Location := B10.Index(Source => B10.To_Bounded_String("The the"), - Pattern => "the", - Going => Ada.Strings.Forward, - Mapping => ASC.Lower_Case_Map); - - if Location /= 1 then - Report.Failed("Incorrect result from Index, non-Identity map - 3"); - end if; - - - if B10.Index(B10.To_Bounded_String("abcd"), -- Pattern = Source - "abcd") /= 1 or - B10.Index(B10.To_Bounded_String("abc"), -- Pattern < Source - "abcd") /= 0 or - B10.Index(B10.Null_Bounded_String, -- Source = Null - "abc") /= 0 - then - Report.Failed("Incorrect result from Index with string patterns"); - end if; - - - -- Function Index (for Sets). - -- This version of Index uses Sets as the basis of the search. - - -- Test = Inside, Going = Forward (Default case). - Location := - B10.Index(Source => B10.To_Bounded_String("abcdeabcde"), - Set => CD_Set, -- set containing 'c' and 'd' - Test => Ada.Strings.Inside, - Going => Ada.Strings.Forward); - - if not (Location = 3) then -- position of first 'c' in source. - Report.Failed("Incorrect result from Index using Sets - 1"); - end if; - - -- Test = Inside, Going = Backward. - Location := - B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), - Set => CD_Set, -- set containing 'c' and 'd' - Test => Ada.Strings.Inside, - Going => Ada.Strings.Backward); - - if not (Location = 9) then -- position of last 'd' in source. - Report.Failed("Incorrect result from Index using Sets - 2"); - end if; - - -- Test = Outside, Going = Forward. - Location := B10.Index(B10.To_Bounded_String("deddacd"), - CD_Set, - Test => Ada.Strings.Outside, - Going => Ada.Strings.Forward); - - if Location /= 2 then -- position of 'e' in source. - Report.Failed("Incorrect result from Index using Sets - 3"); - end if; - - -- Test = Outside, Going = Backward. - Location := B10.Index(B10.To_Bounded_String("deddacd"), - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Backward); - - if Location /= 5 then -- correct position of 'a'. - Report.Failed("Incorrect result from Index using Sets - 4"); - end if; - - if B10.Index(B10.To_Bounded_String("cd"), -- Source = Set - CD_Set) /= 1 or - B10.Index(B10.To_Bounded_String("c"), -- Source < Set - CD_Set) /= 1 or - B10.Index(B10.Null_Bounded_String, -- Source = Null - CD_Set) /= 0 or - B10.Index(AtoE_Bnd_Str, -- "abcde" - Maps.Null_Set) /= 0 or -- Null set - B10.Index(AtoE_Bnd_Str, - Maps.To_Set('x')) /= 0 -- No match. - then - Report.Failed("Incorrect result from Index using Sets - 5"); - end if; - - - -- Function Count with non-Identity mapping. - -- Evaluate the function Count with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the number of matching patterns. - - Total_Count := - B10.Count(Source => B10.To_Bounded_String("abbabaabab"), - Pattern => "yz", - Mapping => AB_to_YZ_Map); - - if Total_Count /= 4 then - Report.Failed - ("Incorrect result from function Count, non-Identity map - 1"); - end if; - - -- And a few with identity maps as well. - - if B10.Count(B10.To_Bounded_String("ABABABABAB"), - "ABA", - Maps.Identity) /= 2 or - B10.Count(B10.To_Bounded_String("ADCBADABCD"), - "AB", - Maps.To_Mapping("CD", "AB")) /= 5 or - B10.Count(B10.To_Bounded_String("aaaaaaaaaa"), - "aaa") /= 3 or - B10.Count(B10.To_Bounded_String("XX"), -- Source < Pattern - "XXX", - Maps.Identity) /= 0 or - B10.Count(AtoE_Bnd_Str, -- Source = Pattern - "abcde") /= 1 or - B10.Count(B10.Null_Bounded_String, -- Source = Null - " ") /= 0 - then - Report.Failed - ("Incorrect result from function Count, w,w/o mapping"); - end if; - - - -- Procedure Translate - - -- Partial mapping of source. - - Test_String := B10.To_Bounded_String("abcdeabcab"); - - B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= B10.To_Bounded_String("yzcdeyzcyz") then - Report.Failed("Incorrect result from procedure Translate - 1"); - end if; - - -- Total mapping of source. - - Test_String := B10.To_Bounded_String("abbaaababb"); - - B10.Translate(Source => Test_String, Mapping => ASC.Upper_Case_Map); - - if Test_String /= B10.To_Bounded_String("ABBAAABABB") then - Report.Failed("Incorrect result from procedure Translate - 2"); - end if; - - -- No mapping of source. - - Test_String := B10.To_Bounded_String("xyzsypcc"); - - B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= B10.To_Bounded_String("xyzsypcc") then - Report.Failed("Incorrect result from procedure Translate - 3"); - end if; - - -- Map > 2 characters, partial mapping. - - Test_String := B10.To_Bounded_String("have faith"); - - B10.Translate(Test_String, - Maps.To_Mapping("aeiou", "AEIOU")); - - if Test_String /= B10.To_Bounded_String("hAvE fAIth") then - Report.Failed("Incorrect result from procedure Translate - 4"); - end if; - - - -- Function Replace_Slice - -- Evaluate function Replace_Slice with - -- a variety of Truncation options. - - -- Drop = Error (Default) - - begin - Test_String := AtoJ_Bnd_Str; - Result_String := - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 3, - High => 5, -- 3-5, 3 chars. - By => "xxxxxx"); -- more than 3. - Report.Failed("Length_Error not raised by Function Replace_Slice"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Function Replace_Slice"); - end; - - -- Drop = Left - - Result_String := - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 7, - High => 10, -- 7-10, 4 chars. - By => "xxxxxx", -- 6 chars. - Drop => Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("cdefxxxxxx") then -- drop a,b - Report.Failed - ("Incorrect result from Function Replace Slice, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 2, - High => 5, -- 2-5, 4 chars. - By => "xxxxxx", -- 6 chars. - Drop => Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("axxxxxxfgh") then -- drop i,j - Report.Failed - ("Incorrect result from Function Replace Slice, Drop = Right"); - end if; - - -- Low = High = Source'Last, "By" length = 1. - - if B10.Replace_Slice(AtoE_Bnd_Str, - B10.To_String(AtoE_Bnd_Str)'Last, - B10.To_String(AtoE_Bnd_Str)'Last, - "X", - Ada.Strings.Error) /= - B10.To_Bounded_String("abcdX") - then - Report.Failed("Incorrect result from Function Replace_Slice"); - end if; - - - - -- Procedure Replace_Slice - -- Evaluate procedure Replace_Slice with - -- a variety of Truncation options. - - -- Drop = Error (Default) - - begin - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 3, - High => 5, -- 3-5, 3 chars. - By => "xxxxxx"); -- more than 3. - Report.Failed("Length_Error not raised by Procedure Replace_Slice"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Procedure Replace_Slice"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 7, - High => 9, -- 7-9, 3 chars. - By => "xxxxx", -- 5 chars. - Drop => Ada.Strings.Left); - - if Test_String /= B10.To_Bounded_String("cdefxxxxxj") then -- drop a,b - Report.Failed - ("Incorrect result from Procedure Replace Slice, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, -- "abcdefghij" - Low => 1, - High => 3, -- 1-3, 3chars. - By => "xxxx", -- 4 chars. - Drop => Ada.Strings.Right); - - if Test_String /= B10.To_Bounded_String("xxxxdefghi") then -- drop j - Report.Failed - ("Incorrect result from Procedure Replace Slice, Drop = Right"); - end if; - - -- High = Source'First, Low > High (Insert before Low). - - Test_String := AtoE_Bnd_Str; - B10.Replace_Slice(Source => Test_String, -- "abcde" - Low => B10.To_String(Test_String)'Last, - High => B10.To_String(Test_String)'First, - By => "XXXX", -- 4 chars. - Drop => Ada.Strings.Right); - - if Test_String /= B10.To_Bounded_String("abcdXXXXe") then - Report.Failed - ("Incorrect result from Procedure Replace Slice"); - end if; - - - - -- Function Insert with Truncation - -- Drop = Error (Default). - - begin - Result_String := - B10.Insert(Source => AtoJ_Bnd_Str, -- "abcdefghij" - Before => 2, - New_Item => "xyz"); - Report.Failed("Length_Error not raised by Function Insert"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Insert"); - end; - - -- Drop = Left - - Result_String := - B10.Insert(Source => AtoJ_Bnd_Str, -- "abcdefghij" - Before => 5, - New_Item => "xyz", -- 3 additional chars. - Drop => Ada.Strings.Left); - - if B10.To_String(Result_String) /= "dxyzefghij" then -- drop a, b, c - Report.Failed("Incorrect result from Function Insert, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := - B10.Insert(Source => B10.To_Bounded_String("abcdef"), - Before => 2, - New_Item => "vwxyz", -- 5 additional chars. - Drop => Ada.Strings.Right); - - if B10.To_String(Result_String) /= "avwxyzbcde" then -- drop f. - Report.Failed("Incorrect result from Function Insert, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Insert(B10.To_Bounded_String("a"), 1, " B") /= - B10.To_Bounded_String(" Ba") or - B10.Insert(B10.Null_Bounded_String, 1, "abcde") /= - AtoE_Bnd_Str or - B10.Insert(B10.To_Bounded_String("ab"), 2, "") /= - B10.To_Bounded_String("ab") - then - Report.Failed("Incorrect result from Function Insert"); - end if; - - - -- Procedure Insert - - -- Drop = Error (Default). - begin - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, -- "abcdefghij" - Before => 9, - New_Item => "wxyz", - Drop => Ada.Strings.Error); - Report.Failed("Length_Error not raised by Procedure Insert"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Procedure Insert"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, -- "abcdefghij" - Before => B10.Length(Test_String), -- before last char - New_Item => "xyz", -- 3 additional chars. - Drop => Ada.Strings.Left); - - if B10.To_String(Test_String) /= "defghixyzj" then -- drop a, b, c - Report.Failed("Incorrect result from Procedure Insert, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, - Before => 4, - New_Item => "yz", -- 2 additional chars. - Drop => Ada.Strings.Right); - - if B10.To_String(Test_String) /= "abcyzdefgh" then -- drop i,j - Report.Failed - ("Incorrect result from Procedure Insert, Drop = Right"); - end if; - - -- Before = Source'First, New_Item length = 1. - - Test_String := B10.To_Bounded_String(" abc "); - B10.Insert(Test_String, - B10.To_String(Test_String)'First, - "Z"); - - if Test_String /= B10.To_Bounded_String("Z abc ") then - Report.Failed("Incorrect result from Procedure Insert"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4008; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a deleted file mode 100644 index f02ef036507..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a +++ /dev/null @@ -1,619 +0,0 @@ --- CXA4009.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 subprograms defined in package Ada.Strings.Bounded are --- available, and that they produce correct results, especially under --- conditions where truncation of the result is required. Specifically, --- check the subprograms Overwrite (function and procedure), Delete, --- Function Trim (blanks), Trim (Set characters, function and procedure), --- Head, Tail, and Replicate (characters and strings). --- --- TEST DESCRIPTION: --- This test, in conjunction with tests CXA4006, CXA4007, and CXA4008, --- will provide coverage of the most common usages of the functionality --- found in the Ada.Strings.Bounded package. It deals in large part --- with truncation effects and options. This test contains many small, --- specific test cases, situations that are often difficult to generate --- in large numbers in an application-based test. These cases represent --- specific usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 10 Apr 95 SAIC Corrected errors in Procedure Overwrite subtests. --- 01 Nov 95 SAIC Fixed bugs for ACVC 2.0.1. --- ---! - -with Report; -with Ada.Strings.Bounded; -with Ada.Strings.Maps; - -procedure CXA4009 is - -begin - - Report.Test("CXA4009", "Check that the subprograms defined in " & - "package Ada.Strings.Bounded are available, " & - "and that they produce correct results, " & - "especially under conditions where " & - "truncation of the result is required"); - - Test_Block: - declare - - package AS renames Ada.Strings; - package ASB renames Ada.Strings.Bounded; - package Maps renames Ada.Strings.Maps; - - package B10 is new ASB.Generic_Bounded_Length(Max => 10); - use type B10.Bounded_String; - - Result_String : B10.Bounded_String; - Test_String : B10.Bounded_String; - AtoE_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("abcde"); - FtoJ_Bnd_Str : B10.Bounded_String := B10.To_Bounded_String("fghij"); - AtoJ_Bnd_Str : B10.Bounded_String := - B10.To_Bounded_String("abcdefghij"); - - Location : Natural := 0; - Total_Count : Natural := 0; - - CD_Set : Maps.Character_Set := Maps.To_Set("cd"); - XY_Set : Maps.Character_Set := Maps.To_Set("xy"); - - - begin - - -- Function Overwrite with Truncation - -- Drop = Error (Default). - - begin - Test_String := AtoJ_Bnd_Str; - Result_String := - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => 9, - New_Item => "xyz", - Drop => AS.Error); - Report.Failed("Exception not raised by Function Overwrite"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Overwrite"); - end; - - -- Drop = Left - - Result_String := - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => B10.Length(Test_String), -- 10 - New_Item => "xyz", - Drop => Ada.Strings.Left); - - if B10.To_String(Result_String) /= "cdefghixyz" then -- drop a,b - Report.Failed - ("Incorrect result from Function Overwrite, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := B10.Overwrite(Test_String, -- "abcdefghij" - 3, - "xxxyyyzzz", - Ada.Strings.Right); - - if B10.To_String(Result_String) /= "abxxxyyyzz" then -- one 'z' dropped - Report.Failed - ("Incorrect result from Function Overwrite, Drop = Right"); - end if; - - -- Additional cases of function Overwrite. - - if B10.Overwrite(B10.To_Bounded_String("a"), -- Source length = 1 - 1, - " abc ") /= - B10.To_Bounded_String(" abc ") or - B10.Overwrite(B10.Null_Bounded_String, -- Null source - 1, - "abcdefghij") /= - AtoJ_Bnd_Str or - B10.Overwrite(AtoE_Bnd_Str, - B10.To_String(AtoE_Bnd_Str)'First, - " ") /= -- New_Item = 1 - B10.To_Bounded_String(" bcde") - then - Report.Failed("Incorrect result from Function Overwrite"); - end if; - - - - -- Procedure Overwrite - -- Correct usage, no truncation. - - Test_String := AtoE_Bnd_Str; -- "abcde" - B10.Overwrite(Test_String, 2, "xyz"); - - if Test_String /= B10.To_Bounded_String("axyze") then - Report.Failed("Incorrect result from Procedure Overwrite - 1"); - end if; - - Test_String := B10.To_Bounded_String("abc"); - B10.Overwrite(Test_String, 2, ""); -- New_Item is null string. - - if Test_String /= B10.To_Bounded_String("abc") then - Report.Failed("Incorrect result from Procedure Overwrite - 2"); - end if; - - -- Drop = Error (Default). - - begin - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => 8, - New_Item => "uvwxyz"); - Report.Failed("Exception not raised by Procedure Overwrite"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Procedure Overwrite"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => B10.Length(Test_String) - 2, -- 8 - New_Item => "uvwxyz", - Drop => Ada.Strings.Left); - - if B10.To_String(Test_String) /= "defguvwxyz" then -- drop a-c - Report.Failed - ("Incorrect result from Procedure Overwrite, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Test_String, -- "abcdefghij" - 3, - "xxxyyyzzz", - Ada.Strings.Right); - - if B10.To_String(Test_String) /= "abxxxyyyzz" then -- one 'z' dropped - Report.Failed - ("Incorrect result from Procedure Overwrite, Drop = Right"); - end if; - - - - -- Function Delete - - if B10.Delete(Source => AtoJ_Bnd_Str, -- "abcdefghij" - From => 3, - Through => 8) /= - B10."&"(B10.Head(AtoJ_Bnd_Str, 2), - B10.Tail(AtoJ_Bnd_Str, 2)) or - B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str)) /= - AtoE_Bnd_Str or - B10.Delete(AtoJ_Bnd_Str, 1, 5) /= - FtoJ_Bnd_Str or - B10.Delete(AtoE_Bnd_Str, 4, 5) /= - B10.Delete(AtoJ_Bnd_Str, 4, B10.Length(AtoJ_Bnd_Str)) - then - Report.Failed("Incorrect result from Function Delete - 1"); - end if; - - if B10.Delete(B10.To_Bounded_String("a"), 1, 1) /= - B10.Null_Bounded_String or - B10.Delete(AtoE_Bnd_Str, - 5, - B10.To_String(AtoE_Bnd_Str)'First) /= - AtoE_Bnd_Str or - B10.Delete(AtoE_Bnd_Str, - B10.To_String(AtoE_Bnd_Str)'Last, - B10.To_String(AtoE_Bnd_Str)'Last) /= - B10.To_Bounded_String("abcd") - then - Report.Failed("Incorrect result from Function Delete - 2"); - end if; - - - - -- Function Trim - - declare - - Text : B10.Bounded_String := B10.To_Bounded_String("Text"); - type Bnd_Array_Type is array (1..5) of B10.Bounded_String; - Bnd_Array : Bnd_Array_Type := - (B10.To_Bounded_String(" Text"), - B10.To_Bounded_String("Text "), - B10.To_Bounded_String(" Text "), - B10.To_Bounded_String("Text Text"), -- Ensure no inter-string - B10.To_Bounded_String(" Text Text")); -- trimming of blanks. - - begin - - for i in Bnd_Array_Type'Range loop - case i is - when 4 => - if B10.Trim(Bnd_Array(i), AS.Both) /= - Bnd_Array(i) then -- no change - Report.Failed("Incorrect result from Function Trim - 4"); - end if; - when 5 => - if B10.Trim(Bnd_Array(i), AS.Both) /= - B10."&"(Text, B10."&"(' ', Text)) then - Report.Failed("Incorrect result from Function Trim - 5"); - end if; - when others => - if B10.Trim(Bnd_Array(i), AS.Both) /= Text then - Report.Failed("Incorrect result from Function Trim - " & - Integer'Image(i)); - end if; - end case; - end loop; - - end; - - - - -- Function Trim using Sets - - -- Trim characters in sets from both sides of the bounded string. - if B10.Trim(Source => B10.To_Bounded_String("ddabbaxx"), - Left => CD_Set, - Right => XY_Set) /= - B10.To_Bounded_String("abba") - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 1"); - end if; - - -- Ensure that the characters in the set provided as the actual to - -- parameter Right are not trimmed from the left side of the bounded - -- string; likewise for the opposite side. Only "cd" trimmed from left - -- side, and only "xy" trimmed from right side. - - if B10.Trim(B10.To_Bounded_String("cdxyabcdxy"), CD_Set, XY_Set) /= - B10.To_Bounded_String("xyabcd") - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 2"); - end if; - - -- Ensure that characters contained in the sets are not trimmed from - -- the "interior" of the bounded string, just the appropriate ends. - - if B10.Trim(B10.To_Bounded_String("cdabdxabxy"), CD_Set, XY_Set) /= - B10.To_Bounded_String("abdxab") - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 3"); - end if; - - -- Trim characters in set from right side only. No change to Left side. - - if B10.Trim(B10.To_Bounded_String("abxyzddcd"), XY_Set, CD_Set) /= - B10.To_Bounded_String("abxyz") - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Right side"); - end if; - - -- Trim no characters on either side of the bounded string. - - Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set); - if Result_String /= AtoJ_Bnd_Str then - Report.Failed("Incorrect result from Fn Trim - Sets, Neither side"); - end if; - - if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /= - AtoE_Bnd_Str or - B10.Trim(B10.To_Bounded_String("dcddcxyyxx"), - CD_Set, - XY_Set) /= - B10.Null_Bounded_String - then - Report.Failed("Incorrect result from Function Trim"); - end if; - - - - -- Procedure Trim using Sets - - -- Trim characters in sets from both sides of the bounded string. - - Test_String := B10.To_Bounded_String("dcabbayx"); - B10.Trim(Source => Test_String, - Left => CD_Set, - Right => XY_Set); - - if Test_String /= B10.To_Bounded_String("abba") then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 1"); - end if; - - -- Ensure that the characters in the set provided as the actual to - -- parameter Right are not trimmed from the left side of the bounded - -- string; likewise for the opposite side. Only "cd" trimmed from left - -- side, and only "xy" trimmed from right side. - - Test_String := B10.To_Bounded_String("cdxyabcdxy"); - B10.Trim(Test_String, CD_Set, XY_Set); - - if Test_String /= B10.To_Bounded_String("xyabcd") then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 2"); - end if; - - -- Ensure that characters contained in the sets are not trimmed from - -- the "interior" of the bounded string, just the appropriate ends. - - Test_String := B10.To_Bounded_String("cdabdxabxy"); - B10.Trim(Test_String, CD_Set, XY_Set); - - if not (Test_String = B10.To_Bounded_String("abdxab")) then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 3"); - end if; - - -- Trim characters in set from Left side only. No change to Right side. - - Test_String := B10.To_Bounded_String("cccdabxyz"); - B10.Trim(Test_String, CD_Set, XY_Set); - - if Test_String /= B10.To_Bounded_String("abxyz") then - Report.Failed - ("Incorrect result from Proc Trim for Sets, Left side only"); - end if; - - -- Trim no characters on either side of the bounded string. - - Test_String := AtoJ_Bnd_Str; - B10.Trim(Test_String, CD_Set, CD_Set); - - if Test_String /= AtoJ_Bnd_Str then - Report.Failed("Incorrect result from Proc Trim-Sets, Neither side"); - end if; - - - - -- Function Head with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Head(Source => AtoJ_Bnd_Str, -- max length - Count => B10.Length(AtoJ_Bnd_Str) + 1, - Pad => 'X'); - Report.Failed("Length_Error not raised by Function Head"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Head"); - end; - - -- Drop = Left - - -- Pad characters (5) are appended to the right end of the string - -- (which is initially at its maximum length), then the first five - -- characters of the intermediate result are dropped to conform to - -- the maximum size limit of the bounded string (10). - - Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHIJ"), - 15, - 'x', - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("FGHIJxxxxx") then - Report.Failed("Incorrect result from Function Head, Drop = Left"); - end if; - - -- Drop = Right - - -- Pad characters (6) are appended to the left end of the string - -- (which is initially at one less than its maximum length), then the - -- last five characters of the intermediate result are dropped - -- (which in this case are the pad characters) to conform to the - -- maximum size limit of the bounded string (10). - - Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHI"), - 15, - 'x', - Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("ABCDEFGHIx") then - Report.Failed("Incorrect result from Function Head, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Head(B10.Null_Bounded_String, 5) /= - B10.To_Bounded_String(" ") or - B10.Head(AtoE_Bnd_Str, - B10.Length(AtoE_Bnd_Str)) /= - AtoE_Bnd_Str - then - Report.Failed("Incorrect result from Function Head"); - end if; - - - - -- Function Tail with Truncation - -- Drop = Error (Default Case) - - begin - Result_String := B10.Tail(Source => AtoJ_Bnd_Str, -- max length - Count => B10.Length(AtoJ_Bnd_Str) + 1, - Pad => Ada.Strings.Space, - Drop => Ada.Strings.Error); - Report.Failed("Length_Error not raised by Function Tail"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Tail"); - end; - - -- Drop = Left - - -- Pad characters (5) are appended to the left end of the string - -- (which is initially at two less than its maximum length), then - -- the first three characters of the intermediate result (in this - -- case, 3 pad characters) are dropped. - - Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGH"), -- 8 ch - 13, - 'x', - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("xxABCDEFGH") then - Report.Failed("Incorrect result from Function Tail, Drop = Left"); - end if; - - -- Drop = Right - - -- Pad characters (3) are appended to the left end of the string - -- (which is initially at its maximum length), then the last three - -- characters of the intermediate result are dropped. - - Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGHIJ"), - 13, - 'x', - Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("xxxABCDEFG") then - Report.Failed("Incorrect result from Function Tail, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Tail(B10.Null_Bounded_String, 3, ' ') /= - B10.To_Bounded_String(" ") or - B10.Tail(AtoE_Bnd_Str, - B10.To_String(AtoE_Bnd_Str)'First) /= - B10.To_Bounded_String("e") - then - Report.Failed("Incorrect result from Function Tail"); - end if; - - - - -- Function Replicate (#, Char) with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Replicate(Count => B10.Max_Length + 5, - Item => 'A', - Drop => AS.Error); - Report.Failed - ("Length_Error not raised by Replicate for characters"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Replicate for characters"); - end; - - -- Drop = Left, Right - -- Since this version of Replicate uses character parameters, the - -- result after truncation from left or right will appear the same. - -- The result will be a 10 character bounded string, composed of 10 - -- "Item" characters. - - if B10.Replicate(Count => 20, Item => 'A', Drop => Ada.Strings.Left) /= - B10.Replicate(15, 'A', Ada.Strings.Right) - then - Report.Failed("Incorrect result from Replicate for characters - 1"); - end if; - - -- Blank-filled 10 character bounded strings. - - if B10.Replicate(B10.Max_Length + 1, ' ', Drop => Ada.Strings.Left) /= - B10.Replicate(B10.Max_Length, Ada.Strings.Space) - then - Report.Failed("Incorrect result from Replicate for characters - 2"); - end if; - - -- Additional cases. - - if B10.Replicate(0, 'a') /= B10.Null_Bounded_String or - B10.Replicate(1, 'a') /= B10.To_Bounded_String("a") - then - Report.Failed("Incorrect result from Replicate for characters - 3"); - end if; - - - - -- Function Replicate (#, String) with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Replicate(Count => 5, -- result would be 15. - Item => "abc"); - Report.Failed - ("Length_Error not raised by Replicate for strings"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Replicate for strings"); - end; - - -- Drop = Left - - Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_String("cdabcdabcd") then - Report.Failed - ("Incorrect result from Replicate for strings, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_String("abcdabcdab") then - Report.Failed - ("Incorrect result from Replicate for strings, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Replicate(10, "X") /= B10.To_Bounded_String("XXXXXXXXXX") or - B10.Replicate(10, "") /= B10.Null_Bounded_String or - B10.Replicate( 0, "ab") /= B10.Null_Bounded_String - then - Report.Failed("Incorrect result from Replicate for strings"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4009; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a deleted file mode 100644 index 8646b12b5e4..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a +++ /dev/null @@ -1,275 +0,0 @@ --- CXA4010.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 subprograms defined in package Ada.Strings.Unbounded --- are available, and that they produce correct results. Specifically, --- check the subprograms To_String, To_Unbounded_String, Insert, "&", --- "*", Length, Slice, Replace_Slice, Overwrite, Index, Index_Non_Blank, --- Head, Tail, and "=", "<=", ">=". --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Unbounded for use with unbounded strings. --- The test simulates how unbounded strings could be used --- to simulate paragraphs of text. Modifications could be easily be --- performed using the provided subprograms (although in this test, the --- main modification performed was the addition of more text to the --- string). One would not have to worry about the formatting of the --- paragraph until it was finished and correct in content. Then, once --- all required editing is complete, the unbounded strings can be divided --- up into the appropriate lengths based on particular formatting --- requirements. The test then compares the formatted text product --- with a predefined "finished product". --- --- This test uses a large number of the subprograms provided --- by package Ada.Strings.Unbounded. Often, the processing involved --- could have been performed more efficiently using a minimum number --- of the subprograms, in conjunction with loops, etc. However, for --- testing purposes, and in the interest of minimizing the number of --- tests developed, subprogram variety and feature mixing was stressed. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Report; -with Ada.Strings.Maps; -with Ada.Strings.Unbounded; - -procedure CXA4010 is -begin - - Report.Test ("CXA4010", "Check that the subprograms defined in " & - "package Ada.Strings.Unbounded are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASUnb renames Ada.Strings.Unbounded; - use type ASUnb.Unbounded_String; - use Ada.Strings; - - Pamphlet_Paragraph_Count : constant := 2; - Lines : constant := 4; - Line_Length : constant := 40; - - type Document_Type is array (Positive range <>) - of ASUnb.Unbounded_String; - - type Camera_Ready_Copy_Type is array (1..Lines) - of String (1..Line_Length); - - Pamphlet : Document_Type (1..Pamphlet_Paragraph_Count); - - Camera_Ready_Copy : Camera_Ready_Copy_Type := - (others => (others => Ada.Strings.Space)); - - TC_Finished_Product : Camera_Ready_Copy_Type := - ( 1 => "Ada is a programming language designed ", - 2 => "to support long-lived, reliable software", - 3 => " systems. ", - 4 => "Go with Ada! "); - - ----- - - - procedure Enter_Text_Into_Document (Document : in out Document_Type) is - begin - - -- Fill in both "paragraphs" of the document. Each unbounded string - -- functions as an individual paragraph, containing an unspecified - -- number of characters. - -- Use a variety of different unbounded string subprograms to load - -- the data. - - Document(1) := ASUnb.To_Unbounded_String("Ada is a language"); - - -- Insert the word "programming" prior to "language". - Document(1) := - ASUnb.Insert(Document(1), - ASUnb.Index(Document(1), - "language"), - ASUnb.To_String("progra" & -- Str & - ASUnb."*"(2,'m') & -- Unbd & - "ing ")); -- Str - - - -- Overwrite the word "language" with "language" + additional text. - Document(1) := - ASUnb.Overwrite(Document(1), - ASUnb.Index(Document(1), - ASUnb.To_String( - ASUnb.Tail(Document(1), 8, ' ')), - Ada.Strings.Backward), - "language designed to support long-lifed"); - - - -- Replace the word "lifed" with "lived". - Document(1) := - ASUnb.Replace_Slice(Document(1), - ASUnb.Index(Document(1), "lifed"), - ASUnb.Length(Document(1)), - "lived"); - - - -- Overwrite the word "lived" with "lived" + additional text. - Document(1) := - ASUnb.Overwrite(Document(1), - ASUnb.Index(Document(1), - ASUnb.To_String( - ASUnb.Tail(Document(1), 5, ' ')), - Ada.Strings.Backward), - "lived, reliable software systems."); - - - -- Use several of the overloaded versions of "&" to form this - -- unbounded string. - - Document(2) := 'G' & - ASUnb.To_Unbounded_String("o ") & - ASUnb.To_Unbounded_String("with") & - ' ' & - "Ada!"; - - end Enter_Text_Into_Document; - - - ----- - - - procedure Create_Camera_Ready_Copy - (Document : in Document_Type; - Camera_Copy : out Camera_Ready_Copy_Type) is - begin - -- Break the unbounded strings into fixed lengths. - - -- Search the first unbounded string for portions of text that - -- are less than or equal to the length of a string in the - -- Camera_Ready_Copy_Type object. - - Camera_Copy(1) := -- Take characters 1-39, - ASUnb.Slice(Document(1), -- and append a blank space. - 1, - ASUnb.Index(ASUnb.To_Unbounded_String( - ASUnb.Slice(Document(1), - 1, - Line_Length)), - Ada.Strings.Maps.To_Set(' '), - Ada.Strings.Inside, - Ada.Strings.Backward)) & ' '; - - Camera_Copy(2) := -- Take characters 40-79. - ASUnb.Slice(Document(1), - 40, - (ASUnb.Index_Non_Blank -- Should return 79 - (ASUnb.To_Unbounded_String - (ASUnb.Slice(Document(1), -- Slice (40..79) - 40, - 79)), - Ada.Strings.Backward) + 39)); -- Increment since - -- this slice starts - -- at 40. - - Camera_Copy(3)(1..9) := ASUnb.Slice(Document(1), -- Characters 80-88 - 80, - ASUnb.Length(Document(1))); - - - -- Break the second unbounded string into the appropriate length. - -- It is only twelve characters in length, so the entire unbounded - -- string will be placed on one string of the output object. - - Camera_Copy(4)(1..ASUnb.Length(Document(2))) := - ASUnb.To_String(ASUnb.Head(Document(2), - ASUnb.Length(Document(2)))); - - end Create_Camera_Ready_Copy; - - - ----- - - - function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) - return Boolean is - begin - - -- Evaluate strings for equality, using the operators defined in - -- package Ada.Strings.Unbounded. The less than/greater than or - -- equal comparisons should evaluate to "equals => True". - - if ASUnb.To_Unbounded_String(Draft(1)) = -- "="(Unb,Unb) - ASUnb.To_Unbounded_String(Master(1)) and - ASUnb.To_Unbounded_String(Draft(2)) <= -- "<="(Unb,Unb) - ASUnb.To_Unbounded_String(Master(2)) and - ASUnb.To_Unbounded_String(Draft(3)) >= -- ">="(Unb,Unb) - ASUnb.To_Unbounded_String(Master(3)) and - ASUnb.To_Unbounded_String(Draft(4)) = -- "="(Unb,Unb) - ASUnb.To_Unbounded_String(Master(4)) - then - return True; - else - return False; - end if; - - end Valid_Proofread; - - - ----- - - - begin - - -- Enter text into the unbounded string paragraphs of the document. - - Enter_Text_Into_Document (Pamphlet); - - - -- Reformat the unbounded strings into fixed string format. - - Create_Camera_Ready_Copy (Document => Pamphlet, - Camera_Copy => Camera_Ready_Copy); - - - -- Verify the conversion process. - - if not Valid_Proofread (Draft => Camera_Ready_Copy, - Master => TC_Finished_Product) - then - Report.Failed ("Incorrect string processing result"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4010; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a deleted file mode 100644 index 05388a04ba7..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a +++ /dev/null @@ -1,376 +0,0 @@ --- CXA4011.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 subprograms defined in package Ada.Strings.Unbounded --- are available, and that they produce correct results. Specifically, --- check the subprograms To_Unbounded_String, "&", ">", "<", Element, --- Replace_Element, Count, Find_Token, Translate, Trim, Delete, and --- "*". --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Unbounded for use with unbounded strings. --- The test simulates how unbounded strings could be processed in a --- user environment, using the subprograms provided in this package. --- --- This test uses a variety of the subprograms defined in the unbounded --- string package in ways typical of common usage, with different --- combinations of available subprograms being used to accomplish --- similar unbounded string processing goals. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Feb 95 SAIC Test description modification. --- 01 Nov 95 SAIC Update and repair for ACVC 2.0.1. --- ---! - -with Report; -with Ada.Strings.Maps; -with Ada.Strings.Unbounded; - -procedure CXA4011 is -begin - - Report.Test ("CXA4011", "Check that the subprograms defined in " & - "package Ada.Strings.Unbounded are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASUnb renames Ada.Strings.Unbounded; - use Ada.Strings; - use type Maps.Character_Set; - use type ASUnb.Unbounded_String; - - Cad_String : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("cad"); - - Complete_String : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Incomplete") & - Ada.Strings.Space & - ASUnb.To_Unbounded_String("String"); - - Incomplete_String : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("ncomplete Strin"); - - Incorrect_Spelling : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Guob Dai"); - - Magic_String : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("abracadabra"); - - Incantation : ASUnb.Unbounded_String := Magic_String; - - - A_Small_G : Character := 'g'; - A_Small_D : Character := 'd'; - - ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd"); - B_Set : Maps.Character_Set := Maps.To_Set('b'); - AB_Set : Maps.Character_Set := Maps."OR"(Maps.To_Set('a'), B_Set); - - Code_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "abcd", To => "wxyz"); - Reverse_Code_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "wxyz", To => "abcd"); - Non_Existent_Map : Maps.Character_Mapping := - Maps.To_Mapping(From => "jkl", To => "mno"); - - - Token_Start : Positive; - Token_End : Natural := 0; - Matching_Letters : Natural := 0; - - - begin - - -- "&" - - -- Prepend an 'I' and append a 'g' to the string. - Incomplete_String := ASUnb."&"('I', Incomplete_String); -- Char & Unb - Incomplete_String := ASUnb."&"(Incomplete_String, - A_Small_G); -- Unb & Char - - if Incomplete_String < Complete_String or - Incomplete_String > Complete_String or - Incomplete_String /= Complete_String - then - Report.Failed("Incorrect result from use of ""&"" operator"); - end if; - - - -- Element - - -- Last element of the unbounded string should be a 'g'. - if ASUnb.Element(Incomplete_String, ASUnb.Length(Incomplete_String)) /= - A_Small_G - then - Report.Failed("Incorrect result from use of Function Element - 1"); - end if; - - if ASUnb.Element(Incomplete_String, 2) /= - ASUnb.Element(ASUnb.Tail(Incomplete_String, 2), 1) or - ASUnb.Element(ASUnb.Head(Incomplete_String, 4), 2) /= - ASUnb.Element(ASUnb.To_Unbounded_String("wnqz"), 2) - then - Report.Failed("Incorrect result from use of Function Element - 2"); - end if; - - - -- Replace_Element - - -- The unbounded string Incorrect_Spelling starts as "Guob Dai", and - -- is transformed by the following three procedure calls to "Good Day". - - ASUnb.Replace_Element(Incorrect_Spelling, 2, 'o'); - - ASUnb.Replace_Element(Incorrect_Spelling, - ASUnb.Index(Incorrect_Spelling, B_Set), - A_Small_D); - - ASUnb.Replace_Element(Source => Incorrect_Spelling, - Index => ASUnb.Length(Incorrect_Spelling), - By => 'y'); - - if Incorrect_Spelling /= ASUnb.To_Unbounded_String("Good Day") then - Report.Failed("Incorrect result from Procedure Replace_Element"); - end if; - - - -- Count - - -- Determine the number of characters in the unbounded string that - -- are contained in the set. - - Matching_Letters := ASUnb.Count(Source => Magic_String, - Set => ABCD_Set); - - if Matching_Letters /= 9 then - Report.Failed - ("Incorrect result from Function Count with Set parameter"); - end if; - - -- Determine the number of occurrences of the following pattern strings - -- in the unbounded string Magic_String. - - if ASUnb.Count(Magic_String, "ab") /= - (ASUnb.Count(Magic_String, "ac") + ASUnb.Count(Magic_String, "ad")) or - ASUnb.Count(Magic_String, "ab") /= 2 - then - Report.Failed - ("Incorrect result from Function Count with String parameter"); - end if; - - - -- Find_Token - - ASUnb.Find_Token(Magic_String, -- Find location of first "ab". - AB_Set, -- Should be (1..2). - Ada.Strings.Inside, - Token_Start, - Token_End); - - if Natural(Token_Start) /= ASUnb.To_String(Magic_String)'First or - Token_End /= ASUnb.Index(Magic_String, B_Set) - then - Report.Failed("Incorrect result from Procedure Find_Token - 1"); - end if; - - - ASUnb.Find_Token(Source => Magic_String, -- Find location of char 'r' - Set => ABCD_Set, -- in string, should be (3..3) - Test => Ada.Strings.Outside, - First => Token_Start, - Last => Token_End); - - if Natural(Token_Start) /= 3 or - Token_End /= 3 then - Report.Failed("Incorrect result from Procedure Find_Token - 2"); - end if; - - - ASUnb.Find_Token(Magic_String, -- No 'g' is in the string, so - Maps.To_Set(A_Small_G), -- the result parameters should - Ada.Strings.Inside, -- be First = Source'First and - First => Token_Start, -- Last = 0. - Last => Token_End); - - if Token_Start /= ASUnb.To_String(Magic_String)'First or - Token_End /= 0 - then - Report.Failed("Incorrect result from Procedure Find_Token - 3"); - end if; - - - -- Translate - - -- Use a mapping ("abcd" -> "wxyz") to transform the contents of - -- the unbounded string. - -- Magic_String = "abracadabra" - - Incantation := ASUnb.Translate(Magic_String, Code_Map); - - if Incantation /= ASUnb.To_Unbounded_String("wxrwywzwxrw") then - Report.Failed("Incorrect result from Function Translate"); - end if; - - -- Use the inverse mapping of the one above to return the "translated" - -- unbounded string to its original form. - - ASUnb.Translate(Incantation, Reverse_Code_Map); - - -- The map contained in the following call to Translate contains one - -- element, and this element is not found in the unbounded string, so - -- this call to Translate should have no effect on the unbounded string. - - if Incantation /= ASUnb.Translate(Magic_String, Non_Existent_Map) then - Report.Failed("Incorrect result from Procedure Translate"); - end if; - - - -- Trim - - Trim_Block: - declare - - XYZ_Set : Maps.Character_Set := Maps.To_Set("xyz"); - PQR_Set : Maps.Character_Set := Maps.To_Set("pqr"); - - Pad : constant ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Pad"); - - The_New_Ada : constant ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Ada9X"); - - Space_Array : array (1..4) of ASUnb.Unbounded_String := - (ASUnb.To_Unbounded_String(" Pad "), - ASUnb.To_Unbounded_String("Pad "), - ASUnb.To_Unbounded_String(" Pad"), - Pad); - - String_Array : array (1..5) of ASUnb.Unbounded_String := - (ASUnb.To_Unbounded_String("xyzxAda9Xpqr"), - ASUnb.To_Unbounded_String("Ada9Xqqrp"), - ASUnb.To_Unbounded_String("zxyxAda9Xqpqr"), - ASUnb.To_Unbounded_String("xxxyAda9X"), - The_New_Ada); - - begin - - -- Examine the version of Trim that removes blanks from - -- the left and/or right of a string. - - for i in 1..4 loop - if ASUnb.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then - Report.Failed("Incorrect result from Trim for spaces - " & - Integer'Image(i)); - end if; - end loop; - - -- Examine the version of Trim that removes set characters from - -- the left and right of a string. - - for i in 1..5 loop - if ASUnb.Trim(String_Array(i), - Left => XYZ_Set, - Right => PQR_Set) /= The_New_Ada then - Report.Failed - ("Incorrect result from Trim for set characters - " & - Integer'Image(i)); - end if; - end loop; - - end Trim_Block; - - - -- Delete - - -- Use the Delete function to remove the first four and last four - -- characters from the string. - - if ASUnb.Delete(Source => ASUnb.Delete(Magic_String, - 8, - ASUnb.Length(Magic_String)), - From => ASUnb.To_String(Magic_String)'First, - Through => 4) /= - Cad_String - then - Report.Failed("Incorrect results from Function Delete"); - end if; - - - -- Constructors ("*") - - Constructor_Block: - declare - - SOS : ASUnb.Unbounded_String; - - Dot : constant ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Dot_"); - Dash : constant String := "Dash_"; - - Distress : ASUnb.Unbounded_String := - ASUnb.To_Unbounded_String("Dot_Dot_Dot_") & - ASUnb.To_Unbounded_String("Dash_Dash_Dash_") & - ASUnb.To_Unbounded_String("Dot_Dot_Dot"); - - Repeat : constant Natural := 3; - Separator : constant Character := '_'; - - Separator_Set : Maps.Character_Set := Maps.To_Set(Separator); - - begin - - -- Use the following constructor forms to construct the string - -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot". Note that the - -- trailing underscore in the string is removed in the call to - -- Trim in the If statement condition. - - SOS := ASUnb."*"(Repeat, Dot); -- "*"(#, Unb Str) - - SOS := SOS & - ASUnb."*"(Repeat, Dash) & -- "*"(#, Str) - ASUnb."*"(Repeat, Dot); -- "*"(#, Unb Str) - - if ASUnb.Trim(SOS, Maps.Null_Set, Separator_Set) /= Distress then - Report.Failed("Incorrect results from Function ""*"""); - end if; - - end Constructor_Block; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4011; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a deleted file mode 100644 index 5ab12b6dfa9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a +++ /dev/null @@ -1,305 +0,0 @@ --- CXA4012.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 types, operations, and other entities defined within --- the package Ada.Strings.Wide_Maps are available and produce correct --- results. --- --- TEST DESCRIPTION: --- This test demonstrates the availability and function of the types and --- operations defined in package Ada.Strings.Wide_Maps. It demonstrates --- the use of these types and functions as they would be used in common --- programming practice. --- Wide_Character set creation, assignment, and comparison are evaluated --- in this test. Each of the functions provided in package --- Ada.Strings.Wide_Maps is utilized in creating or manipulating set --- objects, and the function results are evaluated for correctness. --- Wide_Character sequences are examined using the functions provided for --- manipulating objects of this type. Likewise, Wide_Character maps are --- created, and their contents evaluated. Exception raising conditions --- from the function To_Mapping are also created. --- Note: Throughout this test, the set logical operators are printed in --- capital letters to enhance their visibility. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 01 Nov 95 SAIC Update and repair for ACVC 2.0.1. --- ---! - -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; - -package CXA40120 is - - function Equiv (Ch : Character) return Wide_Character; - function Equiv (Str : String) - return Ada.Strings.Wide_Maps.Wide_Character_Sequence; - function X_Map(From : Wide_Character) return Wide_Character; - -end CXA40120; - -package body CXA40120 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to certain Wide_Map - -- subprogram parameters to simulate the use of Wide_Characters and - -- Wide_Character_Sequences in actual practice. - -- Note: These functions do not actually return "equivalent" wide - -- characters to their character inputs, just "non-character" - -- wide characters. - - function Equiv (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Equiv; - - function Equiv (Str : String) - return Ada.Strings.Wide_Maps.Wide_Character_Sequence is - use Ada.Strings; - WS : Wide_Maps.Wide_Character_Sequence(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Equiv(Str(i)); - end loop; - return WS; - end Equiv; - - function X_Map(From : Wide_Character) return Wide_Character is - begin - return Equiv('X'); - end X_Map; - -end CXA40120; - - - -with CXA40120; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; -with Report; - -procedure CXA4012 is - - use CXA40120; - use Ada.Strings; - -begin - - Report.Test ("CXA4012", "Check that the types, operations, and other " & - "entities defined within the package " & - "Ada.Strings.Wide_Maps are available and " & - "produce correct results"); - - Test_Block: - declare - - use type Wide_Maps.Wide_Character_Set; - - MidPoint_Letter : constant := 13; - Last_Letter : constant := 26; - - Vowels : constant Wide_Maps.Wide_Character_Sequence := - Equiv("aeiou"); - Quasi_Vowel : constant Wide_Character := Equiv('y'); - - Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter); - Half_Alphabet : Wide_Maps.Wide_Character_Sequence(1..MidPoint_Letter); - Inverse_Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter); - - Alphabet_Set, - Consonant_Set, - Vowel_Set, - Full_Vowel_Set, - First_Half_Set, - Second_Half_Set : Wide_Maps.Wide_Character_Set := Wide_Maps.Null_Set; - - begin - - -- Load the alphabet string for use in creating sets. - - for i in 0..MidPoint_Letter-1 loop - Half_Alphabet(i+1) := - Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i); - end loop; - - for i in 0..Last_Letter-1 loop - Alphabet(i+1) := - Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i); - end loop; - - - -- Initialize a series of Wide_Character_Set objects. - - Alphabet_Set := Wide_Maps.To_Set(Alphabet); - Vowel_Set := Wide_Maps.To_Set(Vowels); - Full_Vowel_Set := Vowel_Set OR Wide_Maps.To_Set(Quasi_Vowel); - Consonant_Set := Vowel_Set XOR Alphabet_Set; - - First_Half_Set := Wide_Maps.To_Set(Half_Alphabet); - Second_Half_Set := Alphabet_Set XOR First_Half_Set; - - - -- Evaluation of Set objects, operators, and functions. - - if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then - Report.Failed("Incorrect set combinations using OR operator"); - end if; - - - for i in Vowels'First .. Vowels'Last loop - if not Wide_Maps.Is_In(Vowels(i), Vowel_Set) or - not Wide_Maps.Is_In(Vowels(i), Alphabet_Set) or - Wide_Maps.Is_In(Vowels(i), Consonant_Set) - then - Report.Failed("Incorrect function Is_In use with set " & - "combinations - " & Integer'Image(i)); - end if; - end loop; - - - if Wide_Maps.Is_Subset(Vowel_Set, First_Half_Set) or - Wide_Maps."<="(Vowel_Set, Second_Half_Set) or - not Wide_Maps.Is_Subset(Vowel_Set, Alphabet_Set) - then - Report.Failed - ("Incorrect set evaluation using Is_Subset function"); - end if; - - - if not (Full_Vowel_Set = Wide_Maps.To_Set(Equiv("aeiouy"))) then - Report.Failed("Incorrect result for ""="" set operator"); - end if; - - - if not ((Vowel_Set AND First_Half_Set) OR - (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then - Report.Failed - ("Incorrect result for AND, OR, or ""="" set operators"); - end if; - - - if (Alphabet_Set AND Wide_Maps.Null_Set) /= Wide_Maps.Null_Set or - (Alphabet_Set OR Wide_Maps.Null_Set) /= Alphabet_Set - then - Report.Failed("Incorrect result for AND or OR set operators"); - end if; - - - Vowel_Set := Full_Vowel_Set; - Vowel_Set := Vowel_Set AND (NOT Wide_Maps.To_Set(Quasi_Vowel)); - - if not (Vowels = Wide_Maps.To_Sequence(Vowel_Set)) then - Report.Failed("Incorrect Set to Sequence translation"); - end if; - - - for i in 0..Last_Letter-1 loop - Inverse_Alphabet(i+1) := Alphabet(Last_Letter-i); - end loop; - - - -- Wide_Character_Mapping - - declare - Inverse_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(Alphabet, Inverse_Alphabet); - begin - if Wide_Maps.Value(Wide_Maps.Identity, Equiv('b')) /= - Wide_Maps.Value(Inverse_Map, Equiv('y')) - then - Report.Failed("Incorrect Inverse mapping"); - end if; - end; - - - -- Check that Translation_Error is raised when a character is - -- repeated in the parameter "From" string. - declare - Bad_Map : Wide_Maps.Wide_Character_Mapping; - begin - Bad_Map := Wide_Maps.To_Mapping(From => Equiv("aa"), - To => Equiv("yz")); - Report.Failed("Exception not raised with repeated character"); - exception - when Translation_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised in To_Mapping with " & - "a repeated character"); - end; - - - -- Check that Translation_Error is raised when the parameters of the - -- function To_Mapping are of unequal lengths. - declare - Bad_Map : Wide_Maps.Wide_Character_Mapping; - begin - Bad_Map := Wide_Maps.To_Mapping(Equiv("abc"), Equiv("yz")); - Report.Failed - ("Exception not raised with unequal parameter lengths"); - exception - when Translation_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised in To_Mapping with " & - "unequal parameter lengths"); - end; - - - -- Check that the access-to-subprogram type is defined and available. - -- This provides for one Wide_Character mapping capability only. - -- The actual mapping functionality will be tested in conjunction with - -- the tests of subprograms defined for Wide_String handling. - - declare - - X_Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - X_Map'Access; - - begin - if X_Map_Ptr(Equiv('A')) /= -- both return 'X' - X_Map_Ptr.all(Equiv('Q')) - then - Report.Failed - ("Incorrect result using access-to-subprogram values"); - end if; - end; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4012; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a deleted file mode 100644 index 0f93e9dc8d1..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a +++ /dev/null @@ -1,203 +0,0 @@ --- CXA4013.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 subprograms defined in package Ada.Strings.Wide_Fixed --- are available, and that they produce correct results. Specifically, --- check the subprograms Index, "*" (Wide_String constructor function), --- Count, Trim, and Replace_Slice. --- --- TEST DESCRIPTION: --- This test demonstrates how certain Wide_Fixed string functions --- are used to eliminate specific substrings from portions of text. --- A procedure is defined that will take as parameters a source --- Wide_String along with a substring that is to be completely removed --- from the source string. The source Wide_String is parsed using the --- Index function, and any substring slices are replaced in the source --- Wide_String by a series of X's (based on the length of the substring.) --- Three lines of text are provided to this procedure, and the resulting --- substitutions are compared with expected results to validate the --- string processing. --- A global accumulator is updated with the number of occurrences of the --- substring in the source string. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Ada.Strings; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Maps; -with Report; - -procedure CXA4013 is - -begin - - Report.Test ("CXA4013", "Check that the subprograms defined in package " & - "Ada.Strings.Wide_Fixed are available, and that " & - "they produce correct results"); - - Test_Block: - declare - - TC_Total : Natural := 0; - Number_Of_Lines : constant := 3; - WC : Wide_Character := - Wide_Character'Val(Character'Pos('X') + - Character'Pos(Character'Last) + - 1 ); - - subtype WS is Wide_String (1..25); - - type Restricted_Words_Array_Type is - array (1..10) of Wide_String (1..10); - - Restricted_Words : Restricted_Words_Array_Type := - (" platoon", " marines ", " Marines ", - "north ", "south ", " east", - " beach ", " airport", "airfield ", - " road "); - - type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS; - - Text_Page : Page_Of_Text_Type := ("The platoon of Marines ", - "moved south on the south ", - "road to the airfield. "); - - TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX "; - TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX "; - TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX. "; - - - function Equivalent (Left : WS; Right : Wide_String) - return Boolean is - begin - for i in WS'range loop - if Left(i) /= Right(i) then - if Left(i) /= WC or Right(i) /= 'X' then - return False; - end if; - end if; - end loop; - return True; - end Equivalent; - - --- - - procedure Censor (Source_String : in out Wide_String; - Pattern_String : in Wide_String) is - - use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below. - - -- Create a replacement string that is the same length as the - -- pattern string being removed. Use the infix notation of the - -- wide string constructor function. - - Replacement : constant Wide_String := - Pattern_String'Length * WC; -- "*" - - Going : Ada.Strings.Direction := Ada.Strings.Forward; - Start_Pos, - Index : Natural := Source_String'First; - - begin -- Censor - - -- Accumulate count of total replacement operations. - - TC_Total := TC_Total + - Ada.Strings.Wide_Fixed.Count -- Count - (Source => Source_String, - Pattern => Pattern_String, - Mapping => Ada.Strings.Wide_Maps.Identity); - loop - - Index := Ada.Strings.Wide_Fixed.Index -- Index - (Source_String(Start_Pos..Source_String'Last), - Pattern_String, - Going, - Ada.Strings.Wide_Maps.Identity); - - exit when Index = 0; -- No matches, exit loop. - - -- if a match was found, modify the substring. - Ada.Strings.Wide_Fixed.Replace_Slice -- Replace_Slice - (Source_String, - Index, - Index + Pattern_String'Length - 1, - Replacement); - Start_Pos := Index + Pattern_String'Length; - - end loop; - - end Censor; - - - begin - - -- Invoke Censor subprogram to cleanse text. - -- Loop through each line of text, and check for the presence of each - -- restricted word. - -- Use the Trim function to eliminate leading or trailing blanks from - -- the restricted word parameters. - - for Line in 1..Number_Of_Lines loop - for Word in Restricted_Words'Range loop - Censor (Text_Page(Line), -- Trim - Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word), - Ada.Strings.Both)); - end loop; - end loop; - - - -- Validate results. - - if TC_Total /= 6 then - Report.Failed ("Incorrect number of substitutions performed"); - end if; - - if not Equivalent (Text_Page(1), TC_Revised_Line_1) then - Report.Failed ("Incorrect substitutions on Line 1"); - end if; - - if not Equivalent (Text_Page(2), TC_Revised_Line_2) then - Report.Failed ("Incorrect substitutions on Line 2"); - end if; - - if not Equivalent (Text_Page(3), TC_Revised_Line_3) then - Report.Failed ("Incorrect substitutions on Line 3"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4013; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a deleted file mode 100644 index 6e26a0330d5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a +++ /dev/null @@ -1,359 +0,0 @@ --- CXA4014.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 subprograms defined in package Ada.Strings.Wide_Fixed --- are available, and that they produce correct results. Specifically, --- check the subprograms Find_Token, Head, Index, Index_Non_Blank, Move, --- Overwrite, and Replace_Slice, Tail, and Translate. --- Use the access-to-subprogram mapping version of Translate (function --- and procedure). --- --- TEST DESCRIPTION: --- This test demonstrates how certain wide fixed string operations could --- be used in wide string information processing. A procedure is defined --- that will extract portions of a 50 character string that correspond to --- certain data items (i.e., name, address, state, zip code). These --- parsed items will then be added to the appropriate fields of data --- base elements. These data base elements are then compared for --- accuracy against a similar set of predefined data base --- elements. --- A variety of wide fixed string processing subprograms are used in this --- test. Each parsing operation attempts to use a different combination --- of the available subprograms to accomplish the same goal, therefore --- continuity of approach to wide string parsing is not seen in this --- test. --- However, a wide variety of possible approaches are demonstrated, while --- exercising a large number of the total predefined subprograms of --- package Ada.Strings.Wide_Fixed. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 02 Nov 95 SAIC Update and repair for ACVC 2.0.1. --- ---! - -package CXA40140 is - - UnderScore : Wide_Character := '_'; - Blank : Wide_Character := ' '; - - -- Function providing a mapping to a blank Wide_Character. - function US_to_Blank_Map (From : Wide_Character) return Wide_Character; - -end CXA40140; - -package body CXA40140 is - - function US_to_Blank_Map (From : Wide_Character) return Wide_Character is - begin - if From = UnderScore then - return Blank; - else - return From; - end if; - end US_to_Blank_Map; - -end CXA40140; - - -with CXA40140; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Maps; -with Report; - -procedure CXA4014 is - use CXA40140; -begin - - Report.Test ("CXA4014", "Check that the subprograms defined in package " & - "Ada.Strings.Wide_Fixed are available, and that " & - "they produce correct results"); - - Test_Block: - declare - - Number_Of_Info_Strings : constant Natural := 3; - DB_Size : constant Natural := Number_Of_Info_Strings; - Count : Natural := 0; - Finished_Processing : Boolean := False; - Blank_Wide_String : constant Wide_String := " "; - - subtype Info_Wide_String_Type is Wide_String (1..50); - type Info_Wide_String_Storage_Type is - array (1..Number_Of_Info_Strings) of Info_Wide_String_Type; - - - subtype Name_Type is Wide_String (1..10); - subtype Street_Number_Type is Wide_String (1..5); - subtype Street_Name_Type is Wide_String (1..10); - subtype City_Type is Wide_String (1..10); - subtype State_Type is Wide_String (1..2); - subtype Zip_Code_Type is Wide_String (1..5); - - type Data_Base_Element_Type is - record - Name : Name_Type := (others => ' '); - Street_Number : Street_Number_Type := (others => ' '); - Street_Name : Street_Name_Type := (others => ' '); - City : City_Type := (others => ' '); - State : State_Type := (others => ' '); - Zip_Code : Zip_Code_Type := (others => ' '); - end record; - - type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type; - - Data_Base : Data_Base_Type; - - --- - - Info_String_1 : Info_Wide_String_Type := - "Joe_Jones 123 Sixth_St San_Diego CA 98765"; - - Info_String_2 : Info_Wide_String_Type := - "Sam_Smith 56789 S._Seventh Carlsbad CA 92177"; - - Info_String_3 : Info_Wide_String_Type := - "Jane_Brown 1219 Info_Lane Tuscon AZ 85643"; - - - Info_Strings : Info_Wide_String_Storage_Type := - (1 => Info_String_1, - 2 => Info_String_2, - 3 => Info_String_3); - - - - TC_DB_Element_1 : Data_Base_Element_Type := - ("Joe Jones ", "123 ", "Sixth St ", "San Diego ", "CA", "98765"); - - TC_DB_Element_2 : Data_Base_Element_Type := - ("Sam Smith ", "56789", "S. Seventh", "Carlsbad ", "CA", "92177"); - - TC_DB_Element_3 : Data_Base_Element_Type := - ("Jane Brown", "1219 ", "Info Lane ", "Tuscon ", "AZ", "85643"); - - TC_Data_Base : Data_Base_Type := (TC_DB_Element_1, - TC_DB_Element_2, - TC_DB_Element_3); - - --- - - - procedure Store_Information - (Info_String : in Info_Wide_String_Type; - DB_Record : in out Data_Base_Element_Type) is - - package AS renames Ada.Strings; - use type AS.Wide_Maps.Wide_Character_Set; - - Start, - Stop : Natural := 0; - - Numeric_Set : constant AS.Wide_Maps.Wide_Character_Set := - AS.Wide_Maps.To_Set("0123456789"); - - Cal : constant - AS.Wide_Maps.Wide_Character_Sequence := "CA"; - California_Set : constant AS.Wide_Maps.Wide_Character_Set := - AS.Wide_Maps.To_Set(Cal); - Arizona_Set : constant AS.Wide_Maps.Wide_Character_Set := - AS.Wide_Maps.To_Set("AZ"); - Nevada_Set : constant AS.Wide_Maps.Wide_Character_Set := - AS.Wide_Maps.To_Set("NV"); - - Blank_Ftn_Ptr : AS.Wide_Maps.Wide_Character_Mapping_Function := - US_to_Blank_Map'Access; - - begin - - -- Find the starting position of the name field (first non-blank), - -- then, from that position, find the end of the name field (first - -- blank). - - Start := AS.Wide_Fixed.Index_Non_Blank(Info_String); - Stop := AS.Wide_Fixed.Index (Info_String(Start..Info_String'Length), - AS.Wide_Maps.To_Set(Blank), - AS.Inside, - AS.Forward) - 1 ; - - -- Store the name field in the data base element field for "Name". - - DB_Record.Name := AS.Wide_Fixed.Head(Info_String(1..Stop), - DB_Record.Name'Length); - - -- Replace any underscore characters in the name field - -- that were used to separate first/middle/last names. - -- Use the overloaded version of Translate that takes an - -- access-to-subprogram value. - - AS.Wide_Fixed.Translate (DB_Record.Name, Blank_Ftn_Ptr); - - - -- Continue the extraction process; now find the position of - -- the street number in the string. - - Start := Stop + 1; - - AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length), - Numeric_Set, - AS.Inside, - Start, - Stop); - - -- Store the street number field in the appropriate data base - -- element. - -- No modification of the default parameters of procedure Move - -- is required. - - AS.Wide_Fixed.Move(Source => Info_String(Start..Stop), - Target => DB_Record.Street_Number); - - - -- Continue the extraction process; find the street name in the - -- info string. Skip blanks to the start of the street name, then - -- search for the index of the next blank character in the string. - - Start := AS.Wide_Fixed.Index_Non_Blank - (Info_String(Stop+1..Info_String'Length)); - - Stop := - AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length), - Blank_Wide_String) - 1; - - -- Store the street name in the appropriate data base element field. - - AS.Wide_Fixed.Overwrite(DB_Record.Street_Name, - 1, - Info_String(Start..Stop)); - - -- Replace any underscore characters in the street name field - -- that were used as word separation with blanks. Again, use the - -- access-to-subprogram value to provide the mapping. - - DB_Record.Street_Name := - AS.Wide_Fixed.Translate(DB_Record.Street_Name, - Blank_Ftn_Ptr); - - - -- Continue the extraction; remove the city name from the string. - - Start := AS.Wide_Fixed.Index_Non_Blank - (Info_String(Stop+1..Info_String'Length)); - - Stop := - AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length), - Blank_Wide_String) - 1; - - -- Store the city name field in the appropriate data base element. - - AS.Wide_Fixed.Replace_Slice(DB_Record.City, - 1, - DB_Record.City'Length, - Info_String(Start..Stop)); - - -- Replace any underscore characters in the city name field - -- that were used as word separation. - - AS.Wide_Fixed.Translate (DB_Record.City, - Blank_Ftn_Ptr); - - - -- Continue the extraction; remove the state identifier from the - -- info string. - - Start := Stop + 1; - - AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length), - AS.Wide_Maps."OR"(California_Set, - AS.Wide_Maps."OR"(Nevada_Set, - Arizona_Set)), - AS.Inside, - Start, - Stop); - - -- Store the state indicator into the data base element. - - AS.Wide_Fixed.Move(Source => Info_String(Start..Stop), - Target => DB_Record.State, - Drop => Ada.Strings.Right, - Justify => Ada.Strings.Left, - Pad => AS.Wide_Space); - - - -- Continue the extraction process; remove the final data item in - -- the info string, the zip code, and place it into the - -- corresponding data base element. - - DB_Record.Zip_Code := - AS.Wide_Fixed.Tail(Info_String, DB_Record.Zip_Code'Length); - - exception - when AS.Length_Error => - Report.Failed ("Length_Error raised in procedure"); - when AS.Pattern_Error => - Report.Failed ("Pattern_Error raised in procedure"); - when AS.Translation_Error => - Report.Failed ("Translation_Error raised in procedure"); - when others => - Report.Failed ("Exception raised in procedure"); - end Store_Information; - - - begin - - -- Loop thru the information strings, extract the name and address - -- information, place this info into elements of the data base. - - while not Finished_Processing loop - - Count := Count + 1; - - Store_Information (Info_Strings(Count), Data_Base(Count)); - - Finished_Processing := (Count = Number_Of_Info_Strings); - - end loop; - - - -- Verify that the string processing was successful. - - for i in 1..DB_Size loop - if Data_Base(i) /= TC_Data_Base(i) then - Report.Failed - ("Data processing error on record " & Integer'Image(i)); - end if; - end loop; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4014; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a deleted file mode 100644 index 83fad3af866..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a +++ /dev/null @@ -1,580 +0,0 @@ --- CXA4015.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 subprograms defined in package Ada.Strings.Wide_Fixed --- are available, and that they produce correct results. Specifically, --- check the subprograms Count, Find_Token, Index, Index_Non_Blank, and --- Move. --- --- TEST DESCRIPTION: --- This test, when combined with tests CXA4013,14,16 will provide --- coverage of the functionality found in Ada.Strings.Wide_Fixed. --- This test contains many small, specific test cases, situations that --- although common in user environments, are often difficult to generate --- in large numbers in a application-based test. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 02 Nov 95 SAIC Corrected various accesssibility problems and --- expected result strings for ACVC 2.0.1. --- ---! - -package CXA40150 is - - -- Wide Character mapping function defined for use with specific - -- versions of functions Index and Count. - - function AK_to_ZQ_Mapping (From : Wide_Character) return Wide_Character; - -end CXA40150; - -package body CXA40150 is - - function AK_to_ZQ_Mapping (From : Wide_Character) - return Wide_Character is - begin - if From = 'a' then - return 'z'; - elsif From = 'k' then - return 'q'; - else - return From; - end if; - end AK_to_ZQ_Mapping; - -end CXA40150; - - -with CXA40150; -with Report; -with Ada.Strings; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Maps; - -procedure CXA4015 is -begin - - Report.Test("CXA4015", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Fixed are available, " & - "and that they produce correct results"); - - - Test_Block: - declare - - use CXA40150; - - package ASF renames Ada.Strings.Wide_Fixed; - package Maps renames Ada.Strings.Wide_Maps; - - Result_String : Wide_String(1..10) := - (others => Ada.Strings.Wide_Space); - - Source_String1 : Wide_String(1..5) := "abcde"; -- odd len Wide_String - Source_String2 : Wide_String(1..6) := "abcdef"; -- even len Wide_String - Source_String3 : Wide_String(1..12) := "abcdefghijkl"; - Source_String4 : Wide_String(1..12) := "abcdefghij "; -- last 2 ch pad - Source_String5 : Wide_String(1..12) := " cdefghijkl"; -- first 2 ch pad - Source_String6 : Wide_String(1..12) := "abcdefabcdef"; - - Location : Natural := 0; - Slice_Start : Positive; - Slice_End, - Slice_Count : Natural := 0; - - CD_Set : Maps.Wide_Character_Set := Maps.To_Set("cd"); - ABCD_Set : Maps.Wide_Character_Set := Maps.To_Set("abcd"); - A_to_F_Set : Maps.Wide_Character_Set := Maps.To_Set("abcdef"); - - CD_to_XY_Map : Maps.Wide_Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - - -- Access-to-Subprogram object defined for use with specific versions of - -- functions Index and Count. - - Map_Ptr : Maps.Wide_Character_Mapping_Function := - AK_to_ZQ_Mapping'Access; - - - begin - - - -- Procedure Move - -- Evaluate the Procedure Move with various combinations of - -- parameters. - - -- Justify = Left (default case) - - ASF.Move(Source => Source_String1, -- "abcde" - Target => Result_String); - - if Result_String /= "abcde " then - Report.Failed("Incorrect result from Move with Justify = Left"); - end if; - - -- Justify = Right - - ASF.Move(Source => Source_String2, -- "abcdef" - Target => Result_String, - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= " abcdef" then - Report.Failed("Incorrect result from Move with Justify = Right"); - end if; - - -- Justify = Center (two cases, odd and even pad lengths) - - ASF.Move(Source_String1, -- "abcde" - Result_String, - Ada.Strings.Error, - Ada.Strings.Center, - 'x'); -- non-default padding. - - if Result_String /= "xxabcdexxx" then -- Unequal padding added right - Report.Failed("Incorrect result from Move with Justify = Center-1"); - end if; - - ASF.Move(Source_String2, -- "abcdef" - Result_String, - Ada.Strings.Error, - Ada.Strings.Center); - - if Result_String /= " abcdef " then -- Equal padding added on L/R. - Report.Failed("Incorrect result from Move with Justify = Center-2"); - end if; - - -- When the source Wide_String is longer than the target Wide_String, - -- several cases can be examined, with the results depending on the - -- value of the Drop parameter. - - -- Drop = Left - - ASF.Move(Source => Source_String3, -- "abcdefghijkl" - Target => Result_String, - Drop => Ada.Strings.Left); - - if Result_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Move with Drop = Left"); - end if; - - -- Drop = Right - - ASF.Move(Source_String3, Result_String, Ada.Strings.Right); - - if Result_String /= "abcdefghij" then - Report.Failed("Incorrect result from Move with Drop = Right"); - end if; - - -- Drop = Error - -- The effect in this case depends on the value of the justify - -- parameter, and on whether any characters in Source other than - -- Pad would fail to be copied. - - -- Drop = Error, Justify = Left, right overflow characters are pad. - - ASF.Move(Source => Source_String4, -- "abcdefghij " - Target => Result_String, - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Left); - - if not(Result_String = "abcdefghij") then -- leftmost 10 characters - Report.Failed("Incorrect result from Move with Drop = Error - 1"); - end if; - - -- Drop = Error, Justify = Right, left overflow characters are pad. - - ASF.Move(Source_String5, -- " cdefghijkl" - Result_String, - Ada.Strings.Error, - Ada.Strings.Right); - - if Result_String /= "cdefghijkl" then -- rightmost 10 characters - Report.Failed("Incorrect result from Move with Drop = Error - 2"); - end if; - - -- In other cases of Drop=Error, Length_Error is propagated, such as: - - begin - - ASF.Move(Source_String3, -- 12 characters, no Pad. - Result_String, -- 10 characters - Ada.Strings.Error, - Ada.Strings.Left); - - Report.Failed("Length_Error not raised by Move - 1"); - - exception - when Ada.Strings.Length_Error => null; -- OK - when others => - Report.Failed("Incorrect exception raised by Move - 1"); - end; - - - - -- Function Index - -- (Other usage examples of this function found in CXA4013-14.) - -- Check when the pattern is not found in the source. - - if ASF.Index("abcdef", "gh") /= 0 or - ASF.Index("abcde", "abcdef") /= 0 or -- pattern > source - ASF.Index("xyz", - "abcde", - Ada.Strings.Backward) /= 0 or - ASF.Index("", "ab") /= 0 or -- null source Wide_String. - ASF.Index("abcde", " ") /= 0 -- blank pattern. - then - Report.Failed("Incorrect result from Index, no pattern match"); - end if; - - -- Check that Pattern_Error is raised when the pattern is the - -- null Wide_String. - begin - Location := ASF.Index(Source_String6, -- "abcdefabcdef" - "", -- null pattern Wide_String. - Ada.Strings.Forward); - Report.Failed("Pattern_Error not raised by Index"); - exception - when Ada.Strings.Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Index, null pattern"); - end; - - -- Use the search direction "backward" to locate the particular - -- pattern within the source Wide_String. - - Location := ASF.Index(Source_String6, -- "abcdefabcdef" - "de", -- slice 4..5, 10..11 - Ada.Strings.Backward); -- search from right end. - - if Location /= 10 then - Report.Failed("Incorrect result from Index going Backward"); - end if; - - - - -- Function Index - -- Use the version of Index that takes a Wide_Character_Mapping_Function - -- parameter. - -- Use the search directions Forward and Backward to locate the - -- particular pattern wide string within the source wide string. - - Location := ASF.Index("akzqefakzqef", - "qzq", -- slice 8..10 - Ada.Strings.Backward, - Map_Ptr); -- perform 'a' to 'z', 'k' to 'q' - -- translation. - if Location /= 8 then - Report.Failed - ("Incorrect result from Index w/map ptr going Backward"); - end if; - - Location := ASF.Index("ddkkddakcdakdefcadckdfzaaqd", - "zq", -- slice 7..8 - Ada.Strings.Forward, - Map_Ptr); -- perform 'a' to 'z', 'k' to 'q' - -- translation. - if Location /= 7 then - Report.Failed - ("Incorrect result from Index w/map ptr going Forward"); - end if; - - - if ASF.Index("aakkzq", "zq", Ada.Strings.Forward, Map_Ptr) /= 2 or - ASF.Index("qzedka", "qz", Ada.Strings.Backward, Map_Ptr) /= 5 or - ASF.Index("zazaza", "zzzz", Ada.Strings.Backward, Map_Ptr) /= 3 or - ASF.Index("kka", "qqz", Ada.Strings.Forward, Map_Ptr) /= 1 - then - Report.Failed("Incorrect result from Index w/map ptr"); - end if; - - - -- Check when the pattern wide string is not found in the source. - - if ASF.Index("akzqef", "kzq", Ada.Strings.Forward, Map_Ptr) /= 0 or - ASF.Index("abcde", "abcdef", Ada.Strings.Backward, Map_Ptr) /= 0 or - ASF.Index("xyz", "akzde", Ada.Strings.Backward, Map_Ptr) /= 0 or - ASF.Index("", "zq", Ada.Strings.Forward, Map_Ptr) /= 0 or - ASF.Index("akcde", " ", Ada.Strings.Backward, Map_Ptr) /= 0 - then - Report.Failed - ("Incorrect result from Index w/map ptr, no pattern match"); - end if; - - -- Check that Pattern_Error is raised when the pattern is a - -- null Wide_String. - begin - Location := ASF.Index("akzqefakqzef", - "", -- null pattern Wide_String. - Ada.Strings.Forward, - Map_Ptr); - Report.Failed("Pattern_Error not raised by Index w/map ptr"); - exception - when Ada.Strings.Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Incorrect exception raised by Index w/map ptr, null pattern"); - end; - - - - -- Function Index - -- Using the version of Index testing wide character set membership, - -- check combinations of forward/backward, inside/outside parameter - -- configurations. - - if ASF.Index(Source => Source_String1, -- "abcde" - Set => CD_Set, - Test => Ada.Strings.Inside, - Going => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3. - ASF.Index(Source_String6, -- "abcdefabcdef" - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Backward) /= 12 or -- 'f' at position 12 - ASF.Index(Source_String6, -- "abcdefabcdef" - CD_Set, - Ada.Strings.Inside, - Ada.Strings.Backward) /= 10 or -- 'd' at position 10 - ASF.Index("cdcdcdcdacdcdcdcd", - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Forward) /= 9 -- 'a' at position 9 - then - Report.Failed("Incorrect result from function Index for sets - 1"); - end if; - - -- Additional interesting uses/combinations using Index for sets. - - if ASF.Index("cd", -- same size, str-set - CD_Set, - Ada.Strings.Inside, - Ada.Strings.Forward) /= 1 or -- 'c' at position 1 - ASF.Index("abcd", -- same size, str-set, - Maps.To_Set("efgh"), -- different contents. - Ada.Strings.Outside, - Ada.Strings.Forward) /= 1 or - ASF.Index("abccd", -- set > Wide_String - Maps.To_Set("acegik"), - Ada.Strings.Inside, - Ada.Strings.Backward) /= 4 or -- 'c' at position 4 - ASF.Index("abcde", - Maps.Null_Set) /= 0 or - ASF.Index("", -- Null string. - CD_Set) /= 0 or - ASF.Index("abc ab", -- blank included - Maps.To_Set("e "), -- in Wide_String and - Ada.Strings.Inside, -- set. - Ada.Strings.Backward) /= 4 -- blank in Wide_Str. - then - Report.Failed("Incorrect result from function Index for sets - 2"); - end if; - - - - -- Function Index_Non_Blank. - -- (Other usage examples of this function found in CXA4013-14.) - - - if ASF.Index_Non_Blank(Source => Source_String4, -- "abcdefghij " - Going => Ada.Strings.Backward) /= 10 or - ASF.Index_Non_Blank("abc def ghi jkl ", - Ada.Strings.Backward) /= 15 or - ASF.Index_Non_Blank(" abcdef") /= 3 or - ASF.Index_Non_Blank(" ") /= 0 - then - Report.Failed("Incorrect result from Index_Non_Blank"); - end if; - - - - -- Function Count - -- (Other usage examples of this function found in CXA4013-14.) - - if ASF.Count("abababa", "aba") /= 2 or - ASF.Count("abababa", "ab" ) /= 3 or - ASF.Count("babababa", "ab") /= 3 or - ASF.Count("abaabaaba", "aba") /= 3 or - ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy") /= 1 or - ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x") /= 20 - then - Report.Failed("Incorrect result from Function Count"); - end if; - - -- Determine the number of slices of Source that when mapped to a - -- non-identity map, match the pattern Wide_String. - - Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef" - "xy", - CD_to_XY_Map); -- maps 'c' to 'x', 'd' to 'y' - - if Slice_Count /= 2 then -- two slices "xy" in "mapped" Source_String6 - Report.Failed("Incorrect result from Count with non-identity map"); - end if; - - -- If the pattern supplied to Function Count is the null Wide_String, - -- then Pattern_Error is propagated. - declare - The_Null_Wide_String : constant Wide_String := ""; - begin - Slice_Count := ASF.Count(Source_String6, The_Null_Wide_String); - Report.Failed("Pattern_Error not raised by Function Count"); - exception - when Ada.Strings.Pattern_Error => null; -- OK - when others => - Report.Failed("Incorrect exception from Count with null pattern"); - end; - - - - - -- Function Count - -- Use the version of Count that takes a Wide_Character_Mapping_Function - -- value as the basis of its source mapping. - - if ASF.Count("akakaka", "zqz", Map_Ptr) /= 2 or - ASF.Count("akakaka", "qz", Map_Ptr) /= 3 or - ASF.Count("kakakaka", "q", Map_Ptr) /= 4 or - ASF.Count("zzqaakzaqzzk", "zzq", Map_Ptr) /= 4 or - ASF.Count(" ", "z", Map_Ptr) /= 0 or - ASF.Count("", "qz", Map_Ptr) /= 0 or - ASF.Count("abbababab", "zq", Map_Ptr) /= 0 or - ASF.Count("aaaaaaaaaaaaaaaaaakk", "zqq", Map_Ptr) /= 1 or - ASF.Count("azaazaazzzaaaaazzzza", "z", Map_Ptr) /= 20 - then - Report.Failed("Incorrect result from Function Count w/map ptr"); - end if; - - -- If the pattern supplied to Function Count is a null Wide_String, - -- then Pattern_Error is propagated. - declare - The_Null_Wide_String : constant Wide_String := ""; - begin - Slice_Count := ASF.Count(Source_String6, - The_Null_Wide_String, - Map_Ptr); - Report.Failed - ("Pattern_Error not raised by Function Count w/map ptr"); - exception - when Ada.Strings.Pattern_Error => null; -- OK - when others => - Report.Failed - ("Incorrect exception from Count w/map ptr, null pattern"); - end; - - - - - -- Function Count returning the number of characters in a particular - -- set that are found in source Wide_String. - - if ASF.Count(Source_String6, CD_Set) /= 4 or -- 2 'c' and 'd' chars. - ASF.Count("cddaccdaccdd", CD_Set) /= 10 - then - Report.Failed("Incorrect result from Count with set"); - end if; - - - - -- Function Find_Token. - -- (Other usage examples of this function found in CXA4013-14.) - - ASF.Find_Token(Source => Source_String6, -- First slice with no - Set => ABCD_Set, -- 'a', 'b', 'c', or 'd' - Test => Ada.Strings.Outside, -- is "ef" at 5..6. - First => Slice_Start, - Last => Slice_End); - - if Slice_Start /= 5 or Slice_End /= 6 then - Report.Failed("Incorrect result from Find_Token - 1"); - end if; - - -- If no appropriate slice is contained by the source Wide_String, - -- then the value returned in Last is zero, and the value in First is - -- Source'First. - - ASF.Find_Token(Source_String6, -- "abcdefabcdef" - A_to_F_Set, -- Set of characters 'a' thru 'f'. - Ada.Strings.Outside, -- No characters outside this set. - Slice_Start, - Slice_End); - - if Slice_Start /= Source_String6'First or Slice_End /= 0 then - Report.Failed("Incorrect result from Find_Token - 2"); - end if; - - -- Additional testing of Find_Token. - - ASF.Find_Token("eabcdabcddcab", - ABCD_Set, - Ada.Strings.Inside, - Slice_Start, - Slice_End); - - if Slice_Start /= 2 or Slice_End /= 13 then - Report.Failed("Incorrect result from Find_Token - 3"); - end if; - - ASF.Find_Token("efghijklabcdabcd", - ABCD_Set, - Ada.Strings.Outside, - Slice_Start, - Slice_End); - - if Slice_Start /= 1 or Slice_End /= 8 then - Report.Failed("Incorrect result from Find_Token - 4"); - end if; - - ASF.Find_Token("abcdefgabcdabcd", - ABCD_Set, - Ada.Strings.Outside, - Slice_Start, - Slice_End); - - if Slice_Start /= 5 or Slice_End /= 7 then - Report.Failed("Incorrect result from Find_Token - 5"); - end if; - - ASF.Find_Token("abcdcbabcdcba", - ABCD_Set, - Ada.Strings.Inside, - Slice_Start, - Slice_End); - - if Slice_Start /= 1 or Slice_End /= 13 then - Report.Failed("Incorrect result from Find_Token - 6"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4015; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a deleted file mode 100644 index 00dcdcdbd00..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a +++ /dev/null @@ -1,685 +0,0 @@ --- CXA4016.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 subprograms defined in package Ada.Strings.Wide_Fixed --- are available, and that they produce correct results. Specifically, --- check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice, --- Tail, Trim, and "*". --- --- TEST DESCRIPTION: --- This test, when combined with tests CXA4013-15 will provide --- coverage of the functionality found in package Ada.Strings.Wide_Fixed. --- This test contains many small, specific test cases, situations that --- although common in user environments, are often difficult to generate --- in large numbers in a application-based test. They represent --- individual usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 10 Apr 94 SAIC Modified comments in a subtest failure message. --- 06 Nov 95 SAIC Corrected subtest results for ACVC 2.0.1 --- 14 Mar 01 RLB Added checks that the lower bound is 1, similar --- to CXA4005. These changes were made to test --- Defect Report 8652/0049, as reflected in --- Technical Corrigendum 1. --- ---! - -with Report; -with Ada.Strings; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Maps; - -procedure CXA4016 is - - type TC_Name_Holder is access String; - Name : TC_Name_Holder; - - function TC_Check (S : Wide_String) return Wide_String is - begin - if S'First /= 1 then - Report.Failed ("Lower bound of result of function " & Name.all & - " is" & Integer'Image (S'First)); - end if; - return S; - end TC_Check; - - procedure TC_Set_Name (N : String) is - begin - Name := new String'(N); - end TC_Set_Name; - -begin - - Report.Test("CXA4016", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Fixed are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package ASW renames Ada.Strings.Wide_Fixed; - package Wide_Maps renames Ada.Strings.Wide_Maps; - - Result_String, - Delete_String, - Insert_String, - Trim_String, - Overwrite_String : Wide_String(1..10) := - (others => Ada.Strings.Wide_Space); - Replace_String : Wide_String(10..30) := - (others => Ada.Strings.Wide_Space); - - Source_String1 : Wide_String(1..5) := "abcde"; -- odd len wd str - Source_String2 : Wide_String(1..6) := "abcdef"; -- even len wd str - Source_String3 : Wide_String(1..12) := "abcdefghijkl"; - Source_String4 : Wide_String(1..12) := "abcdefghij "; -- last two ch pad - Source_String5 : Wide_String(1..12) := " cdefghijkl"; -- first two ch pad - Source_String6 : Wide_String(1..12) := "abcdefabcdef"; - - Location : Natural := 0; - Slice_Start : Positive; - Slice_End, - Slice_Count : Natural := 0; - - CD_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set("cd"); - X_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set('x'); - ABCD_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set("abcd"); - A_to_F_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set("abcdef"); - - CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(From => "cd", To => "xy"); - - begin - - -- Procedure Replace_Slice - -- The functionality of this procedure is similar to procedure Move, - -- and is tested here in the same manner, evaluated with various - -- combinations of parameters. - - -- Index_Error propagation when Low > Source'Last + 1 - - begin - ASW.Replace_Slice(Result_String, - Result_String'Last + 2, -- should raise exception - Result_String'Last, - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 1"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 1"); - end; - - -- Index_Error propagation when High < Source'First - 1 - - begin - ASW.Replace_Slice(Replace_String(20..30), - Replace_String'First, - Replace_String'First - 2, -- should raise exception - "xxxxxxx"); - Report.Failed("Index_Error not raised by Replace_Slice - 2"); - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Replace_Slice - 2"); - end; - - -- Justify = Left (default case) - - Result_String := "XXXXXXXXXX"; - - ASW.Replace_Slice(Source => Result_String, - Low => 1, - High => 10, - By => Source_String1); -- "abcde" - - if Result_String /= "abcde " then - Report.Failed("Incorrect result from Replace_Slice - Justify = Left"); - end if; - - -- Justify = Right - - ASW.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String2, -- "abcdef" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= " abcdef" then - Report.Failed("Incorrect result from Replace_Slice - Justify=Right"); - end if; - - -- Justify = Center (two cases, odd and even pad lengths) - - ASW.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String1, -- "abcde" - Ada.Strings.Error, - Ada.Strings.Center, - 'x'); -- non-default padding. - - if Result_String /= "xxabcdexxx" then -- Unequal padding added right - Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1"); - end if; - - ASW.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String2, -- "abcdef" - Ada.Strings.Error, - Ada.Strings.Center); - - if Result_String /= " abcdef " then -- Equal padding added on L/R. - Report.Failed("Incorrect result from Replace_Slice with " & - "Justify = Center - 2"); - end if; - - -- When the source string is longer than the target string, several - -- cases can be examined, with the results depending on the value of - -- the Drop parameter. - - -- Drop = Left - - ASW.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Left); - - if Result_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Replace_Slice - Drop=Left"); - end if; - - -- Drop = Right - - ASW.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String3, -- "abcdefghijkl" - Ada.Strings.Right); - - if Result_String /= "abcdefghij" then - Report.Failed("Incorrect result, Replace_Slice with Drop=Right"); - end if; - - -- Drop = Error - - -- The effect in this case depends on the value of the justify - -- parameter, and on whether any characters in Source other than - -- Pad would fail to be copied. - - -- Drop = Error, Justify = Left, right overflow characters are pad. - - ASW.Replace_Slice(Result_String, - 1, - Result_String'Last, - Source_String4, -- "abcdefghij " - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Left); - - if not(Result_String = "abcdefghij") then -- leftmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1"); - end if; - - -- Drop = Error, Justify = Right, left overflow characters are pad. - - ASW.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String5, -- " cdefghijkl" - Drop => Ada.Strings.Error, - Justify => Ada.Strings.Right); - - if Result_String /= "cdefghijkl" then -- rightmost 10 characters - Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2"); - end if; - - -- In other cases of Drop=Error, Length_Error is propagated, such as: - - begin - - ASW.Replace_Slice(Source => Result_String, - Low => 1, - High => Result_String'Last, - By => Source_String3, -- "abcdefghijkl" - Drop => Ada.Strings.Error); - - Report.Failed("Length_Error not raised by Replace_Slice - 1"); - - exception - when Ada.Strings.Length_Error => null; -- OK - when others => - Report.Failed("Incorrect exception from Replace_Slice - 3"); - end; - - - -- Function Replace_Slice - - TC_Set_Name ("Replace_Slice"); - - if TC_Check (ASW.Replace_Slice("abcde", 3, 3, "x")) - /= "abxde" or -- High = Low - TC_Check (ASW.Replace_Slice("abc", 2, 3, "xyz")) /= "axyz" or - TC_Check (ASW.Replace_Slice("abcd", 4, 1, "xy")) - /= "abcxyd" or -- High < Low - TC_Check (ASW.Replace_Slice("abc", 2, 3, "x")) /= "ax" or - TC_Check (ASW.Replace_Slice("a", 1, 1, "z")) /= "z" - then - Report.Failed("Incorrect result from Function Replace_Slice - 1"); - end if; - - if TC_Check (ASW.Replace_Slice("abcde", 5, 5, "z")) - /= "abcdz" or -- By length 1 - TC_Check (ASW.Replace_Slice("abc", 1, 3, "xyz")) - /= "xyz" or -- High > Low - TC_Check (ASW.Replace_Slice("abc", 3, 2, "xy")) - /= "abxyc" or -- insert - TC_Check (ASW.Replace_Slice("a", 1, 1, "xyz")) /= "xyz" - then - Report.Failed("Incorrect result from Function Replace_Slice - 2"); - end if; - - - - -- Function Insert. - - TC_Set_Name ("Insert"); - - declare - New_String : constant Wide_String := - TC_Check ( - ASW.Insert(Source => Source_String1(2..5), -- "bcde" - Before => 2, - New_Item => Source_String2)); -- "abcdef" - begin - if New_String /= "abcdefbcde" then - Report.Failed("Incorrect result from Function Insert - 1"); - end if; - end; - - if TC_Check (ASW.Insert("a", 1, "z")) /= "za" or - TC_Check (ASW.Insert("abc", 3, "")) /= "abc" or - TC_Check (ASW.Insert("abc", 4, "z")) /= "abcz" - then - Report.Failed("Incorrect result from Function Insert - 2"); - end if; - - begin - if TC_Check (ASW.Insert(Source => Source_String1(2..5), -- "bcde" - Before => Report.Ident_Int(7), - New_Item => Source_String2)) -- "abcdef" - /= "babcdefcde" then - Report.Failed("Index_Error not raised by Insert - 3A"); - else - Report.Failed("Index_Error not raised by Insert - 3B"); - end if; - exception - when Ada.Strings.Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception from Insert - 3"); - end; - - - -- Procedure Insert - - -- Drop = Right - - ASW.Insert(Source => Insert_String, - Before => 6, - New_Item => Source_String2, -- "abcdef" - Drop => Ada.Strings.Right); - - if Insert_String /= " abcde" then -- last char of New_Item dropped. - Report.Failed("Incorrect result from Insert with Drop = Right"); - end if; - - -- Drop = Left - - ASW.Insert(Source => Insert_String, -- 10 char string - Before => 2, -- 9 chars, 2..10 available - New_Item => Source_String3, -- 12 characters long. - Drop => Ada.Strings.Left); -- truncate from Left. - - if Insert_String /= "l abcde" then -- 10 chars, leading blank. - Report.Failed("Incorrect result from Insert with Drop=Left"); - end if; - - -- Drop = Error - - begin - ASW.Insert(Source => Result_String, -- 10 chars - Before => Result_String'Last, - New_Item => "abcdefghijk", - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Insert"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception - when others => - Report.Failed("Incorrect exception raised by Procedure Insert"); - end; - - - - -- Function Overwrite - - TC_Set_Name ("Overwrite"); - - Overwrite_String := TC_Check ( - ASW.Overwrite(Result_String, -- 10 chars - 1, -- starting at pos=1 - Source_String3(1..10))); - - if Overwrite_String /= Source_String3(1..10) then - Report.Failed("Incorrect result from Function Overwrite - 1"); - end if; - - - if TC_Check (ASW.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or - TC_Check (ASW.Overwrite("a", 1, "xyz")) - /= "xyz" or -- chars appended - TC_Check (ASW.Overwrite("abc", 3, " ")) - /= "ab " or -- blanks appended - TC_Check (ASW.Overwrite("abcde", 1, "z" )) /= "zbcde" - then - Report.Failed("Incorrect result from Function Overwrite - 2"); - end if; - - - - -- Procedure Overwrite, with truncation. - - ASW.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Left); - - if Overwrite_String /= "cdefghijkl" then - Report.Failed("Incorrect result from Overwrite with Drop=Left"); - end if; - - -- The default drop value is Right, used here. - - ASW.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3); -- 12 characters. - - if Overwrite_String /= "abcdefghij" then - Report.Failed("Incorrect result from Overwrite with Drop=Right"); - end if; - - -- Drop = Error - - begin - ASW.Overwrite(Source => Overwrite_String, -- 10 characters. - Position => 1, - New_Item => Source_String3, -- 12 characters. - Drop => Ada.Strings.Error); - Report.Failed("Exception not raised by Procedure Overwrite"); - exception - when Ada.Strings.Length_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Incorrect exception raised by Procedure Overwrite"); - end; - - Overwrite_String := "ababababab"; - ASW.Overwrite(Overwrite_String, Overwrite_String'Last, "z"); - ASW.Overwrite(Overwrite_String, Overwrite_String'First,"z"); - ASW.Overwrite(Overwrite_String, 5, "zz"); - - if Overwrite_String /= "zbabzzabaz" then - Report.Failed("Incorrect result from Procedure Overwrite"); - end if; - - - - -- Function Delete - - TC_Set_Name ("Delete"); - - declare - New_String1 : constant Wide_String := -- Returns a 4 char wide str. - TC_Check (ASW.Delete(Source => Source_String3, - From => 3, - Through => 10)); - New_String2 : constant Wide_String := -- This returns Source. - TC_Check (ASW.Delete(Source_String3, 10, 3)); - begin - if New_String1 /= "abkl" or - New_String2 /= Source_String3 - then - Report.Failed("Incorrect result from Function Delete - 1"); - end if; - end; - - if TC_Check (ASW.Delete("a", 1, 1)) - /= "" or -- Source length = 1 - TC_Check (ASW.Delete("abc", 1, 2)) - /= "c" or -- From = Source'First - TC_Check (ASW.Delete("abc", 3, 3)) - /= "ab" or -- From = Source'Last - TC_Check (ASW.Delete("abc", 3, 1)) - /= "abc" -- From > Through - then - Report.Failed("Incorrect result from Function Delete - 2"); - end if; - - - - -- Procedure Delete - - -- Justify = Left - - Delete_String := Source_String3(1..10); -- Initialize to "abcdefghij" - - ASW.Delete(Source => Delete_String, - From => 6, - Through => Delete_String'Last, - Justify => Ada.Strings.Left, - Pad => 'x'); -- pad with char 'x' - - if Delete_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Delete - Justify = Left"); - end if; - - -- Justify = Right - - ASW.Delete(Source => Delete_String, -- Remove x"s from end and - From => 6, -- shift right. - Through => Delete_String'Last, - Justify => Ada.Strings.Right, - Pad => 'x'); -- pad with char 'x' on left. - - if Delete_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Delete - Justify = Right"); - end if; - - -- Justify = Center - - ASW.Delete(Source => Delete_String, - From => 1, - Through => 5, - Justify => Ada.Strings.Center, - Pad => 'z'); - - if Delete_String /= "zzabcdezzz" then -- extra pad char on right side. - Report.Failed("Incorrect result from Delete - Justify = Center"); - end if; - - - - -- Function Trim - -- Use non-identity character sets to perform the trim operation. - - TC_Set_Name ("Trim"); - - Trim_String := "cdabcdefcd"; - - -- Remove the "cd" from each end of the string. This will not effect - -- the "cd" slice at 5..6. - - declare - New_String : constant Wide_String := - TC_Check (ASW.Trim(Source => Trim_String, - Left => CD_Set, Right => CD_Set)); - begin - if New_String /= Source_String2 then -- string "abcdef" - Report.Failed - ("Incorrect result from Trim with wide character sets"); - end if; - end; - - if TC_Check (ASW.Trim("abcdef", Wide_Maps.Null_Set, Wide_Maps.Null_Set)) - /= "abcdef" then - Report.Failed("Incorrect result from Trim with Null sets"); - end if; - - if TC_Check (ASW.Trim("cdxx", CD_Set, X_Set)) /= "" then - Report.Failed("Incorrect result from Trim, wide string removal"); - end if; - - - -- Procedure Trim - - -- Justify = Right - - ASW.Trim(Source => Trim_String, - Left => CD_Set, - Right => CD_Set, - Justify => Ada.Strings.Right, - Pad => 'x'); - - if Trim_String /= "xxxxabcdef" then - Report.Failed("Incorrect result from Trim with Justify = Right"); - end if; - - -- Justify = Left - - ASW.Trim(Source => Trim_String, - Left => X_Set, - Right => Wide_Maps.Null_Set, - Justify => Ada.Strings.Left, - Pad => ' '); - - if Trim_String /= "abcdef " then -- Padded with 4 blanks on right. - Report.Failed("Incorrect result from Trim with Justify = Left"); - end if; - - -- Justify = Center - - ASW.Trim(Source => Trim_String, - Left => ABCD_Set, - Right => CD_Set, - Justify => Ada.Strings.Center, - Pad => 'x'); - - if Trim_String /= "xxef xx" then -- Padded with 4 pad chars on L/R - Report.Failed("Incorrect result from Trim with Justify = Center"); - end if; - - - - -- Function Head, testing use of padding. - - TC_Set_Name ("Head"); - - -- Use the wide characters of Source_String1 ("abcde") and pad the - -- last five wide characters of Result_String with 'x' wide characters. - - Result_String := TC_CHeck (ASW.Head(Source_String1, 10, 'x')); - - if Result_String /= "abcdexxxxx" then - Report.Failed("Incorrect result from Function Head with padding"); - end if; - - if TC_Check (ASW.Head(" ab ", 2)) /= " " or - TC_Check (ASW.Head("a", 6, 'A')) /= "aAAAAA" or - TC_Check (ASW.Head(ASW.Head("abc ", 7, 'x'), 10, 'X')) - /= "abc xxXXX" - then - Report.Failed("Incorrect result from Function Head"); - end if; - - - - -- Function Tail, testing use of padding. - - TC_Set_Name ("Tail"); - - -- Use the wide characters of Source_String1 ("abcde") and pad the - -- first five wide characters of Result_String with 'x' wide characters. - - Result_String := TC_Check (ASW.Tail(Source_String1, 10, 'x')); - - if Result_String /= "xxxxxabcde" then - Report.Failed("Incorrect result from Function Tail with padding"); - end if; - - if TC_Check (ASW.Tail("abcde ", 5)) - /= "cde " or -- blanks, back - TC_Check (ASW.Tail(" abc ", 8, ' ')) - /= " abc " or -- blanks, front/back - TC_Check (ASW.Tail("", 5, 'Z')) - /= "ZZZZZ" or -- pad characters only - TC_Check (ASW.Tail("abc", 0)) - /= "" or -- null result - TC_Check (ASW.Tail(ASW.Tail(" abc ", 6, 'x'), - 10, - 'X')) /= "XXXXx abc " - then - Report.Failed("Incorrect result from Function Tail"); - end if; - - - - -- Function "*" - with (Natural, Wide_String) parameters - - TC_Set_Name ("""*"""); - - if TC_Check (ASW."*"(3, Source_String1)) /= "abcdeabcdeabcde" or - TC_Check (ASW."*"(2, Source_String2)) /= Source_String6 or - TC_Check (ASW."*"(4, Source_String1(1..2))) /= "abababab" or - TC_Check (ASW."*"(0, Source_String1)) /= "" - then - Report.Failed - ("Incorrect result from Function ""*"" with wide strings"); - end if; - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4016; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a deleted file mode 100644 index 8d6886897ad..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a +++ /dev/null @@ -1,337 +0,0 @@ --- CXA4017.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 subprograms defined in package Ada.Strings.Wide_Bounded --- are available, and that they produce correct results. Specifically, --- check the subprograms Append, Delete, Index, Insert , Length, --- Overwrite, Replace_Slice, Slice, "&", To_Bounded_Wide_String, --- To_Wide_String, Translate, and Trim. --- --- TEST DESCRIPTION: --- This test demonstrates the uses of a variety of the Wide_String --- functions found in the package Ada.Strings.Wide_Bounded, simulating --- the operations found in a text processing environment. --- With bounded wide strings, the length of each "line" of text can vary --- up to the instantiated maximum, allowing one to view a page of text as --- a series of expandable lines. This provides flexibility in text --- formatting of individual lines (wide strings). --- Several subprograms are defined, all of which attempt to take --- advantage of as many different bounded wide string utilities as --- possible. Often, an operation that is being performed in a subprogram --- using a certain bounded wide string utility could more efficiently be --- performed using a different utility. However, in the interest of --- including as broad coverage as possible, a mixture of utilities is --- invoked in this test. --- A simulated page of text is provided as a parameter to the test --- defined subprograms, and the appropriate processing performed. The --- processed page of text is then compared to a predefined "finished" --- page, and test passage/failure is based on the results of this --- comparison. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 06 Nov 95 SAIC Corrected initialization error for ACVC 2.0.1. --- ---! - -with Ada.Strings; -with Ada.Strings.Wide_Bounded; -with Ada.Strings.Wide_Maps; -with Report; - -procedure CXA4017 is - -begin - - Report.Test ("CXA4017", "Check that the subprograms defined in package " & - "Ada.Strings.Wide_Bounded are available, and " & - "that they produce correct results"); - - Test_Block: - declare - - Characters_Per_Line : constant Positive := 40; - Lines_Per_Page : constant Natural := 4; - - - package BS_40 is new - Ada.Strings.Wide_Bounded.Generic_Bounded_Length(Characters_Per_Line); - - use type BS_40.Bounded_Wide_String; - - type Page_Type is array (1..Lines_Per_Page) of - BS_40.Bounded_Wide_String; - - -- Note: Misspellings below are intentional. - - Line1 : BS_40.Bounded_Wide_String := - BS_40.To_Bounded_Wide_String - ("ada is a progrraming language designed"); - Line2 : BS_40.Bounded_Wide_String := - BS_40.To_Bounded_Wide_String("to support the construction of long-"); - Line3 : BS_40.Bounded_Wide_String := - BS_40.To_Bounded_Wide_String("lived, highly reliabel software "); - Line4 : BS_40.Bounded_Wide_String := - BS_40.To_Bounded_Wide_String("systems"); - - Page : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4); - - Finished_Page : Page_Type := - (BS_40.To_Bounded_Wide_String - ("Ada is a programming language designed"), - BS_40.To_Bounded_Wide_String("to support the construction of long-"), - BS_40.To_Bounded_Wide_String - ("lived, HIGHLY RELIABLE software systems."), - BS_40.To_Bounded_Wide_String("")); - - --- - - procedure Compress (Page : in out Page_Type) is - Clear_Line : Natural := Lines_Per_Page; - begin - -- If two consecutive lines on the page are together less than the - -- maximum line length, then append those two lines, move up all - -- lower lines on the page, and blank out the last line. - -- This algorithm works one time through the page, does not perform - -- repetitive compression, and is designed for use with this test - -- program only. - for i in 1..Lines_Per_Page - 1 loop - if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <= - BS_40.Max_Length - then - Page(i) := BS_40."&"(Page(i), - Page(i+1)); -- "&" (wd bnd, wd bnd) - - for j in i+1..Lines_Per_Page - 1 loop - Page(j) := - BS_40.To_Bounded_Wide_String - (BS_40.Slice(Page(j+1), - 1, - BS_40.Length(Page(j+1)))); - Clear_Line := j + 1; - end loop; - Page(Clear_Line) := BS_40.Null_Bounded_Wide_String; - end if; - end loop; - end Compress; - - --- - - procedure Format (Page : in out Page_Type) is - Sm_Ada : BS_40.Bounded_Wide_String := - BS_40.To_Bounded_Wide_String("ada"); - Cap_Ada : constant Wide_String := "Ada"; - Char_Pos : Natural := 0; - Finished : Boolean := False; - Line : Natural := Page_Type'Last; - begin - - -- Add a period to the end of the last line. - while Line >= Page_Type'First and not Finished loop - if Page(Line) /= BS_40.Null_Bounded_Wide_String and - BS_40.Length(Page(Line)) <= BS_40.Max_Length - then - Page(Line) := BS_40.Append(Page(Line), '.'); - Finished := True; - end if; - Line := Line - 1; - end loop; - - -- Replace all occurrences of "ada" with "Ada". - for Line in Page_Type'First .. Page_Type'Last loop - Finished := False; - while not Finished loop - Char_Pos := - BS_40.Index (Source => Page(Line), - Pattern => BS_40.To_Wide_String(Sm_Ada), - Going => Ada.Strings.Backward); - -- A zero is returned by function Index if no occurrences of - -- the pattern wide string are found. - Finished := (Char_Pos = 0); - if not Finished then - BS_40.Replace_Slice - (Source => Page(Line), - Low => Char_Pos, - High => Char_Pos + BS_40.Length(Sm_Ada) - 1, - By => Cap_Ada); - end if; - end loop; -- while loop - end loop; -- for loop - - end Format; - - --- - - procedure Spell_Check (Page : in out Page_Type) is - type Spelling_Type is (Incorrect, Correct); - type Word_Array_Type is array (Spelling_Type) - of BS_40.Bounded_Wide_String; - type Dictionary_Type is array (1..2) of Word_Array_Type; - - -- Note that the "words" in the dictionary will require various - -- amounts of Trimming prior to their use in the bounded wide string - -- functions. - Dictionary : Dictionary_Type := - (1 => (BS_40.To_Bounded_Wide_String(" reliabel "), - BS_40.To_Bounded_Wide_String(" reliable ")), - 2 => (BS_40.To_Bounded_Wide_String(" progrraming "), - BS_40.To_Bounded_Wide_String(" programming "))); - - Pos : Natural := Natural'First; - Finished : Boolean := False; - - begin - - for Line in Page_Type'Range loop - - -- Search for the first incorrectly spelled word in the - -- Dictionary, if it is found, replace it with the correctly - -- spelled word, using the Overwrite function. - - while not Finished loop - Pos := - BS_40.Index(Page(Line), - BS_40.To_Wide_String - (BS_40.Trim(Dictionary(1)(Incorrect), - Ada.Strings.Both)), - Ada.Strings.Forward); - Finished := (Pos = 0); - if not Finished then - Page(Line) := - BS_40.Overwrite(Page(Line), - Pos, - BS_40.To_Wide_String - (BS_40.Trim(Dictionary(1)(Correct), - Ada.Strings.Both))); - end if; - end loop; - - Finished := False; - - -- Search for the second incorrectly spelled word in the - -- Dictionary, if it is found, replace it with the correctly - -- spelled word, using the Delete procedure and Insert function. - - while not Finished loop - Pos := - BS_40.Index(Page(Line), - BS_40.To_Wide_String( - BS_40.Trim(Dictionary(2)(Incorrect), - Ada.Strings.Both)), - Ada.Strings.Forward); - - Finished := (Pos = 0); - - if not Finished then - BS_40.Delete - (Page(Line), - Pos, - Pos + BS_40.To_Wide_String - (BS_40.Trim(Dictionary(2)(Incorrect), - Ada.Strings.Both))'Length-1); - Page(Line) := - BS_40.Insert(Page(Line), - Pos, - BS_40.To_Wide_String - (BS_40.Trim(Dictionary(2)(Correct), - Ada.Strings.Both))); - end if; - end loop; - - Finished := False; - - end loop; - end Spell_Check; - - --- - - procedure Bold (Page : in out Page_Type) is - Key_Word : constant Wide_String := "highly reliable"; - Bold_Mapping : constant - Ada.Strings.Wide_Maps.Wide_Character_Mapping := - Ada.Strings.Wide_Maps.To_Mapping - (From => " abcdefghijklmnopqrstuvwxyz", - To => " ABCDEFGHIJKLMNOPQRSTUVWXYZ"); - Pos : Natural := Natural'First; - Finished : Boolean := False; - begin - -- This procedure is designed to change the case of the phrase - -- "highly reliable" into upper case (a type of "Bolding"). - -- All instances of the phrase on all lines of the page will be - -- modified. - - for Line in Page_Type'First .. Page_Type'Last loop - while not Finished loop - Pos := BS_40.Index(Page(Line), Key_Word); - Finished := (Pos = 0); - if not Finished then - - BS_40.Overwrite - (Page(Line), - Pos, - BS_40.To_Wide_String - (BS_40.Translate - (BS_40.To_Bounded_Wide_String - (BS_40.Slice(Page(Line), - Pos, - Pos + Key_Word'Length - 1)), - Bold_Mapping))); - - end if; - end loop; - Finished := False; - end loop; - end Bold; - - - begin - - Compress(Page); - Format(Page); - Spell_Check(Page); - Bold(Page); - - for i in 1..Lines_Per_Page loop - if BS_40.To_Wide_String(Page(i)) /= - BS_40.To_Wide_String(Finished_Page(i)) or - BS_40.Length(Page(i)) /= - BS_40.Length(Finished_Page(i)) - then - Report.Failed("Incorrect modification of Page, Line " & - Integer'Image(i)); - end if; - end loop; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4017; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a deleted file mode 100644 index 98e0ded4a2c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a +++ /dev/null @@ -1,379 +0,0 @@ --- CXA4018.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 subprograms defined in package --- Ada.Strings.Wide_Bounded are available, and that they produce --- correct results. Specifically, check the subprograms Append, --- Count, Element, Find_Token, Head, Index_Non_Blank, Replace_Element, --- Replicate, Tail, To_Bounded_Wide_String, "&", ">", "<", ">=", "<=", --- and "*". --- --- TEST DESCRIPTION: --- This test, when taken in conjunction with test CXA40[17,19,20], will --- constitute a test of all the functionality contained in package --- Ada.Strings.Wide_Bounded. This test uses a variety of the --- subprograms defined in the wide bounded string package in ways typical --- of common usage. Different combinations of available subprograms --- are used to accomplish similar wide bounded string processing goals. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 22 Dec 94 SAIC Changed obsolete constant to Strings.Wide_Space. --- 06 Nov 95 SAIC Corrected evaluation string used in Head/Tail --- subtests for ACVC 2.0.1. --- ---! - -with Ada.Strings; -with Ada.Strings.Wide_Bounded; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; -with Report; - -procedure CXA4018 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to all the Wide_Bounded - -- subprogram parameters to simulate the use of Wide_Characters and - -- Wide_Strings in actual practice. Blanks are translated to Wide_Character - -- blanks and all other characters are translated into Wide_Characters with - -- position values 256 greater than their (narrow) character position - -- values. - - function Translate (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Translate; - - function Translate (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Translate(Str(i)); - end loop; - return WS; - end Translate; - - -begin - - Report.Test ("CXA4018", "Check that the subprograms defined in package " & - "Ada.Strings.Wide_Bounded are available, and " & - "that they produce correct results"); - - Test_Block: - declare - - package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80); - use type BS80.Bounded_Wide_String; - - Part1 : constant Wide_String := Translate("Rum"); - Part2 : Wide_Character := Translate('p'); - Part3 : BS80.Bounded_Wide_String := - BS80.To_Bounded_Wide_String(Translate("el")); - Part4 : Wide_Character := Translate('s'); - Part5 : BS80.Bounded_Wide_String := - BS80.To_Bounded_Wide_String(Translate("tilt")); - Part6 : Wide_String(1..3) := Translate("ski"); - - Full_Catenate_String, - Full_Append_String, - Constructed_String, - Drop_String, - Replicated_String, - Token_String : BS80.Bounded_Wide_String; - - CharA : Wide_Character := Translate('A'); - CharB : Wide_Character := Translate('B'); - CharC : Wide_Character := Translate('C'); - CharD : Wide_Character := Translate('D'); - CharE : Wide_Character := Translate('E'); - CharF : Wide_Character := Translate('F'); - - ABStr : Wide_String(1..15) := Translate("AAAAABBBBBBBBBB"); - StrB : Wide_String(1..2) := Translate("BB"); - StrE : Wide_String(1..2) := Translate("EE"); - - - begin - - -- Evaluation of the overloaded forms of the "&" operator. - - Full_Catenate_String := - BS80."&"(Part2, -- WChar & Bnd WStr - BS80."&"(Part3, -- Bnd WStr & Bnd WStr - BS80."&"(Part4, -- WChar & Bnd WStr - BS80."&"(Part5, -- Bnd WStr & Bnd WStr - BS80.To_Bounded_Wide_String - (Part6))))); - - Full_Catenate_String := - BS80."&"(Part1, Full_Catenate_String); -- WStr & Bnd WStr - Full_Catenate_String := - BS80."&"(Left => Full_Catenate_String, - Right => Translate('n')); -- Bnd WStr & WChar - - - -- Evaluation of the overloaded forms of function Append. - - Full_Append_String := - BS80.Append(Part2, -- WChar,Bnd WStr - BS80.Append(Part3, -- Bnd WStr, Bnd WStr - BS80.Append(Part4, -- WChar,Bnd WStr - BS80.Append(BS80.To_Wide_String(Part5), -- WStr,Bnd WStr - BS80.To_Bounded_Wide_String(Part6))))); - - Full_Append_String := - BS80.Append(BS80.To_Bounded_Wide_String(Part1), -- Bnd WStr, WStr - BS80.To_Wide_String(Full_Append_String)); - - Full_Append_String := - BS80.Append(Left => Full_Append_String, - Right => Translate('n')); -- Bnd WStr, WChar - - - -- Validate the resulting bounded wide strings. - - if BS80."<"(Full_Catenate_String, Full_Append_String) or - BS80.">"(Full_Catenate_String, Full_Append_String) or - not (Full_Catenate_String = Full_Append_String and - BS80."<="(Full_Catenate_String, Full_Append_String) and - BS80.">="(Full_Catenate_String, Full_Append_String)) - then - Report.Failed - ("Incorrect results from bounded wide string catenation" & - " and comparison"); - end if; - - - -- Evaluate the overloaded forms of the Constructor function "*" and - -- the Replicate function. - - Constructed_String := - BS80."*"(2,CharA) & -- "AA" - BS80."*"(2,StrB) & -- "AABBBB" - BS80."*"(3, BS80."*"(2, CharC)) & -- "AABBBBCCCCCC" - BS80.Replicate(3, - BS80.Replicate(2, CharD)) & -- "AABBBBCCCCCCDDDDDD" - BS80.Replicate(2, StrE) & -- "AABBBBCCCCCCDDDDDDEEEE" - BS80.Replicate(2, CharF); -- "AABBBBCCCCCCDDDDDDEEEEFF" - - - -- Use of Function Replicate that involves dropping wide characters. - -- The attempt to replicate the 15 character wide string six times will - -- exceed the 80 wide character bound of the wide string. Therefore, - -- the result should be the catenation of 5 copies of the 15 character - -- wide string, followed by 5 'A' wide characters (the first five wide - -- characters of the 6th replication) with the remaining wide - -- characters of the 6th replication dropped. - - Drop_String := - BS80.Replicate(Count => 6, - Item => ABStr, -- "AAAAABBBBBBBBBB" - Drop => Ada.Strings.Right); - - if BS80.Element(Drop_String, 1) /= Translate('A') or - BS80.Element(Drop_String, 6) /= Translate('B') or - BS80.Element(Drop_String, 76) /= Translate('A') or - BS80.Element(Drop_String, 80) /= Translate('A') - then - Report.Failed("Incorrect result from Replicate with Drop"); - end if; - - - -- Use function Index_Non_Blank in the evaluation of the - -- Constructed_String. - - if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward) /= - BS80.To_Wide_String(Constructed_String)'First or - BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /= - BS80.Length(Constructed_String) - then - Report.Failed("Incorrect results from constructor functions"); - end if; - - - - declare - - -- Define wide character set objects for use with the Count function. - -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above. - - A_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 1)); - B_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 3)); - C_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 7)); - D_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 13)); - E_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 19)); - F_Set : Ada.Strings.Wide_Maps.Wide_Character_Set := - Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String, - 23)); - Start : Positive; - Stop : Natural := 0; - - begin - - -- Evaluate the results from function Count by comparing the number - -- of A's to the number of F's, B's to E's, and C's to D's in the - -- Constructed_String. - -- There should be an equal number of each of the wide characters that - -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc) - - if BS80.Count(Constructed_String, A_Set) /= - BS80.Count(Constructed_String, F_Set) or - BS80.Count(Constructed_String, B_Set) /= - BS80.Count(Constructed_String, E_Set) or - not (BS80.Count(Constructed_String, C_Set) = - BS80.Count(Constructed_String, D_Set)) - then - Report.Failed("Incorrect result from function Count"); - end if; - - - -- Evaluate the functions Head, Tail, and Find_Token. - -- Create the Token_String from the Constructed_String above. - - Token_String := - BS80.Tail(BS80.Head(Constructed_String, 3), 2) & -- "AB" & - BS80.Head(BS80.Tail(Constructed_String, 13), 2) & -- "CD" & - BS80.Head(BS80.Tail(Constructed_String, 3), 2); -- "EF" - - if Token_String /= - BS80.To_Bounded_Wide_String(Translate("ABCDEF")) then - Report.Failed("Incorrect result from Catenation of Token_String"); - end if; - - - -- Find the starting/ending position of the first A in the - -- Token_String (both should be 1, only one A appears in string). - -- The Function Head uses the default pad character to return a - -- bounded wide string longer than its input parameter bounded - -- wide string. - - BS80.Find_Token(BS80.Head(Token_String, 10), -- Default pad. - A_Set, - Ada.Strings.Inside, - Start, - Stop); - - if Start /= 1 and Stop /= 1 then - Report.Failed("Incorrect result from Find_Token - 1"); - end if; - - - -- Find the starting/ending position of the first non-AB slice in - -- the "head" five wide characters of Token_String (slice CDE at - -- positions 3-5) - - BS80.Find_Token(BS80.Head(Token_String, 5), -- "ABCDE" - Ada.Strings.Wide_Maps."OR"(A_Set, B_Set), -- Set (AB) - Ada.Strings.Outside, - Start, - Stop); - - if Start /= 3 and Stop /= 5 then - Report.Failed("Incorrect result from Find_Token - 2"); - end if; - - - -- Find the starting/ending position of the first CD slice in - -- the "tail" eight wide characters (including two pad wide - -- characters) of Token_String (slice CD at positions 5-6 of - -- the tail portion specified) - - BS80.Find_Token(BS80.Tail(Token_String, 8, - Ada.Strings.Wide_Space), - Ada.Strings.Wide_Maps."OR"(C_Set, D_Set), - Ada.Strings.Inside, - Start, - Stop); - - if Start /= 5 and Stop /= 6 then - Report.Failed("Incorrect result from Find_Token - 3"); - end if; - - - -- Evaluate the Replace_Element function. - - -- Token_String = "ABCDEF" - - BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4)); - - -- Token_String = "ABDDEF" - - BS80.Replace_Element(Source => Token_String, - Index => 2, - By => BS80.Element(Token_String, 5)); - - -- Token_String = "AEDDEF" - - BS80.Replace_Element(Token_String, - 1, - BS80.Element(BS80.Tail(Token_String, 2), 2)); - - -- Token_String = "FEDDEF" - -- Evaluate this result. - - if BS80.Element(Token_String, - BS80.To_Wide_String(Token_String)'First) /= - BS80.Element(Token_String, - BS80.To_Wide_String(Token_String)'Last) or - BS80.Count(Token_String, D_Set) /= - BS80.Count(Token_String, E_Set) or - BS80.Index_Non_Blank(BS80.Head(Token_String,6)) /= - BS80.Index_Non_Blank(BS80.Tail(Token_String,6)) or - BS80.Head(Token_String, 1) /= - BS80.Tail(Token_String, 1) - then - Report.Failed("Incorrect result from operations in combination"); - end if; - - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4018; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a deleted file mode 100644 index 943e3e73b88..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a +++ /dev/null @@ -1,1027 +0,0 @@ --- CXA4019.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 subprograms defined in package Ada.Strings.Wide_Bounded --- are available, and that they produce correct results, especially --- under conditions where truncation of the result is required. --- Specifically, check the subprograms Append, Count with non-Identity --- maps, Index with non-Identity maps, Index with Set parameters, --- Insert (function and procedure), Replace_Slice (function and --- procedure), To_Bounded_Wide_String, and Translate (function and --- procedure). --- --- TEST DESCRIPTION: --- This test, in conjunction with tests CXA4017, CXA4018, and CXA4020, --- will provide coverage of the most common usages of the functionality --- found in the Ada.Strings.Wide_Bounded package. It deals in large part --- with truncation effects and options. This test contains many small, --- specific test cases, situations that are often difficult to generate --- in large numbers in an application-based test. These cases represent --- specific usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 06 Nov 95 SAIC Corrected expected result string in subtest for --- ACVC 2.0.1. --- Moved function Dog_to_Cat_Mapping to library --- level to correct accessibility problem in test. --- 22 Aug 96 SAIC Corrected three subtests identified in reviewer --- comments. --- 17 Feb 97 PWB.CTA Corrected result strings for Translate and Insert --- ---! - -package CXA40190 is - - -- Wide Character mapping function defined for use with specific - -- versions of functions Index and Count. - - function Dog_to_Cat_Mapping (From : Wide_Character) - return Wide_Character; - -end CXA40190; - -package body CXA40190 is - - -- Translates "dog" to "cat". - function Dog_to_Cat_Mapping (From : Wide_Character) - return Wide_Character is - begin - if From = 'd' then - return 'c'; - elsif From = 'o' then - return 'a'; - elsif From = 'g' then - return 't'; - else - return From; - end if; - end Dog_to_Cat_Mapping; - -end CXA40190; - - -with CXA40190; -with Report; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Bounded; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Maps.Wide_Constants; - -procedure CXA4019 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to all the Wide_Bounded - -- subprogram parameters to simulate the use of Wide_Characters and - -- Wide_Strings in actual practice. - - function Equiv (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Equiv; - - - function Equiv (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Equiv(Str(i)); - end loop; - return WS; - end Equiv; - -begin - - Report.Test("CXA4019", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Bounded are " & - "available, and that they produce correct " & - "results, especially under conditions where " & - "truncation of the result is required"); - - Test_Block: - declare - - use CXA40190; - - package AS renames Ada.Strings; - package ASB renames Ada.Strings.Wide_Bounded; - package ASWC renames Ada.Strings.Wide_Maps.Wide_Constants; - package Maps renames Ada.Strings.Wide_Maps; - - package B10 is new ASB.Generic_Bounded_Length(Max => 10); - use type B10.Bounded_Wide_String; - - Result_String : B10.Bounded_Wide_String; - Test_String : B10.Bounded_Wide_String; - AtoE_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Equiv("abcde")); - FtoJ_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Equiv("fghij")); - AtoJ_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Equiv("abcdefghij")); - - Location : Natural := 0; - Total_Count : Natural := 0; - - CD_Set : Maps.Wide_Character_Set := Maps.To_Set("cd"); - Wide_CD_Set : Maps.Wide_Character_Set := Maps.To_Set(Equiv("cd")); - - AB_to_YZ_Map : Maps.Wide_Character_Mapping := - Maps.To_Mapping(From => "ab", To => "yz"); - - Wide_AB_to_YZ_Map : Maps.Wide_Character_Mapping := - Maps.To_Mapping(From => Equiv("ab"), - To => Equiv("yz")); - - CD_to_XY_Map : Maps.Wide_Character_Mapping := - Maps.To_Mapping(From => "cd", To => "xy"); - - Wide_CD_to_XY_Map : Maps.Wide_Character_Mapping := - Maps.To_Mapping(From => Equiv("cd"), - To => Equiv("xy")); - - - -- Access-to-Subprogram object defined for use with specific versions of - -- functions Index, Count Translate, and procedure Translate. - - Map_Ptr : Maps.Wide_Character_Mapping_Function := - Dog_to_Cat_Mapping'Access; - - - - begin - - -- Function To_Bounded_Wide_String with Truncation - -- Evaluate the function Append with parameters that will - -- cause the truncation of the result. - - -- Drop = Error (default case, Length_Error will be raised) - - begin - Test_String := - B10.To_Bounded_Wide_String - (Equiv("Much too long for this bounded wide string")); - Report.Failed("Length Error not raised by To_Bounded_Wide_String"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed - ("Incorrect exception raised by To_Bounded_Wide_String"); - end; - - -- Drop = Left - - Test_String := - B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"), - Drop => Ada.Strings.Left); - - if Test_String /= B10.To_Bounded_Wide_String(Equiv("efghijklmn")) then - Report.Failed - ("Incorrect result from To_Bounded_Wide_String, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := - B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"), - Drop => Ada.Strings.Right); - - if not(Test_String = AtoJ_Bnd_Str) then - Report.Failed - ("Incorrect result from To_Bounded_Wide_String, Drop = Right"); - end if; - - - - - -- Function Append with Truncation - -- Evaluate the function Append with parameters that will - -- cause the truncation of the result. - - -- Drop = Error (default case, Length_Error will be raised) - - begin - -- Append (Bnd Str, Bnd Str); - Result_String := - B10.Append(B10.To_Bounded_Wide_String(Equiv("abcde")), - B10.To_Bounded_Wide_String(Equiv("fghijk"))); -- 11 char - Report.Failed("Length_Error not raised by Append - 1"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 1"); - end; - - begin - -- Append (Str, Bnd Str); - Result_String := - B10.Append(B10.To_Wide_String(AtoE_Bnd_Str), - B10.To_Bounded_Wide_String(Equiv("fghijk")), - AS.Error); - Report.Failed("Length_Error not raised by Append - 2"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 2"); - end; - - begin - -- Append (Bnd Str, Char); - Result_String := - B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 'k'); - Report.Failed("Length_Error not raised by Append - 3"); - exception - when AS.Length_Error => null; -- OK, correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Append - 3"); - end; - - -- Drop = Left - - -- Append (Bnd Str, Bnd Str) - Result_String := - B10.Append(B10.To_Bounded_Wide_String(Equiv("abcdefgh")), -- 8 chs - B10.To_Bounded_Wide_String(Equiv("ijklmn")), -- 6 chs - Ada.Strings.Left); - - if Result_String /= - B10.To_Bounded_Wide_String(Equiv("efghijklmn")) -- 10 chars - then - Report.Failed("Incorrect truncation performed by Append - 4"); - end if; - - -- Append (Bnd Str, Str) - Result_String := - B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), - "xyz", - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_Wide_String("defghijxyz") then - Report.Failed("Incorrect truncation performed by Append - 5"); - end if; - - -- Append (Char, Bnd Str) - - Result_String := - B10.Append(Equiv('A'), - B10.To_Bounded_Wide_String(Equiv("abcdefghij")), - Ada.Strings.Left); - - if Result_String /= B10.To_Bounded_Wide_String(Equiv("abcdefghij")) - then - Report.Failed("Incorrect truncation performed by Append - 6"); - end if; - - -- Drop = Right - - -- Append (Bnd Str, Bnd Str) - Result_String := B10.Append(FtoJ_Bnd_Str, - AtoJ_Bnd_Str, - Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Equiv("fghijabcde")) - then - Report.Failed("Incorrect truncation performed by Append - 7"); - end if; - - -- Append (Str, Bnd Str) - Result_String := B10.Append(B10.To_Wide_String(AtoE_Bnd_Str), - AtoJ_Bnd_Str, - Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Equiv("abcdeabcde")) - then - Report.Failed("Incorrect truncation performed by Append - 8"); - end if; - - -- Append (Char, Bnd Str) - Result_String := B10.Append(Equiv('A'), AtoJ_Bnd_Str, Ada.Strings.Right); - - if Result_String /= B10.To_Bounded_Wide_String(Equiv("Aabcdefghi")) then - Report.Failed("Incorrect truncation performed by Append - 9"); - end if; - - - - -- Function Index with non-Identity map. - -- Evaluate the function Index with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the index position search. - - Location := - B10.Index(Source => B10.To_Bounded_Wide_String("foxy fox 2"), - Pattern => "FOX", - Going => Ada.Strings.Backward, - Mapping => ASWC.Upper_Case_Map); - - if Location /= 6 then - Report.Failed("Incorrect result from Index, non-Identity map - 1"); - end if; - - Location := - B10.Index(B10.To_Bounded_Wide_String("THE QUICK "), - "quick", - Ada.Strings.Forward, - Ada.Strings.Wide_Maps.Wide_Constants.Lower_Case_Map); - - if Location /= 5 then - Report.Failed("Incorrect result from Index, non-Identity map - 2"); - end if; - - Location := B10.Index(Source => B10.To_Bounded_Wide_String("The the"), - Pattern => "the", - Going => Ada.Strings.Forward, - Mapping => ASWC.Lower_Case_Map); - - if Location /= 1 then - Report.Failed("Incorrect result from Index, non-Identity map - 3"); - end if; - - - - if B10.Index(B10.To_Bounded_Wide_String("abcd"), -- Pattern = Source - "abcd") /= 1 or - B10.Index(B10.To_Bounded_Wide_String("abc"), -- Pattern < Source - "abcd") /= 0 or - B10.Index(B10.Null_Bounded_Wide_String, -- Source = Null - "abc") /= 0 - then - Report.Failed("Incorrect result from Index with string patterns"); - end if; - - - - -- Function Index with access-to-subprogram mapping value. - -- Evaluate the function Index with a wide character mapping function - -- object that performs the mapping operation. - - Location := B10.Index(Source => B10.To_Bounded_Wide_String("My dog"), - Pattern => "cat", - Going => Ada.Strings.Forward, - Mapping => Map_Ptr); -- change "dog" to "cat" - - if Location /= 4 then - Report.Failed("Incorrect result from Index, w/map ptr - 1"); - end if; - - Location := B10.Index(B10.To_Bounded_Wide_String("cat or dog"), - "cat", - Ada.Strings.Backward, - Map_Ptr); - - if Location /= 8 then - Report.Failed("Incorrect result from Index, w/map ptr - 2"); - end if; - - if B10.Index(B10.To_Bounded_Wide_String("dog"), -- Pattern = Source - "cat", - Ada.Strings.Forward, - Map_Ptr) /= 1 or - B10.Index(B10.To_Bounded_Wide_String("dog"), -- Pattern < Source - "cats", - Ada.Strings.Backward, - Map_Ptr) /= 0 or - B10.Index(B10.Null_Bounded_Wide_String, -- Source = Null - "cat", - Ada.Strings.Forward, - Map_Ptr) /= 0 or - B10.Index(B10.To_Bounded_Wide_String("hot dog"), - "dog", - Ada.Strings.Backward, - Map_Ptr) /= 0 or - B10.Index(B10.To_Bounded_Wide_String(" cat dog "), - " cat", - Ada.Strings.Backward, - Map_Ptr) /= 5 or - B10.Index(B10.To_Bounded_Wide_String("dog CatDog"), - "cat", - Ada.Strings.Backward, - Map_Ptr) /= 1 or - B10.Index(B10.To_Bounded_Wide_String("CatandDog"), - "cat", - Ada.Strings.Forward, - Map_Ptr) /= 0 or - B10.Index(B10.To_Bounded_Wide_String("dddd"), - "ccccc", - Ada.Strings.Backward, - Map_Ptr) /= 0 - then - Report.Failed("Incorrect result from Index w/map ptr - 3"); - end if; - - - - -- Function Index (for Sets). - -- This version of Index uses Sets as the basis of the search. - - -- Test = Inside, Going = Forward (Default case). - Location := - B10.Index(Source => B10.To_Bounded_Wide_String(Equiv("abcdeabcde")), - Set => Wide_CD_Set, - Test => Ada.Strings.Inside, - Going => Ada.Strings.Forward); - - if not (Location = 3) then -- position of first 'c' equivalent in source. - Report.Failed("Incorrect result from Index using Sets - 1"); - end if; - - -- Test = Inside, Going = Backward. - Location := - B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), - Set => Wide_CD_Set, - Test => Ada.Strings.Inside, - Going => Ada.Strings.Backward); - - if not (Location = 9) then -- position of last 'd' in source. - Report.Failed("Incorrect result from Index using Sets - 2"); - end if; - - -- Test = Outside, Going = Forward. - Location := B10.Index(B10.To_Bounded_Wide_String("deddacd"), - CD_Set, - Test => Ada.Strings.Outside, - Going => Ada.Strings.Forward); - - if Location /= 2 then -- position of 'e' in source. - Report.Failed("Incorrect result from Index using Sets - 3"); - end if; - - -- Test = Outside, Going = Backward. - Location := B10.Index(B10.To_Bounded_Wide_String(Equiv("deddacd")), - Wide_CD_Set, - Ada.Strings.Outside, - Ada.Strings.Backward); - - if Location /= 5 then -- position of 'a', correct. - Report.Failed("Incorrect result from Index using Sets - 4"); - end if; - - if B10.Index(B10.To_Bounded_Wide_String("cd"), -- Source = Set - CD_Set) /= 1 or - B10.Index(B10.To_Bounded_Wide_String("c"), -- Source < Set - CD_Set) /= 1 or - B10.Index(B10.Null_Bounded_Wide_String, -- Source = Null - Wide_CD_Set) /= 0 or - B10.Index(AtoE_Bnd_Str, - Maps.To_Set('x')) /= 0 -- No match. - then - Report.Failed("Incorrect result from Index using Sets - 5"); - end if; - - - - -- Function Count with non-Identity mapping. - -- Evaluate the function Count with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the number of matching patterns. - - Total_Count := - B10.Count(Source => B10.To_Bounded_Wide_String("THE THE TH"), - Pattern => "th", - Mapping => ASWC.Lower_Case_Map); - - if Total_Count /= 3 then - Report.Failed - ("Incorrect result from function Count, non-Identity map - 1"); - end if; - - -- And a few with identity maps as well. - - if B10.Count(B10.To_Bounded_Wide_String(Equiv("ABABABABAB")), - Equiv("ABA"), - Maps.Identity) /= 2 or - B10.Count(B10.To_Bounded_Wide_String("ADCBADABCD"), - "AB", - Maps.To_Mapping("CD", "AB")) /= 5 or - B10.Count(B10.To_Bounded_Wide_String(Equiv("aaaaaaaaaa")), - Equiv("aaa")) /= 3 or - B10.Count(B10.To_Bounded_Wide_String(Equiv("XX")), - Equiv("XXX"), - Maps.Identity) /= 0 or - B10.Count(AtoE_Bnd_Str, -- Source = Pattern - Equiv("abcde")) /= 1 or - B10.Count(B10.Null_Bounded_Wide_String, -- Source = Null - " ") /= 0 - then - Report.Failed - ("Incorrect result from function Count, w,w/o mapping"); - end if; - - - - - - -- Function Count with access-to-subprogram mapping. - -- Evaluate the version function Count that uses an access-to-subprogram - -- map parameter. - - Total_Count := - B10.Count(Source => B10.To_Bounded_Wide_String("dogdogdo"), - Pattern => "ca", - Mapping => Map_Ptr); - - if Total_Count /= 3 then - Report.Failed - ("Incorrect result from function Count, w/map ptr - 1"); - end if; - - - if B10.Count(B10.To_Bounded_Wide_String("DdOoGgod"), - "c", - Map_Ptr) /= 2 or - B10.Count(B10.To_Bounded_Wide_String("dododododo"), - "do", - Map_Ptr) /= 0 or - B10.Count(B10.To_Bounded_Wide_String("Dog or dog"), - "cat", - Map_Ptr) /= 1 or - B10.Count(B10.To_Bounded_Wide_String("dddddddddd"), - "ccccc", - Map_Ptr) /= 2 or - B10.Count(B10.To_Bounded_Wide_String("do"), -- Source < Pattern - "cat", - Map_Ptr) /= 0 or - B10.Count(B10.To_Bounded_Wide_String(" dog "), -- Source = Pattern - " cat ", - Map_Ptr) /= 1 or - B10.Count(B10.Null_Bounded_Wide_String, -- Source = Null - " ", - Map_Ptr) /= 0 - then - Report.Failed - ("Incorrect result from function Count, w/map ptr - 2"); - end if; - - - - - -- Procedure Translate - - -- Partial mapping of source. - - Test_String := B10.To_Bounded_Wide_String("abcdeabcab"); - - B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= B10.To_Bounded_Wide_String("yzcdeyzcyz") then - Report.Failed("Incorrect result from procedure Translate - 1"); - end if; - - -- Total mapping of source. - - Test_String := B10.To_Bounded_Wide_String("abbaaababb"); - - B10.Translate(Source => Test_String, Mapping => ASWC.Upper_Case_Map); - - if Test_String /= B10.To_Bounded_Wide_String("ABBAAABABB") then - Report.Failed("Incorrect result from procedure Translate - 2"); - end if; - - -- No mapping of source. - - Test_String := B10.To_Bounded_Wide_String(Equiv("xyzsypcc")); - - B10.Translate(Source => Test_String, Mapping => Wide_AB_to_YZ_Map); - - if Test_String /= B10.To_Bounded_Wide_String(Equiv("xyzsypcc")) then - Report.Failed("Incorrect result from procedure Translate - 3"); - end if; - - -- Map > 2 characters, partial mapping. - - Test_String := B10.To_Bounded_Wide_String("opabcdelmn"); - - B10.Translate(Test_String, - Maps.To_Mapping("abcde", "lmnop")); - - if Test_String /= B10.To_Bounded_Wide_String("oplmnoplmn") then - Report.Failed("Incorrect result from procedure Translate - 4"); - end if; - - - - - -- Procedure Translate with access-to-subprogram mapping. - -- Use the version of Procedure Translate that takes an - -- access-to-subprogram parameter to perform the Source mapping. - - -- Partial mapping of source. - - Test_String := B10.To_Bounded_Wide_String("dogeatdog"); - - B10.Translate(Source => Test_String, Mapping => Map_Ptr); - - if Test_String /= B10.To_Bounded_Wide_String("cateatcat") then - Report.Failed - ("Incorrect result from procedure Translate w/map ptr - 1"); - end if; - - Test_String := B10.To_Bounded_Wide_String("odogcatlmn"); - - B10.Translate(Test_String, Map_Ptr); - - if Test_String /= B10.To_Bounded_Wide_String("acatcatlmn") then - Report.Failed - ("Incorrect result from procedure Translate w/map ptr - 2"); - end if; - - - -- Total mapping of source. - - Test_String := B10.To_Bounded_Wide_String("gggooooddd"); - - B10.Translate(Source => Test_String, Mapping => Map_Ptr); - - if Test_String /= B10.To_Bounded_Wide_String("tttaaaaccc") then - Report.Failed - ("Incorrect result from procedure Translate w/map ptr- 3"); - end if; - - -- No mapping of source. - - Test_String := B10.To_Bounded_Wide_String(" DOG cat "); - - B10.Translate(Source => Test_String, Mapping => Map_Ptr); - - if Test_String /= B10.To_Bounded_Wide_String(" DOG cat ") then - Report.Failed - ("Incorrect result from procedure Translate w/map ptr - 4"); - end if; - - Test_String := B10.Null_Bounded_Wide_String; - - B10.Translate(Source => Test_String, Mapping => Map_Ptr); - - if Test_String /= B10.To_Bounded_Wide_String("") then - Report.Failed - ("Incorrect result from procedure Translate w/map ptr - 5"); - end if; - - - - - -- Function Translate with access-to-subprogram mapping. - -- Use the version of Function Translate that takes an - -- access-to-subprogram parameter to perform the Source mapping. - - -- Partial mapping of source. - - if B10.Translate(Source => B10.To_Bounded_Wide_String("cateatdog"), - Mapping => Map_Ptr) /= - B10.To_Bounded_Wide_String("cateatcat") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr - 1"); - end if; - - if B10.Translate(B10.To_Bounded_Wide_String("cadogtac"), - Map_Ptr) /= - B10.To_Bounded_Wide_String("cacattac") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr - 2"); - end if; - - -- Total mapping of source. - - if B10.Translate(Source => B10.To_Bounded_Wide_String("dogodggdo"), - Mapping => Map_Ptr) /= - B10.To_Bounded_Wide_String("catacttca") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr- 3"); - end if; - - -- No mapping of source. - - if B10.Translate(Source => B10.To_Bounded_Wide_String(" DOG cat "), - Mapping => Map_Ptr) /= - B10.To_Bounded_Wide_String(" DOG cat ") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr - 4"); - end if; - - if B10.Translate(B10.To_Bounded_Wide_String("d "), Map_Ptr) /= - B10.To_Bounded_Wide_String("c ") or - B10.Translate(B10.To_Bounded_Wide_String(" god"), Map_Ptr) /= - B10.To_Bounded_Wide_String(" tac") or - B10.Translate(B10.To_Bounded_Wide_String("d o g D og"), Map_Ptr) /= - B10.To_Bounded_Wide_String("c a t D at") or - B10.Translate(B10.To_Bounded_Wide_String(" "), Map_Ptr) /= - B10.To_Bounded_Wide_String(" ") or - B10.Translate(B10.To_Bounded_Wide_String("dddddddddd"), Map_Ptr) /= - B10.To_Bounded_Wide_String("cccccccccc") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr - 5"); - end if; - - if B10.Translate(Source => B10.Null_Bounded_Wide_String, - Mapping => Map_Ptr) /= - B10.To_Bounded_Wide_String("") - then - Report.Failed - ("Incorrect result from function Translate w/map ptr - 6"); - end if; - - - - - -- Function Replace_Slice - -- Evaluate function Replace_Slice with - -- a variety of Truncation options. - - -- Drop = Error (Default) - - begin - Test_String := AtoJ_Bnd_Str; - Result_String := - B10.Replace_Slice(Source => Test_String, - Low => 3, - High => 5, -- 3-5, 3 chars. - By => Equiv("xxxxxx")); -- more than 3. - Report.Failed("Length_Error not raised by Function Replace_Slice"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Function Replace_Slice"); - end; - - -- Drop = Left - - Result_String := - B10.Replace_Slice(Source => Test_String, - Low => 7, - High => 10, -- 7-10, 4 chars. - By => Equiv("xxxxxx"), -- 6 chars. - Drop => Ada.Strings.Left); - - if Result_String /= - B10.To_Bounded_Wide_String(Equiv("cdefxxxxxx")) -- drop a,b - then - Report.Failed - ("Incorrect result from Function Replace Slice, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := - B10.Replace_Slice(Source => Test_String, - Low => 2, - High => 5, -- 2-5, 4 chars. - By => Equiv("xxxxxx"), -- 6 chars. - Drop => Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Equiv("axxxxxxfgh")) -- drop i,j - then - Report.Failed - ("Incorrect result from Function Replace Slice, Drop = Right"); - end if; - - -- Low = High = Source'Last, "By" length = 1. - - if B10.Replace_Slice(AtoE_Bnd_Str, - B10.To_Wide_String(AtoE_Bnd_Str)'Last, - B10.To_Wide_String(AtoE_Bnd_Str)'Last, - Equiv("X"), - Ada.Strings.Error) /= - B10.To_Bounded_Wide_String(Equiv("abcdX")) - then - Report.Failed("Incorrect result from Function Replace_Slice"); - end if; - - -- Index_Error raised when High < Source'First - 1. - begin - Test_String := - B10.Replace_Slice(AtoE_Bnd_Str, - B10.To_Wide_String(AtoE_Bnd_Str)'First, - B10.To_Wide_String(AtoE_Bnd_Str)'First - 2, - Equiv("hijklm")); - Report.Failed("Index_Error not raised by Function Replace_Slice"); - exception - when AS.Index_Error => null; -- OK, expected exception - when Constraint_Error => null; -- Also OK, since RM is not clear - when others => - Report.Failed - ("Incorrect exception raised by Function Replace_Slice"); - end; - - - - -- Procedure Replace_Slice - -- Evaluate procedure Replace_Slice with - -- a variety of Truncation options. - - -- Drop = Error (Default) - - begin - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, - Low => 3, - High => 5, -- 3-5, 3 chars. - By => Equiv("xxxxxx")); -- more than 3. - Report.Failed("Length_Error not raised by Procedure Replace_Slice"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Procedure Replace_Slice"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, - Low => 7, - High => 9, -- 7-9, 3 chars. - By => Equiv("xxxxx"), -- 5 chars. - Drop => Ada.Strings.Left); - - if Test_String /= - B10.To_Bounded_Wide_String(Equiv("cdefxxxxxj")) -- drop a,b - then - Report.Failed - ("Incorrect result from Procedure Replace Slice, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Replace_Slice(Source => Test_String, - Low => 1, - High => 3, -- 1-3, 3chars. - By => Equiv("xxxx"), -- 4 chars. - Drop => Ada.Strings.Right); - - if Test_String /= - B10.To_Bounded_Wide_String(Equiv("xxxxdefghi")) -- drop j - then - Report.Failed - ("Incorrect result from Procedure Replace Slice, Drop = Right"); - end if; - - -- High = Source'First, Low > High (Insert before Low). - - Test_String := AtoE_Bnd_Str; - B10.Replace_Slice(Source => Test_String, - Low => B10.To_Wide_String(Test_String)'Last, - High => B10.To_Wide_String(Test_String)'First, - By => Equiv("XXXX"), -- 4 chars. - Drop => Ada.Strings.Right); - - if Test_String /= B10.To_Bounded_Wide_String(Equiv("abcdXXXXe")) then - Report.Failed - ("Incorrect result from Procedure Replace Slice"); - end if; - - - - - -- Function Insert with Truncation - -- Drop = Error (Default). - - begin - Result_String := - B10.Insert(Source => AtoJ_Bnd_Str, -- "abcdefghij" - Before => 2, - New_Item => Equiv("xyz")); - Report.Failed("Length_Error not raised by Function Insert"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Insert"); - end; - - -- Drop = Left - - Result_String := - B10.Insert(Source => AtoJ_Bnd_Str, -- "abcdefghij" - Before => 5, - New_Item => Equiv("xyz"), -- 3 additional chars. - Drop => Ada.Strings.Left); - - if B10.To_Wide_String(Result_String) /= Equiv("dxyzefghij") then - Report.Failed("Incorrect result from Function Insert, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := - B10.Insert(Source => B10.To_Bounded_Wide_String("abcdef"), - Before => 2, - New_Item => "vwxyz", -- 5 additional chars. - Drop => Ada.Strings.Right); - - if B10.To_Wide_String(Result_String) /= "avwxyzbcde" then -- drop f. - Report.Failed("Incorrect result from Function Insert, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Insert(B10.To_Bounded_Wide_String("a"), 1, " B") /= - B10.To_Bounded_Wide_String(" Ba") or - B10.Insert(B10.Null_Bounded_Wide_String, 1, Equiv("abcde")) /= - AtoE_Bnd_Str or - B10.Insert(B10.To_Bounded_Wide_String("ab"), 2, "") /= - B10.To_Bounded_Wide_String("ab") - then - Report.Failed("Incorrect result from Function Insert"); - end if; - - - - -- Procedure Insert - - -- Drop = Error (Default). - begin - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, - Before => 9, - New_Item => Equiv("wxyz"), - Drop => Ada.Strings.Error); - Report.Failed("Length_Error not raised by Procedure Insert"); - exception - when AS.Length_Error => null; -- Correct exception raised. - when others => - Report.Failed("Incorrect exception raised by Procedure Insert"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, - Before => B10.Length(Test_String), -- before last char - New_Item => Equiv("xyz"), -- 3 additional chars. - Drop => Ada.Strings.Left); - - if B10.To_Wide_String(Test_String) /= Equiv("defghixyzj") then - Report.Failed("Incorrect result from Procedure Insert, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Insert(Source => Test_String, - Before => 4, - New_Item => Equiv("yz"), -- 2 additional chars. - Drop => Ada.Strings.Right); - - if B10.To_Wide_String(Test_String) /= Equiv("abcyzdefgh") then - Report.Failed - ("Incorrect result from Procedure Insert, Drop = Right"); - end if; - - -- Before = Source'First, New_Item length = 1. - - Test_String := B10.To_Bounded_Wide_String(" abc "); - B10.Insert(Test_String, - B10.To_Wide_String(Test_String)'First, - "Z"); - - if Test_String /= B10.To_Bounded_Wide_String("Z abc ") then - Report.Failed("Incorrect result from Procedure Insert"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4019; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a deleted file mode 100644 index 24036f17103..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a +++ /dev/null @@ -1,688 +0,0 @@ --- CXA4020.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 subprograms defined in package Ada.Strings.Wide_Bounded --- are available, and that they produce correct results, especially under --- conditions where truncation of the result is required. Specifically, --- check the subprograms Overwrite (function and procedure), Delete, --- Function Trim (blanks), Trim (Set wide characters, function and --- procedure), Head, Tail, and Replicate (wide characters and wide --- strings). --- --- TEST DESCRIPTION: --- This test, in conjunction with tests CXA4017, CXA4018, CXA4019, --- will provide coverage of the most common usages of the functionality --- found in the Ada.Strings.Wide_Bounded package. It deals in large part --- with truncation effects and options. This test contains many small, --- specific test cases, situations that are often difficult to generate --- in large numbers in an application-based test. These cases represent --- specific usage paradigms in-the-small. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 22 Dec 94 SAIC Changed obsolete constant to Strings.Wide_Space. --- 13 Apr 95 SAIC Corrected certain subtest acceptance conditions. --- ---! - -with Report; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Bounded; -with Ada.Strings.Wide_Maps; - -procedure CXA4020 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to all the Wide_Bounded - -- subprogram parameters to simulate the use of Wide_Characters and - -- Wide_Strings in actual practice. Blanks are translated to Wide_Character - -- blanks and all other characters are translated into Wide_Characters with - -- position values 256 greater than their (narrow) character position - -- values. - - function Translate (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Translate; - - - function Translate (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Translate(Str(i)); - end loop; - return WS; - end Translate; - - -begin - - Report.Test("CXA4020", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Bounded are " & - "available, and that they produce correct " & - "results, especially under conditions where " & - "truncation of the result is required"); - - Test_Block: - declare - - package AS renames Ada.Strings; - package ASW renames Ada.Strings.Wide_Bounded; - package Maps renames Ada.Strings.Wide_Maps; - - package B10 is new ASW.Generic_Bounded_Length(Max => 10); - use type B10.Bounded_Wide_String; - - Result_String : B10.Bounded_Wide_String; - Test_String : B10.Bounded_Wide_String; - AtoE_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Translate("abcde")); - FtoJ_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Translate("fghij")); - AtoJ_Bnd_Str : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Translate("abcdefghij")); - - Location : Natural := 0; - Total_Count : Natural := 0; - - CD_Set : Maps.Wide_Character_Set := Maps.To_Set(Translate("cd")); - XY_Set : Maps.Wide_Character_Set := Maps.To_Set(Translate("xy")); - - - begin - - -- Function Overwrite with Truncation - -- Drop = Error (Default). - - begin - Test_String := AtoJ_Bnd_Str; - Result_String := - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => 9, - New_Item => Translate("xyz"), - Drop => AS.Error); - Report.Failed("Exception not raised by Function Overwrite"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Overwrite"); - end; - - -- Drop = Left - - Result_String := - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => B10.Length(Test_String), -- 10 - New_Item => Translate("xyz"), - Drop => Ada.Strings.Left); - - if B10.To_Wide_String(Result_String) /= - Translate("cdefghixyz") then -- drop a,b - Report.Failed - ("Incorrect result from Function Overwrite, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := B10.Overwrite(Test_String, -- "abcdefghij" - 3, - Translate("xxxyyyzzz"), - Ada.Strings.Right); - - if B10.To_Wide_String(Result_String) /= - Translate("abxxxyyyzz") - then - Report.Failed - ("Incorrect result from Function Overwrite, Drop = Right"); - end if; - - -- Additional cases of function Overwrite. - - if B10.Overwrite(B10.To_Bounded_Wide_String(Translate("a")), - 1, -- Source length = 1 - Translate(" abc ")) /= - B10.To_Bounded_Wide_String(Translate(" abc ")) or - B10.Overwrite(B10.Null_Bounded_Wide_String, -- Null source - 1, - Translate("abcdefghij")) /= - AtoJ_Bnd_Str or - B10.Overwrite(AtoE_Bnd_Str, - B10.To_Wide_String(AtoE_Bnd_Str)'First, - Translate(" ")) /= -- New_Item = 1 - B10.To_Bounded_Wide_String(Translate(" bcde")) - then - Report.Failed("Incorrect result from Function Overwrite"); - end if; - - - - -- Procedure Overwrite - -- Correct usage, no truncation. - - Test_String := AtoE_Bnd_Str; -- "abcde" - B10.Overwrite(Test_String, 2, Translate("xyz")); - - if Test_String /= B10.To_Bounded_Wide_String(Translate("axyze")) then - Report.Failed("Incorrect result from Procedure Overwrite - 1"); - end if; - - Test_String := B10.To_Bounded_Wide_String(Translate("abc")); - B10.Overwrite(Test_String, 2, ""); -- New_Item is null string. - - if Test_String /= B10.To_Bounded_Wide_String(Translate("abc")) then - Report.Failed("Incorrect result from Procedure Overwrite - 2"); - end if; - - -- Drop = Error (Default). - - begin - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => 8, - New_Item => Translate("uvwxyz")); - Report.Failed("Exception not raised by Procedure Overwrite"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Procedure Overwrite"); - end; - - -- Drop = Left - - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Source => Test_String, -- "abcdefghij" - Position => B10.Length(Test_String) - 2, -- 8 - New_Item => Translate("uvwxyz"), - Drop => Ada.Strings.Left); - - if B10.To_Wide_String(Test_String) /= - Translate("defguvwxyz") - then - Report.Failed - ("Incorrect result from Procedure Overwrite, Drop = Left"); - end if; - - -- Drop = Right - - Test_String := AtoJ_Bnd_Str; - B10.Overwrite(Test_String, -- "abcdefghij" - 3, - Translate("xxxyyyzzz"), - Ada.Strings.Right); - - if B10.To_Wide_String(Test_String) /= Translate("abxxxyyyzz") then - Report.Failed - ("Incorrect result from Procedure Overwrite, Drop = Right"); - end if; - - - - -- Function Delete - - if B10.Delete(Source => AtoJ_Bnd_Str, -- "abcdefghij" - From => 3, - Through => 8) /= - B10."&"(B10.Head(AtoJ_Bnd_Str, 2), - B10.Tail(AtoJ_Bnd_Str, 2)) or - B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str)) /= - AtoE_Bnd_Str or - B10.Delete(AtoJ_Bnd_Str, 1, 5) /= - FtoJ_Bnd_Str - then - Report.Failed("Incorrect result from Function Delete - 1"); - end if; - - if B10.Delete(B10.To_Bounded_Wide_String(Translate("a")), 1, 1) /= - B10.Null_Bounded_Wide_String or - B10.Delete(AtoE_Bnd_Str, - 5, - B10.To_Wide_String(AtoE_Bnd_Str)'First) /= - AtoE_Bnd_Str or - B10.Delete(AtoE_Bnd_Str, - B10.To_Wide_String(AtoE_Bnd_Str)'Last, - B10.To_Wide_String(AtoE_Bnd_Str)'Last) /= - B10.To_Bounded_Wide_String(Translate("abcd")) - then - Report.Failed("Incorrect result from Function Delete - 2"); - end if; - - - - -- Function Trim - - declare - - Text : B10.Bounded_Wide_String := - B10.To_Bounded_Wide_String(Translate("Text")); - type Bnd_Array_Type is array (1..5) of B10.Bounded_Wide_String; - Bnd_Array : Bnd_Array_Type := - (B10.To_Bounded_Wide_String(Translate(" Text")), - B10.To_Bounded_Wide_String(Translate("Text ")), - B10.To_Bounded_Wide_String(Translate(" Text ")), - B10.To_Bounded_Wide_String(Translate("Text Text")), - B10.To_Bounded_Wide_String(Translate(" Text Text"))); - - begin - - for i in Bnd_Array_Type'Range loop - case i is - when 4 => - if B10.Trim(Bnd_Array(i), AS.Both) /= - Bnd_Array(i) then -- no change - Report.Failed("Incorrect result from Function Trim - 4"); - end if; - when 5 => - if B10.Trim(Bnd_Array(i), AS.Both) /= - B10."&"(Text, B10."&"(Translate(' '), Text)) - then - Report.Failed("Incorrect result from Function Trim - 5"); - end if; - when others => - if B10.Trim(Bnd_Array(i), AS.Both) /= Text then - Report.Failed("Incorrect result from Function Trim - " & - Integer'Image(i)); - end if; - end case; - end loop; - - end; - - - - -- Function Trim using Sets - - -- Trim characters in sets from both sides of the bounded wide string. - if B10.Trim(Source => B10.To_Bounded_Wide_String(Translate("ddabbaxx")), - Left => CD_Set, - Right => XY_Set) /= - B10.To_Bounded_Wide_String(Translate("abba")) - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 1"); - end if; - - -- Ensure that the characters in the set provided as the actual to - -- parameter Right are not trimmed from the left side of the bounded - -- wide string; likewise for the opposite side. Only "cd" trimmed - -- from left side, and only "xy" trimmed from right side. - - if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")), - CD_Set, - XY_Set) /= - B10.To_Bounded_Wide_String(Translate("xyabcd")) - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 2"); - end if; - - -- Ensure that characters contained in the sets are not trimmed from - -- the "interior" of the bounded wide string, just the appropriate ends. - - if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdabdxabxy")), - CD_Set, - XY_Set) /= - B10.To_Bounded_Wide_String(Translate("abdxab")) - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Left & Right side - 3"); - end if; - - -- Trim characters in set from right side only. No change to Left side. - - if B10.Trim(B10.To_Bounded_Wide_String(Translate("abxyzddcd")), - XY_Set, - CD_Set) /= - B10.To_Bounded_Wide_String(Translate("abxyz")) - then - Report.Failed - ("Incorrect result from Fn Trim - Sets, Right side"); - end if; - - -- Trim no characters on either side of the bounded string. - - Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set); - if Result_String /= AtoJ_Bnd_Str then - Report.Failed("Incorrect result from Fn Trim - Sets, Neither side"); - end if; - - if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /= - AtoE_Bnd_Str or - B10.Trim(B10.To_Bounded_Wide_String(Translate("dcddcxyyxx")), - CD_Set, - XY_Set) /= - B10.Null_Bounded_Wide_String - then - Report.Failed("Incorrect result from Function Trim"); - end if; - - - - -- Procedure Trim using Sets - - -- Trim characters in sets from both sides of the bounded wide string. - - Test_String := B10.To_Bounded_Wide_String(Translate("dcabbayx")); - B10.Trim(Source => Test_String, - Left => CD_Set, - Right => XY_Set); - - if Test_String /= B10.To_Bounded_Wide_String(Translate("abba")) then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 1"); - end if; - - -- Ensure that the characters in the set provided as the actual to - -- parameter Right are not trimmed from the left side of the bounded - -- wide string; likewise for the opposite side. Only "cd" trimmed - -- from left side, and only "xy" trimmed from right side. - - Test_String := B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")); - B10.Trim(Test_String, CD_Set, XY_Set); - - if Test_String /= B10.To_Bounded_Wide_String(Translate("xyabcd")) then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 2"); - end if; - - -- Ensure that characters contained in the sets are not trimmed from - -- the "interior" of the bounded wide string, just the appropriate ends. - - Test_String := B10.To_Bounded_Wide_String(Translate("cdabdxabxy")); - B10.Trim(Test_String, CD_Set, XY_Set); - - if not - (Test_String = B10.To_Bounded_Wide_String(Translate("abdxab"))) then - Report.Failed - ("Incorrect result from Proc Trim - Sets, Left & Right side - 3"); - end if; - - -- Trim characters in set from Left side only. No change to Right side. - - Test_String := B10.To_Bounded_Wide_String(Translate("cccdabxyz")); - B10.Trim(Test_String, CD_Set, XY_Set); - - if Test_String /= B10.To_Bounded_Wide_String(Translate("abxyz")) then - Report.Failed - ("Incorrect result from Proc Trim for Sets, Left side only"); - end if; - - -- Trim no characters on either side of the bounded wide string. - - Test_String := AtoJ_Bnd_Str; - B10.Trim(Test_String, CD_Set, CD_Set); - - if Test_String /= AtoJ_Bnd_Str then - Report.Failed("Incorrect result from Proc Trim-Sets, Neither side"); - end if; - - - - -- Function Head with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Head(Source => AtoJ_Bnd_Str, -- max length - Count => B10.Length(AtoJ_Bnd_Str) + 1, - Pad => Translate('X')); - Report.Failed("Length_Error not raised by Function Head"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Head"); - end; - - -- Drop = Left - - -- Pad characters (5) are appended to the right end of the bounded - -- wide string (which is initially at its maximum length), then the - -- first five characters of the intermediate result are dropped to - -- conform to the maximum size limit of the bounded wide string (10). - - Result_String := - B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")), - 15, - Translate('x'), - Ada.Strings.Left); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("FGHIJxxxxx")) - then - Report.Failed("Incorrect result from Function Head, Drop = Left"); - end if; - - -- Drop = Right - - -- Pad characters (6) are appended to the left end of the bounded - -- wide string (which is initially at one less than its maximum length), - -- then the last five characters of the intermediate result are dropped - -- (which in this case are the pad characters) to conform to the - -- maximum size limit of the bounded wide string (10). - - Result_String := - B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHI")), - 15, - Translate('x'), - Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("ABCDEFGHIx")) - then - Report.Failed("Incorrect result from Function Head, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Head(B10.Null_Bounded_Wide_String, 5, Translate('a')) /= - B10.To_Bounded_Wide_String(Translate("aaaaa")) or - B10.Head(AtoE_Bnd_Str, - B10.Length(AtoE_Bnd_Str)) /= - AtoE_Bnd_Str - then - Report.Failed("Incorrect result from Function Head"); - end if; - - - - -- Function Tail with Truncation - -- Drop = Error (Default Case) - - begin - Result_String := B10.Tail(Source => AtoJ_Bnd_Str, -- max length - Count => B10.Length(AtoJ_Bnd_Str) + 1, - Pad => Ada.Strings.Wide_Space, - Drop => Ada.Strings.Error); - Report.Failed("Length_Error not raised by Function Tail"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed("Incorrect exception raised by Function Tail"); - end; - - -- Drop = Left - - -- Pad characters (5) are appended to the left end of the bounded wide - -- string (which is initially at two less than its maximum length), - -- then the first three characters of the intermediate result (in this - -- case, 3 pad characters) are dropped. - - Result_String := - B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGH")), - 13, - Translate('x'), - Ada.Strings.Left); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("xxABCDEFGH")) - then - Report.Failed("Incorrect result from Function Tail, Drop = Left"); - end if; - - -- Drop = Right - - -- Pad characters (3) are appended to the left end of the bounded wide - -- string (which is initially at its maximum length), then the last - -- three characters of the intermediate result are dropped. - - Result_String := - B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")), - 13, - Translate('x'), - Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("xxxABCDEFG")) - then - Report.Failed("Incorrect result from Function Tail, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Tail(B10.Null_Bounded_Wide_String, 3, Translate(' ')) /= - B10.To_Bounded_Wide_String(Translate(" ")) or - B10.Tail(AtoE_Bnd_Str, - B10.To_Wide_String(AtoE_Bnd_Str)'First) /= - B10.To_Bounded_Wide_String(Translate("e")) - then - Report.Failed("Incorrect result from Function Tail"); - end if; - - - - -- Function Replicate (#, Char) with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Replicate(Count => B10.Max_Length + 5, - Item => Translate('A'), - Drop => AS.Error); - Report.Failed - ("Length_Error not raised by Replicate for characters"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Replicate for characters"); - end; - - -- Drop = Left, Right - -- Since this version of Replicate uses wide character parameters, the - -- result after truncation from left or right will appear the same. - -- The result will be a 10 character bounded wide string, composed of - -- 10 "Item" wide characters. - - if B10.Replicate(Count => 20, - Item => Translate('A'), - Drop => Ada.Strings.Left) /= - B10.Replicate(15, Translate('A'), Ada.Strings.Right) - then - Report.Failed("Incorrect result from Replicate for characters - 1"); - end if; - - -- Blank-filled, 10 character bounded wide strings. - - if B10.Replicate(B10.Max_Length + 1, - Translate(' '), - Drop => Ada.Strings.Left) /= - B10.Replicate(B10.Max_Length, Ada.Strings.Wide_Space) - then - Report.Failed("Incorrect result from Replicate for characters - 2"); - end if; - - -- Additional cases. - - if B10.Replicate(0, Translate('a')) /= B10.Null_Bounded_Wide_String or - B10.Replicate(1, Translate('a')) /= - B10.To_Bounded_Wide_String(Translate("a")) - then - Report.Failed("Incorrect result from Replicate for characters - 3"); - end if; - - - - -- Function Replicate (#, String) with Truncation - -- Drop = Error (Default). - - begin - Result_String := B10.Replicate(Count => 5, -- result would be 15. - Item => Translate("abc")); - Report.Failed - ("Length_Error not raised by Replicate for wide strings"); - exception - when AS.Length_Error => null; -- Expected exception raised. - when others => - Report.Failed - ("Incorrect exception raised by Replicate for wide strings"); - end; - - -- Drop = Left - - Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Left); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("cdabcdabcd")) - then - Report.Failed - ("Incorrect result from Replicate for wide strings, Drop = Left"); - end if; - - -- Drop = Right - - Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Right); - - if Result_String /= - B10.To_Bounded_Wide_String(Translate("abcdabcdab")) then - Report.Failed - ("Incorrect result from Replicate for wide strings, Drop = Right"); - end if; - - -- Additional cases. - - if B10.Replicate(5, Translate("X")) /= - B10.To_Bounded_Wide_String(Translate("XXXXX")) or - B10.Replicate(10, "") /= - B10.Null_Bounded_Wide_String or - B10.Replicate(0, Translate("ab")) /= - B10.Null_Bounded_Wide_String - then - Report.Failed("Incorrect result from Replicate for wide strings"); - end if; - - - exception - when others => Report.Failed("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4020; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a deleted file mode 100644 index 345a77c68d0..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a +++ /dev/null @@ -1,311 +0,0 @@ --- CXA4021.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 subprograms defined in package --- Ada.Strings.Wide_Unbounded are available, and that they produce --- correct results. Specifically, check the subprograms Head, Index, --- Index_Non_Blank, Insert, Length, Overwrite, Replace_Slice, Slice, --- Tail, To_Wide_String, To_Unbounded_Wide_String, "*", "&", --- and "=", "<=", ">=". --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Wide_Unbounded for use with unbounded wide --- strings. --- The test attempts to simulate how unbounded wide strings could be used --- to simulate paragraphs of text. Modifications could be easily be --- performed using the provided subprograms (although in this test, the --- main modification performed was the addition of more text to the --- string). One would not have to worry about the formatting of the --- paragraph until it was finished and correct in content. Then, once --- all required editing is complete, the unbounded strings can be divided --- up into the appropriate lengths based on particular formatting --- requirements. The test then compares the formatted text product --- with a predefined "finished product". --- --- This test attempts to use a large number of the subprograms provided --- by package Ada.Strings.Wide_Unbounded. Often, the processing involved --- could have been performed more efficiently using a minimum number --- of the subprograms, in conjunction with loops, etc. However, for --- testing purposes, and in the interest of minimizing the number of --- tests developed, subprogram variety and feature mixing was stressed. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Report; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Unbounded; - -procedure CXA4021 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to all the Wide_Bounded - -- subprogram character and string parameters to simulate the use of non- - -- character Wide_Characters and Wide_Strings in actual practice. - -- Note: These functions do not actually return "equivalent" wide - -- characters to their character inputs, just "non-character" - -- wide characters. - - function Equiv (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Equiv; - - - function Equiv (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Equiv(Str(i)); - end loop; - return WS; - end Equiv; - -begin - - Report.Test ("CXA4021", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Unbounded are " & - "available, and that they produce correct " & - "results"); - - Test_Block: - declare - - package ASW renames Ada.Strings.Wide_Unbounded; - use type ASW.Unbounded_Wide_String; - use Ada.Strings; - - Pamphlet_Paragraph_Count : constant := 2; - Lines : constant := 4; - Line_Length : constant := 40; - - type Document_Type is array (Positive range <>) - of ASW.Unbounded_Wide_String; - - type Camera_Ready_Copy_Type is array (1..Lines) - of Wide_String (1..Line_Length); - - Pamphlet : Document_Type (1..Pamphlet_Paragraph_Count); - - Camera_Ready_Copy : Camera_Ready_Copy_Type := - (others => (others => Ada.Strings.Wide_Space)); - - TC_Finished_Product : Camera_Ready_Copy_Type := - ( 1 => Equiv("Ada is a programming language designed "), - 2 => Equiv("to support long-lived, reliable software"), - 3 => Equiv(" systems. "), - 4 => Equiv("Go with Ada! ")); - - ----- - - - procedure Enter_Text_Into_Document (Document : in out Document_Type) is - begin - - -- Fill in both "paragraphs" of the document. Each unbounded wide - -- string functions as an individual paragraph, containing an - -- unspecified number of characters. - -- Use a variety of different unbounded wide string subprograms to - -- load the data. - - Document(1) := - ASW.To_Unbounded_Wide_String(Equiv("Ada is a language")); - - -- Insert the word "programming" prior to "language". - Document(1) := - ASW.Insert(Document(1), - ASW.Index(Document(1), - Equiv("language")), - ASW.To_Wide_String(Equiv("progra") & -- Wd Str & - ASW."*"(2,Equiv('m')) & -- Wd Unbd & - Equiv("ing "))); -- Wd Str - - - -- Overwrite the word "language" with "language" + additional text. - Document(1) := - ASW.Overwrite(Document(1), - ASW.Index(Document(1), - ASW.To_Wide_String( - ASW.Tail(Document(1), 8, Equiv(' '))), - Ada.Strings.Backward), - Equiv("language designed to support long-lifed")); - - - -- Replace the word "lifed" with "lived". - Document(1) := - ASW.Replace_Slice(Document(1), - ASW.Index(Document(1), Equiv("lifed")), - ASW.Length(Document(1)), - Equiv("lived")); - - - -- Overwrite the word "lived" with "lived" + additional text. - Document(1) := - ASW.Overwrite(Document(1), - ASW.Index(Document(1), - ASW.To_Wide_String - (ASW.Tail(Document(1), 5, Equiv(' '))), - Ada.Strings.Backward), - Equiv("lived, reliable software systems.")); - - - -- Use several of the overloaded versions of "&" to form this - -- unbounded wide string. - - Document(2) := Equiv('G') & - ASW.To_Unbounded_Wide_String(Equiv("o ")) & - ASW.To_Unbounded_Wide_String(Equiv("with")) & - Equiv(' ') & - Equiv("Ada!"); - - end Enter_Text_Into_Document; - - - ----- - - - procedure Create_Camera_Ready_Copy - (Document : in Document_Type; - Camera_Copy : out Camera_Ready_Copy_Type) is - begin - -- Break the unbounded wide strings into fixed lengths. - - -- Search the first unbounded wide string for portions of text that - -- are less than or equal to the length of a wide string in the - -- Camera_Ready_Copy_Type object. - - Camera_Copy(1) := -- Take characters 1-39, - ASW.Slice(Document(1), -- and append a blank space. - 1, - ASW.Index(ASW.To_Unbounded_Wide_String - (ASW.Slice(Document(1), - 1, - Line_Length)), - Ada.Strings.Wide_Maps.To_Set(Equiv(' ')), - Ada.Strings.Inside, - Ada.Strings.Backward)) & Equiv(' '); - - Camera_Copy(2) := -- Take characters 40-79. - ASW.Slice(Document(1), - 40, - (ASW.Index_Non_Blank -- Should return 79 - (ASW.To_Unbounded_Wide_String - (ASW.Slice(Document(1), -- Slice (40..79) - 40, - 79)), - Ada.Strings.Backward) + 39)); -- Increment since - -- this slice starts - -- at 40. - - Camera_Copy(3)(1..9) := ASW.Slice(Document(1), -- Characters 80-88 - 80, - ASW.Length(Document(1))); - - - -- Break the second unbounded wide string into the appropriate - -- length. It is only twelve characters in length, so the entire - -- unbounded wide string will be placed on one string of the output - -- object. - - Camera_Copy(4)(1..ASW.Length(Document(2))) := - ASW.To_Wide_String(ASW.Head(Document(2), - ASW.Length(Document(2)))); - - end Create_Camera_Ready_Copy; - - - ----- - - - function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) - return Boolean is - begin - - -- Evaluate wide strings for equality, using the operators defined - -- in package Ada.Strings.Wide_Unbounded. The less than/greater - -- than or equal comparisons should evaluate to "equals => True". - - if ASW.To_Unbounded_Wide_String(Draft(1)) = -- "="(WUnb,WUnb) - ASW.To_Unbounded_Wide_String(Master(1)) and - ASW.To_Unbounded_Wide_String(Draft(2)) <= -- "<="(WUnb,WUnb) - ASW.To_Unbounded_Wide_String(Master(2)) and - ASW.To_Unbounded_Wide_String(Draft(3)) >= -- ">="(WUnb,WUnb) - ASW.To_Unbounded_Wide_String(Master(3)) and - ASW.To_Unbounded_Wide_String(Draft(4)) = -- "="(WUnb,WUnb) - ASW.To_Unbounded_Wide_String(Master(4)) - then - return True; - else - return False; - end if; - - end Valid_Proofread; - - - ----- - - - begin - - -- Enter text into the unbounded wide string paragraphs of the document. - - Enter_Text_Into_Document (Pamphlet); - - - -- Reformat the unbounded wide strings into fixed wide string format. - - Create_Camera_Ready_Copy (Document => Pamphlet, - Camera_Copy => Camera_Ready_Copy); - - - -- Verify the conversion process. - - if not Valid_Proofread (Draft => Camera_Ready_Copy, - Master => TC_Finished_Product) - then - Report.Failed ("Incorrect unbounded wide string processing result"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4021; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a deleted file mode 100644 index 3c649a1a294..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a +++ /dev/null @@ -1,531 +0,0 @@ --- CXA4022.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 subprograms defined in package --- Ada.Strings.Wide_Unbounded are available, and that they produce --- correct results. Specifically, check the subprograms Count, Element, --- Index, Replace_Element, To_Unbounded_Wide_String, and "&", ">", "<". --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Wide_Unbounded for use with unbounded wide --- strings. The test simulates how unbounded wide strings --- will be processed in a user environment, using the subprograms --- provided in this package. --- --- Taken in conjunction with tests CXA4021 and CXA4023, this test will --- constitute a test of the functionality contained in package --- Ada.Strings.Wide Unbounded. This test uses a variety --- of the subprograms defined in the unbounded wide string package --- in ways typical of common usage, with different combinations of --- available subprograms being used to accomplish similar --- unbounded wide string processing goals. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 08 Nov 95 SAIC Corrected accessibility level, type visibility, --- and subtest acceptance criteria problems for --- ACVC 2.0.1 --- ---! - -with Ada.Characters.Handling; -with Ada.Strings; - -package CXA40220 is - - -- The following two functions are used to translate character and string - -- values to "Wide" values. They will be applied to all the Wide_Bounded - -- subprogram character and string parameters to simulate the use of non- - -- character Wide_Characters and Wide_Strings in actual practice. - -- Note: These functions do not actually return "equivalent" wide - -- characters to their character inputs, just "non-character" - -- wide characters. - - function Equiv (Ch : Character) return Wide_Character; - - function Equiv (Str : String) return Wide_String; - - - -- Functions and access-to-subprogram value used to supply mapping - -- capability to the appropriate versions of Count, Index, and - -- Translate. - - function AB_to_US_Mapping_Function (From : Wide_Character) - return Wide_Character; - - function AB_to_Blank_Mapping_Function (From : Wide_Character) - return Wide_Character; - -end CXA40220; - -package body CXA40220 is - - function Equiv (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Equiv; - - - function Equiv (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Equiv(Str(i)); - end loop; - return WS; - end Equiv; - - - function AB_to_US_Mapping_Function (From : Wide_Character) - return Wide_Character is - UnderScore : constant Wide_Character := Equiv('_'); - begin - if From = Equiv('a') or From = Equiv('b') then - return UnderScore; - else - return From; - end if; - end AB_to_US_Mapping_Function; - - - function AB_to_Blank_Mapping_Function (From : Wide_Character) - return Wide_Character is - begin - if From = Equiv('a') or From = Equiv('b') then - return Ada.Strings.Wide_Space; - else - return From; - end if; - end AB_to_Blank_Mapping_Function; - -end CXA40220; - - -with CXA40220; -with Report; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Unbounded; - -procedure CXA4022 is -begin - - Report.Test ("CXA4022", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Unbounded are " & - "available, and that they produce correct " & - "results"); - - Test_Block: - declare - - use CXA40220; - - package ASW renames Ada.Strings.Wide_Unbounded; - use Ada.Strings; - use type Wide_Maps.Wide_Character_Set; - use type ASW.Unbounded_Wide_String; - - Test_String : ASW.Unbounded_Wide_String; - AtoE_Str : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("abcde")); - - Complete_String : ASW.Unbounded_Wide_String := - ASW."&"(ASW.To_Unbounded_Wide_String(Equiv("Incomplete")), - ASW."&"(Ada.Strings.Wide_Space, - ASW.To_Unbounded_Wide_String(Equiv("String")))); - - Incomplete_String : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String - (Equiv("ncomplete Strin")); - - Incorrect_Spelling : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("Guob Dai")); - - Magic_String : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("abracadabra")); - - Incantation : ASW.Unbounded_Wide_String := Magic_String; - - - A_Small_G : Wide_Character := Equiv('g'); - A_Small_D : Wide_Character := Equiv('d'); - - ABCD_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv("abcd")); - B_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv('b')); - CD_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv("cd")); - - CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(From => Equiv("cd"), - To => Equiv("xy")); - AB_to_YZ_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(Equiv("ab"), Equiv("yz")); - - - Matching_Letters : Natural := 0; - Location, - Total_Count : Natural := 0; - - - Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - AB_to_US_Mapping_Function'Access; - - - begin - - - -- Function "&" - - -- Prepend an 'I' and append a 'g' to the wide string. - Incomplete_String := ASW."&"(Equiv('I'), - Incomplete_String); -- Ch & W Unb - Incomplete_String := ASW."&"(Incomplete_String, - A_Small_G); -- W Unb & Ch - - if ASW."<"(Incomplete_String, Complete_String) or - ASW.">"(Incomplete_String, Complete_String) or - Incomplete_String /= Complete_String - then - Report.Failed("Incorrect result from use of ""&"" operator"); - end if; - - - - -- Function Element - - -- Last element of the unbounded wide string should be a 'g'. - if ASW.Element(Incomplete_String, ASW.Length(Incomplete_String)) /= - A_Small_G - then - Report.Failed("Incorrect result from use of Function Element - 1"); - end if; - - if ASW.Element(Incomplete_String, 2) /= - ASW.Element(ASW.Tail(Incomplete_String, 2), 1) or - ASW.Element(ASW.Head(Incomplete_String, 4), 2) /= - ASW.Element(ASW.To_Unbounded_Wide_String(Equiv("wnqz")), 2) - then - Report.Failed("Incorrect result from use of Function Element - 2"); - end if; - - - - -- Procedure Replace_Element - - -- The unbounded wide string Incorrect_Spelling starts as "Guob Dai", - -- and is transformed by the following three procedure calls to - -- "Good Day". - - ASW.Replace_Element(Incorrect_Spelling, 2, Equiv('o')); - - ASW.Replace_Element(Incorrect_Spelling, - ASW.Index(Incorrect_Spelling, B_Set), - A_Small_D); - - ASW.Replace_Element(Source => Incorrect_Spelling, - Index => ASW.Length(Incorrect_Spelling), - By => Equiv('y')); - - if Incorrect_Spelling /= - ASW.To_Unbounded_Wide_String(Equiv("Good Day")) - then - Report.Failed("Incorrect result from Procedure Replace_Element"); - end if; - - - - -- Function Index with non-Identity map. - -- Evaluate the function Index with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the index position search. - - Location := ASW.Index(Source => ASW.To_Unbounded_Wide_String - (Equiv("abcdefghij")), - Pattern => Equiv("xy"), - Going => Ada.Strings.Forward, - Mapping => CD_to_XY_Map); -- change "cd" to "xy" - - if Location /= 3 then - Report.Failed("Incorrect result from Index, non-Identity map - 1"); - end if; - - Location := ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcdabcdab")), - Equiv("yz"), - Ada.Strings.Backward, - AB_to_YZ_Map); -- change all "ab" to "yz" - - if Location /= 9 then - Report.Failed("Incorrect result from Index, non-Identity map - 2"); - end if; - - -- A couple with identity maps (default) as well. - - if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")), -- Pat = Src - Equiv("abcd")) /= 1 or - ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")), -- Pat < Src - Equiv("abcd")) /= 0 or - ASW.Index(ASW.Null_Unbounded_Wide_String, -- Src = Null - Equiv("abc")) /= 0 - then - Report.Failed - ("Incorrect result from Index with wide string patterns"); - end if; - - - - -- Function Index (for Sets). - -- This version of Index uses Sets as the basis of the search. - - -- Test = Inside, Going = Forward (Default case). - Location := - ASW.Index(Source => ASW.To_Unbounded_Wide_String(Equiv("abcdeabcde")), - Set => CD_Set); -- set containing 'c' and 'd' - - if not (Location = 3) then -- position of first 'c' in source. - Report.Failed("Incorrect result from Index using Sets - 1"); - end if; - - -- Test = Inside, Going = Backward. - Location := - ASW.Index(Source => ASW."&"(AtoE_Str, AtoE_Str), - Set => CD_Set, -- set containing 'c' and 'd' - Test => Ada.Strings.Inside, - Going => Ada.Strings.Backward); - - if not (Location = 9) then -- position of last 'd' in source. - Report.Failed("Incorrect result from Index using Sets - 2"); - end if; - - -- Test = Outside, Going = Forward, Backward - if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")), - Wide_Maps.To_Set(Equiv("xydcgf")), - Test => Ada.Strings.Outside, - Going => Ada.Strings.Forward) /= 2 or - ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")), - Wide_Maps.To_Set(Equiv("xydcgf")), - Test => Ada.Strings.Outside, - Going => Ada.Strings.Backward) /= 5 or - ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")), - CD_Set, - Ada.Strings.Outside, - Ada.Strings.Backward) /= 5 - then - Report.Failed("Incorrect result from Index using Sets - 3"); - end if; - - -- Default direction (forward) and mapping (identity). - - if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("cd")), -- Source = Set - CD_Set) /= 1 or - ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("c")), -- Source < Set - CD_Set) /= 1 or - ASW.Index(ASW.Null_Unbounded_Wide_String, -- Source = Null - CD_Set) /= 0 or - ASW.Index(AtoE_Str, - Wide_Maps.Null_Set) /= 0 or -- Null set - ASW.Index(AtoE_Str, - Wide_Maps.To_Set(Equiv('x'))) /= 0 -- No match. - then - Report.Failed("Incorrect result from Index using Sets - 4"); - end if; - - - - -- Function Index using access-to-subprogram mapping. - -- Evaluate the function Index with an access value that supplies the - -- mapping function for this version of Index. - - Map_Ptr := AB_to_US_Mapping_Function'Access; - - Location := ASW.Index(Source => ASW.To_Unbounded_Wide_String - (Equiv("xAxabbxax xaax _cx")), - Pattern => Equiv("_x"), - Going => Ada.Strings.Forward, - Mapping => Map_Ptr); -- change 'a'or 'b' to '_' - - if Location /= 6 then -- location of "bx" substring - Report.Failed("Incorrect result from Index, access value map - 1"); - end if; - - Map_Ptr := AB_to_Blank_Mapping_Function'Access; - - Location := ASW.Index(ASW.To_Unbounded_Wide_String - (Equiv("ccacdcbbcdacc")), - Equiv("cd "), - Ada.Strings.Backward, - Map_Ptr); -- change 'a' or 'b' to ' ' - - if Location /= 9 then - Report.Failed("Incorrect result from Index, access value map - 2"); - end if; - - if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")), - Equiv(" cd"), - Ada.Strings.Forward, - Map_Ptr) /= 1 or - ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")), - Equiv(" c "), -- No match - Ada.Strings.Backward, - Map_Ptr) /= 0 - then - Report.Failed("Incorrect result from Index, access value map - 3"); - end if; - - - - -- Function Count - - -- Determine the number of characters in the unbounded wide string that - -- are contained in the set. - - Matching_Letters := ASW.Count(Source => Magic_String, - Set => ABCD_Set); - - if Matching_Letters /= 9 then - Report.Failed - ("Incorrect result from Function Count with Set parameter"); - end if; - - -- Determine the number of occurrences of the following pattern wide - -- strings in the unbounded wide string Magic_String. - - if ASW.Count(Magic_String, Equiv("ab")) /= - (ASW.Count(Magic_String, Equiv("ac")) + - ASW.Count(Magic_String, Equiv("ad"))) or - ASW.Count(Magic_String, Equiv("ab")) /= 2 - then - Report.Failed - ("Incorrect result from Function Count, wide string parameter"); - end if; - - - - -- Function Count with non-Identity mapping. - -- Evaluate the function Count with a non-identity map - -- parameter which will cause mapping of the source parameter - -- prior to the evaluation of the number of matching patterns. - - Total_Count := - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abbabbabbabba")), - Pattern => Equiv("yz"), - Mapping => AB_to_YZ_Map); - - if Total_Count /= 4 then - Report.Failed - ("Incorrect result from function Count, non-Identity map - 1"); - end if; - - if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ADCBADABCD")), - Equiv("AB"), - Wide_Maps.To_Mapping(Equiv("CD"), Equiv("AB"))) /= 5 or - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("dcccddcdccdddccccd")), - Equiv("xxy"), - CD_to_XY_Map) /= 3 - then - Report.Failed - ("Incorrect result from function Count, non-Identity map - 2"); - end if; - - -- And a few with identity Wide_Maps as well. - - if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ABABABABAB")), - Equiv("ABA"), - Wide_Maps.Identity) /= 2 or - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")), - Equiv("aaa")) /= 3 or - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")), -- Src < Pat - Equiv("XXX"), - Wide_Maps.Identity) /= 0 or - ASW.Count(AtoE_Str, -- Source = Pattern - Equiv("abcde")) /= 1 or - ASW.Count(ASW.Null_Unbounded_Wide_String, -- Source = Null - Equiv(" ")) /= 0 - then - Report.Failed - ("Incorrect result from function Count, w,w/o mapping"); - end if; - - - - -- Function Count using access-to-subprogram mapping. - -- Evaluate the function Count with an access value specifying the - -- mapping that is going to occur to Source. - - Map_Ptr := AB_to_US_Mapping_Function'Access; - - Total_Count := - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abcbacbadbaAbbB")), - Pattern => Equiv("__"), - Mapping => Map_Ptr); -- change 'a' and 'b' to '_' - - if Total_Count /= 5 then - Report.Failed - ("Incorrect result from function Count, access value map - 1"); - end if; - - Map_Ptr := AB_to_Blank_Mapping_Function'Access; - - if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("cccaccBcbcaccacAc")), - Equiv("c c"), - Map_Ptr) /= 3 or - ASW.Count(ASW.To_Unbounded_Wide_String - (Equiv("aBBAAABaBBBBAaBABBABaBBbBB")), - Equiv(" BB"), - Map_Ptr) /= 4 or - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")), - Equiv(" "), - Map_Ptr) /= 3 or - ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")), -- Src < Pat - Equiv("XX "), - Map_Ptr) /= 0 or - ASW.Count(AtoE_Str, -- Source'Length = Pattern'Length - Equiv(" cde"), - Map_Ptr) /= 1 - then - Report.Failed - ("Incorrect result from function Count, access value map - 3"); - end if; - - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4022; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a deleted file mode 100644 index d0325fc88ec..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a +++ /dev/null @@ -1,585 +0,0 @@ --- CXA4023.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 subprograms defined in package --- Ada.Strings.Wide_Unbounded are available, and that they produce --- correct results. Specifically, check the subprograms Delete, --- Find_Token, Translate, Trim, and "*". --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Wide_Unbounded for use with unbounded wide --- strings. The test simulates how unbounded wide strings --- will be processed in a user environment, using the subprograms --- provided in this package. --- --- This test, when taken in conjunction with tests CXA4021-22, will --- constitute a test of the functionality contained in package --- Ada.Strings.Wide_Unbounded. This test uses a variety --- of the subprograms defined in the unbounded wide string package --- in ways typical of common usage, with different combinations of --- available subprograms being used to accomplish similar --- unbounded wide string processing goals. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 08 Nov 95 SAIC Corrected accessibility level and type --- visibility problems for ACVC 2.0.1. --- ---! - -with Ada.Characters.Handling; -with Ada.Strings; - -package CXA40230 is - - -- The following two functions are used to translate character and string - -- values to non-character "Wide" values. They will be applied to all the - -- Wide_Bounded subprogram character and string parameters to simulate the - -- use of Wide_Characters and Wide_Strings in actual practice. - -- Note: These functions do not actually return "equivalent" wide - -- characters to their character inputs, just "non-character" - -- wide characters. - - function Equiv (Ch : Character) return Wide_Character; - - function Equiv (Str : String) return Wide_String; - - -- Functions and access-to-subprogram object used to supply mapping - -- capability to the appropriate versions of Translate. - - function AB_to_US_Mapping_Function (From : Wide_Character) - return Wide_Character; - - function AB_to_Blank_Mapping_Function (From : Wide_Character) - return Wide_Character; - -end CXA40230; - - -package body CXA40230 is - - function Equiv (Ch : Character) return Wide_Character is - C : Character := Ch; - begin - if Ch = ' ' then - return Ada.Characters.Handling.To_Wide_Character(C); - else - return Wide_Character'Val(Character'Pos(Ch) + - Character'Pos(Character'Last) + 1); - end if; - end Equiv; - - - function Equiv (Str : String) return Wide_String is - WS : Wide_String(Str'First..Str'Last); - begin - for i in Str'First..Str'Last loop - WS(i) := Equiv(Str(i)); - end loop; - return WS; - end Equiv; - - - function AB_to_US_Mapping_Function (From : Wide_Character) - return Wide_Character is - UnderScore : constant Wide_Character := Equiv('_'); - begin - if From = Equiv('a') or From = Equiv('b') then - return UnderScore; - else - return From; - end if; - end AB_to_US_Mapping_Function; - - - function AB_to_Blank_Mapping_Function (From : Wide_Character) - return Wide_Character is - begin - if From = Equiv('a') or From = Equiv('b') then - return Ada.Strings.Wide_Space; - else - return From; - end if; - end AB_to_Blank_Mapping_Function; - -end CXA40230; - - -with CXA40230; -with Report; -with Ada.Characters.Handling; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Unbounded; - -procedure CXA4023 is -begin - - Report.Test ("CXA4023", "Check that the subprograms defined in " & - "package Ada.Strings.Wide_Unbounded are " & - "available, and that they produce correct " & - "results"); - - Test_Block: - declare - - use CXA40230; - - package ASW renames Ada.Strings.Wide_Unbounded; - use Ada.Strings; - use type Wide_Maps.Wide_Character_Set; - use type ASW.Unbounded_Wide_String; - - Test_String : ASW.Unbounded_Wide_String; - AtoE_Str : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("abcde")); - - Cad_String : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("cad")); - - Magic_String : ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("abracadabra")); - - Incantation : ASW.Unbounded_Wide_String := Magic_String; - - - A_Small_G : Wide_Character := Equiv('g'); - - ABCD_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv("abcd")); - B_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv('b')); - AB_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps."OR"(Wide_Maps.To_Set(Equiv('a')), B_Set); - - - AB_to_YZ_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(From => Equiv("ab"), - To => Equiv("yz")); - Code_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(Equiv("abcd"), Equiv("wxyz")); - Reverse_Code_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(Equiv("wxyz"), Equiv("abcd")); - Non_Existent_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(Equiv("jkl"), Equiv("mno")); - - - Token_Start : Positive; - Token_End : Natural := 0; - - Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - AB_to_US_Mapping_Function'Access; - - - begin - - -- Find_Token - - ASW.Find_Token(Magic_String, -- Find location of first "ab" equiv. - AB_Set, -- Should be (1..2). - Ada.Strings.Inside, - Token_Start, - Token_End); - - if Natural(Token_Start) /= ASW.To_Wide_String(Magic_String)'First or - Token_End /= ASW.Index(Magic_String, B_Set) or - Token_End /= 2 - then - Report.Failed("Incorrect result from Procedure Find_Token - 1"); - end if; - - - ASW.Find_Token(Source => Magic_String, -- Find location of char 'r'equiv - Set => ABCD_Set, -- in wide str, should be (3..3) - Test => Ada.Strings.Outside, - First => Token_Start, - Last => Token_End); - - if Natural(Token_Start) /= 3 or Token_End /= 3 then - Report.Failed("Incorrect result from Procedure Find_Token - 2"); - end if; - - - ASW.Find_Token(Magic_String, -- No 'g' "equivalent in - Wide_Maps.To_Set(A_Small_G), -- the wide str, so the - Ada.Strings.Inside, -- result params should be - First => Token_Start, -- First = Source'First and - Last => Token_End); -- Last = 0. - - - if Token_Start /= ASW.To_Wide_String(Magic_String)'First or - Token_End /= 0 - then - Report.Failed("Incorrect result from Procedure Find_Token - 3"); - end if; - - - ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")), - Wide_Maps.To_Set(Equiv("trpq")), - Ada.Strings.Inside, - Token_Start, - Token_End); - - if Token_Start /= 3 or - Token_End /= 10 - then - Report.Failed("Incorrect result from Procedure Find_Token - 4"); - end if; - - ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")), - Wide_Maps.To_Set(Equiv("abpq")), - Ada.Strings.Outside, - Token_Start, - Token_End); - - if Token_Start /= 7 or - Token_End /= 11 - then - Report.Failed("Incorrect result from Procedure Find_Token - 5"); - end if; - - - - -- Translate - - -- Use a mapping ("abcd" -> "wxyz") to transform the contents of - -- the unbounded wide string. - -- Magic_String = "abracadabra" - - Incantation := ASW.Translate(Magic_String, Code_Map); - - if Incantation /= - ASW.To_Unbounded_Wide_String(Equiv("wxrwywzwxrw")) - then - Report.Failed("Incorrect result from Function Translate - 1"); - end if; - - -- (Note: See below for additional testing of Function Translate) - - -- Use the inverse mapping of the one above to return the "translated" - -- unbounded wide string to its original form. - - ASW.Translate(Incantation, Reverse_Code_Map); - - -- The map contained in the following call to Translate contains three - -- elements, and these elements are not found in the unbounded wide - -- string, so this call to Translate should have no effect on it. - - if Incantation /= ASW.Translate(Magic_String, Non_Existent_Map) then - Report.Failed("Incorrect result from Procedure Translate - 1"); - end if; - - -- Partial mapping of source. - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("abcdeabcab")); - - ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyz")) then - Report.Failed("Incorrect result from Procedure Translate - 2"); - end if; - - -- Total mapping of source. - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbaaababb")); - - ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzz")) then - Report.Failed("Incorrect result from Procedure Translate - 3"); - end if; - - -- No mapping of source. - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")); - - ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map); - - if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")) then - Report.Failed("Incorrect result from Procedure Translate - 4"); - end if; - - -- Map > 2 characters, partial mapping. - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("opabcdelmn")); - - ASW.Translate(Test_String, - Wide_Maps.To_Mapping(Equiv("abcde"), Equiv("lmnop"))); - - if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("oplmnoplmn")) then - Report.Failed("Incorrect result from Procedure Translate - 5"); - end if; - - - - -- Various degrees of mapping of source (full, partial, none) used - -- with Function Translate. - - if ASW.Translate( - ASW.To_Unbounded_Wide_String(Equiv("abcdeabcabbbaaacaa")), - AB_to_YZ_Map) /= - ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyzzzyyycyy")) or - - ASW.Translate( - ASW.To_Unbounded_Wide_String(Equiv("abbaaababbaaaaba")), - AB_to_YZ_Map) /= - ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzzyyyyzy")) or - - ASW.Translate(ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc")), - Mapping => AB_to_YZ_Map) /= - ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc")) or - - ASW.Translate(ASW.To_Unbounded_Wide_String("opabcdelmnddeaccabec"), - Wide_Maps.To_Mapping("abcde", "lmnop")) /= - ASW.To_Unbounded_Wide_String("oplmnoplmnooplnnlmpn") - then - Report.Failed("Incorrect result from Function Translate - 2"); - end if; - - - - -- Procedure Translate using access-to-subprogram mapping. - -- Partial mapping of source. - - Map_Ptr := AB_to_Blank_Mapping_Function'Access; - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("abABaABbaBAbba")); - - ASW.Translate(Source => Test_String, -- change equivalent of 'a' and - Mapping => Map_Ptr); -- 'b' to ' ' - - if Test_String /= - ASW.To_Unbounded_Wide_String(Equiv(" AB AB BA ")) - then - Report.Failed - ("Incorrect result from Proc Translate, w/ access value map - 1"); - end if; - - -- Total mapping of source to blanks. - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbbab")); - - ASW.Translate(Source => Test_String, - Mapping => Map_Ptr); - - if Test_String /= - ASW.To_Unbounded_Wide_String(Equiv(" ")) - then - Report.Failed - ("Incorrect result from Proc Translate, w/ access value map - 2"); - end if; - - -- No mapping of source. - - Map_Ptr := AB_to_US_Mapping_Function'Access; - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")); - - ASW.Translate(Source => Test_String, - Mapping => Map_Ptr); - - if Test_String /= - ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")) -- no change - then - Report.Failed - ("Incorrect result from Proc Translate, w/ access value map - 3"); - end if; - - - -- Function Translate using access-to-subprogram mapping value. - - Map_Ptr := AB_to_Blank_Mapping_Function'Access; - - Test_String := ASW.To_Unbounded_Wide_String(Equiv("abAbBBAabbacD")); - - if ASW.Translate(ASW.Translate(Test_String, Map_Ptr), Map_Ptr) /= - ASW.To_Unbounded_Wide_String(Equiv(" A BBA cD")) - then - Report.Failed - ("Incorrect result from Function Translate, access value map - 1"); - end if; - - if ASW.Translate(Source => ASW.To_Unbounded_Wide_String(Equiv("a")), - Mapping => Map_Ptr) /= - ASW.To_Unbounded_Wide_String(Equiv(" ")) or - ASW.Translate(ASW.To_Unbounded_Wide_String - (Equiv(" aa Aa A AAaaa a aA")), - Map_Ptr) /= - ASW.To_Unbounded_Wide_String(Equiv(" A A AA A")) or - ASW.Translate(Source => ASW.To_Unbounded_Wide_String(Equiv("a ")), - Mapping => Map_Ptr) /= - ASW.To_Unbounded_Wide_String(Equiv(" ")) or - ASW.Translate(Source => ASW.To_Unbounded_Wide_String(Equiv("xyz")), - Mapping => Map_Ptr) /= - ASW.To_Unbounded_Wide_String(Equiv("xyz")) - then - Report.Failed - ("Incorrect result from Function Translate, access value map - 2"); - end if; - - - - -- Trim - - Trim_Block: - declare - - XYZ_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv("xyz")); - PQR_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Equiv("pqr")); - - Pad : constant ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("Pad")); - - The_New_Ada : constant ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("Ada9X")); - - Space_Array : array (1..4) of ASW.Unbounded_Wide_String := - (ASW.To_Unbounded_Wide_String(Equiv(" Pad ")), - ASW.To_Unbounded_Wide_String(Equiv("Pad ")), - ASW.To_Unbounded_Wide_String(Equiv(" Pad")), - Pad); - - String_Array : array (1..5) of ASW.Unbounded_Wide_String := - (ASW.To_Unbounded_Wide_String(Equiv("xyzxAda9Xpqr")), - ASW.To_Unbounded_Wide_String(Equiv("Ada9Xqqrp")), - ASW.To_Unbounded_Wide_String(Equiv("zxyxAda9Xqpqr")), - ASW.To_Unbounded_Wide_String(Equiv("xxxyAda9X")), - The_New_Ada); - - begin - - -- Examine the version of Trim that removes blanks from - -- the left and/or right of a wide string. - - for i in 1..4 loop - if ASW.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then - Report.Failed("Incorrect result from Trim for spaces - " & - Integer'Image(i)); - end if; - end loop; - - -- Examine the version of Trim that removes set characters from - -- the left and right of a wide string. - - for i in 1..5 loop - if ASW.Trim(String_Array(i), - Left => XYZ_Set, - Right => PQR_Set) /= The_New_Ada then - Report.Failed - ("Incorrect result from Trim for set characters - " & - Integer'Image(i)); - end if; - end loop; - - -- No trimming. - - if ASW.Trim( - ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz")), - XYZ_Set, - PQR_Set) /= - ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz")) - then - Report.Failed - ("Incorrect result from Trim for set, no trimming"); - end if; - - end Trim_Block; - - - - -- Delete - - -- Use the Delete function to remove the first four and last four - -- characters from the wide string. - - if ASW.Delete(Source => ASW.Delete(Magic_String, - 8, - ASW.Length(Magic_String)), - From => ASW.To_Wide_String(Magic_String)'First, - Through => 4) /= - Cad_String - then - Report.Failed("Incorrect results from Function Delete"); - end if; - - - - -- Constructors ("*") - - Constructor_Block: - declare - - SOS : ASW.Unbounded_Wide_String; - - Dot : constant ASW.Unbounded_Wide_String := - ASW.To_Unbounded_Wide_String(Equiv("Dot_")); - Dash : constant Wide_String := Equiv("Dash_"); - - Distress : ASW.Unbounded_Wide_String := - ASW."&"(ASW.To_Unbounded_Wide_String - (Equiv("Dot_Dot_Dot_")), - ASW."&"(ASW.To_Unbounded_Wide_String - (Equiv("Dash_Dash_Dash_")), - ASW.To_Unbounded_Wide_String - (Equiv("Dot_Dot_Dot")))); - - Repeat : constant Natural := 3; - Separator : constant Wide_Character := Equiv('_'); - - Separator_Set : Wide_Maps.Wide_Character_Set := - Wide_Maps.To_Set(Separator); - - begin - - -- Use the following constructor forms to construct the wide string - -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot". Note that the - -- trailing underscore in the wide string is removed in the call to - -- Trim in the If statement condition. - - SOS := ASW."*"(Repeat, Dot); -- "*"(#, W Unb Str) - - SOS := ASW."&"(SOS, - ASW."&"(ASW."*"(Repeat, Dash), -- "*"(#, W Str) - ASW."*"(Repeat, Dot))); -- "*"(#, W Unb Str) - - if ASW.Trim(SOS, Wide_Maps.Null_Set, Separator_Set) /= Distress then - Report.Failed("Incorrect results from Function ""*"""); - end if; - - end Constructor_Block; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4023; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a deleted file mode 100644 index 1b0af9ce978..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a +++ /dev/null @@ -1,350 +0,0 @@ --- CXA4024.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 "-", To_Ranges, To_Domain, and To_Range are --- available in the package Ada.Strings.Maps, and that they produce --- correct results based on the Character_Set/Character_Mapping input --- provided. --- --- TEST DESCRIPTION: --- This test examines the operation of four functions from within the --- Ada.Strings.Maps package. A variety of Character_Sequence, --- Character_Set, and Character_Mapping objects are created and --- initialized for use with these functions. In each subtest of --- function operation, specific inputs are provided to the functions as --- input parameters, and the results are evaluated against expected --- values. Wherever appropriate, additional characteristics of the --- function results are verified against the prescribed result --- characteristics. --- --- --- CHANGE HISTORY: --- 03 Feb 95 SAIC Initial prerelease version --- 10 Mar 95 SAIC Incorporated reviewer comments. --- 15 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 05 Oct 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -with Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; -with Ada.Characters.Latin_1; -with Report; - -procedure CXA4024 is - -begin - - Report.Test ("CXA4024", "Check that the function ""-"", To_Ranges, " & - "To_Domain, and To_Range are available in " & - "the package Ada.Strings.Maps, and that " & - "they produce correct results"); - - Test_Block: - declare - - use Ada.Strings, Ada.Strings.Maps; - use type Maps.Character_Set; -- To allow logical set operator - -- infix notation. - package ACL1 renames Ada.Characters.Latin_1; - - MidPoint_Letter : constant := 13; - Last_Letter : constant := 26; - - Vowels : constant Maps.Character_Sequence := "aeiou"; - Quasi_Vowel : constant Character := 'y'; - - Alphabet : Maps.Character_Sequence (1..Last_Letter); - Half_Alphabet : Maps.Character_Sequence (1..MidPoint_Letter); - - Alphabet_Set, - Consonant_Set, - Vowel_Set, - First_Half_Set, - Second_Half_Set : Maps.Character_Set; - - - begin - - -- Load the alphabet strings for use in creating sets. - for i in 0..12 loop - Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i); - end loop; - - for i in 0..25 loop - Alphabet(i+1) := Character'Val(Character'Pos('a') + i); - end loop; - - -- Initialize a series of Character_Set objects. - - Alphabet_Set := Maps.To_Set(Alphabet); - Vowel_Set := Maps.To_Set(Vowels); - Consonant_Set := Vowel_Set XOR Alphabet_Set; - First_Half_Set := Maps.To_Set(Half_Alphabet); - Second_Half_Set := Alphabet_Set XOR First_Half_Set; - - - - -- Evaluation of Set operator "-". - - if Consonant_Set /= "-"(Alphabet_Set, Vowel_Set) or - Vowel_Set /= (Alphabet_Set - Consonant_Set) or - Alphabet_Set /= Alphabet_Set - Maps.Null_Set or - First_Half_Set /= "-"(Alphabet_Set, Second_Half_Set) or - (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) - then - Report.Failed("Incorrect result from ""-"" operator for sets"); - end if; - - - - -- Evaluation of Function "To_Ranges". - - declare - - use type Maps.Character_Range; - use type Maps.Character_Ranges; - - Set_A_to_C : Maps.Character_Set := Maps.To_Set("ABC"); - Set_J : Maps.Character_Set := Maps.To_Set("J"); - Set_M_to_P : Maps.Character_Set := Maps.To_Set("MNOP"); - Set_X_to_Z : Maps.Character_Set := Maps.To_Set("XYZ"); - Set_Of_Five : Maps.Character_Set := Set_A_to_C OR -- Union of the - Set_M_to_P OR -- five sets. - Set_X_to_Z OR - Set_J OR - Maps.Null_Set; - - TC_Range_A_to_C : Maps.Character_Range := (Low => 'A', High => 'C'); - TC_Range_J : Maps.Character_Range := ('J', 'J'); - TC_Range_M_to_P : Maps.Character_Range := ('M', 'P'); - TC_Range_X_to_Z : Maps.Character_Range := (Low => 'X', High => 'Z'); - - TC_Ranges : Maps.Character_Ranges (1..4) := - (1 => TC_Range_A_to_C, - 2 => TC_Range_J, - 3 => TC_Range_M_to_P, - 4 => TC_Range_X_to_Z); - - begin - - -- Based on input of a set containing four separate "spans" of - -- character sequences, Function To_Ranges is required to produce - -- the shortest array of contiguous ranges of Character values in - -- the input set, in increasing order of Low. - - declare - - -- This Character_Ranges constant should consist of array - -- components, each component being a Character_Range from Low - -- to High containing the appropriate characters. - - Ranges_Result : constant Maps.Character_Ranges := - Maps.To_Ranges(Set => Set_Of_Five); - begin - - -- Check the structure and components of the Character_Ranges - -- constant. - - if Ranges_Result(1) /= TC_Range_A_to_C or - Ranges_Result(1).Low /= TC_Ranges(1).Low or - Ranges_Result(2) /= TC_Range_J or - Ranges_Result(2).High /= TC_Ranges(2).High or - Ranges_Result(3) /= TC_Range_M_to_P or - Ranges_Result(3).Low /= TC_Ranges(3).Low or - Ranges_Result(3).High /= TC_Ranges(3).High or - Ranges_Result(4) /= TC_Range_X_To_Z or - Ranges_Result(4).Low /= TC_Ranges(4).Low or - Ranges_Result(4).High /= TC_Ranges(4).High - then - Report.Failed ("Incorrect structure or components in " & - "Character_Ranges constant"); - end if; - - exception - when others => - Report.Failed("Exception raised using the Function To_Ranges " & - "to initialize a Character_Ranges constant"); - end; - end; - - - - -- Evaluation of Functions To_Domain and To_Range. - - declare - - Null_Sequence : constant Maps.Character_Sequence := ""; - - TC_Upper_Case_Sequence : constant Maps.Character_Sequence := - "ZYXWVUTSRQPONMABCDEFGHIJKL"; - TC_Lower_Case_Sequence : constant Maps.Character_Sequence := - "zyxwvutsrqponmabcdefghijkl"; - TC_Unordered_Sequence : Maps.Character_Sequence(1..6) := - "BxACzy"; - - TC_Upper_to_Lower_Map : Maps.Character_Mapping := - Maps.To_Mapping(TC_Upper_Case_Sequence, - TC_Lower_Case_Sequence); - - TC_Lower_to_Upper_Map : Maps.Character_Mapping := - Maps.To_Mapping(TC_Lower_Case_Sequence, - TC_Upper_Case_Sequence); - - TC_Unordered_Map : Maps.Character_Mapping := - Maps.To_Mapping(TC_Unordered_Sequence, - "ikglja"); - begin - - declare - - TC_Domain_1 : constant Maps.Character_Sequence := - Maps.To_Domain(TC_Upper_to_Lower_Map); - - TC_Domain_2 : constant Maps.Character_Sequence := - Maps.To_Domain(TC_Lower_to_Upper_Map); - - TC_Domain_3 : Maps.Character_Sequence(1..6); - - TC_Range_1 : constant Maps.Character_Sequence := - Maps.To_Range(TC_Upper_to_Lower_Map); - - TC_Range_2 : constant Maps.Character_Sequence := - Maps.To_Range(TC_Lower_to_Upper_Map); - - TC_Range_3 : Maps.Character_Sequence(1..6); - - begin - - -- Function To_Domain returns the shortest Character_Sequence - -- value such that each character not in the result maps to - -- itself, and all characters in the result are in ascending - -- order. - - TC_Domain_3 := Maps.To_Domain(TC_Unordered_Map); - - -- Check contents of result of To_Domain, must be in ascending - -- order. - - if TC_Domain_1 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then - Report.Failed("Incorrect result from To_Domain with " & - "TC_Upper_to_Lower_Map as input"); - end if; - - if TC_Domain_2 /= "abcdefghijklmnopqrstuvwxyz" then - Report.Failed("Incorrect result from To_Domain with " & - "TC_Lower_to_Upper_Map as input"); - end if; - - if TC_Domain_3 /= "ABCxyz" then - Report.Failed("Incorrect result from To_Domain with " & - "an unordered mapping as input"); - end if; - - - -- The lower bound on the returned Character_Sequence value - -- from To_Domain must be 1. - - if TC_Domain_1'First /= 1 or - TC_Domain_2'First /= 1 or - TC_Domain_3'First /= 1 - then - Report.Failed("Incorrect lower bound returned from To_Domain"); - end if; - - - -- Check contents of result of To_Range. - - TC_Range_3 := Maps.To_Range(TC_Unordered_Map); - - if TC_Range_1 /= "abcdefghijklmnopqrstuvwxyz" then - Report.Failed("Incorrect result from To_Range with " & - "TC_Upper_to_Lower_Map as input"); - end if; - - if TC_Range_2 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then - Report.Failed("Incorrect result from To_Range with " & - "TC_Lower_to_Upper_Map as input"); - end if; - - if TC_Range_3 /= "gilkaj" then - Report.Failed("Incorrect result from To_Range with " & - "an unordered mapping as input"); - end if; - - - -- The lower bound on the returned Character_Sequence value - -- must be 1. - - if TC_Range_1'First /= 1 or - TC_Range_2'First /= 1 or - TC_Range_3'First /= 1 - then - Report.Failed("Incorrect lower bound returned from To_Range"); - end if; - - - -- The upper bound on the returned Character_Sequence value - -- must be Map'Length. - - if TC_Range_1'Last /= TC_Lower_Case_Sequence'Length or - TC_Range_2'Last /= TC_Upper_Case_Sequence'Length or - TC_Range_3'Last /= TC_Unordered_Sequence'Length - then - Report.Failed("Incorrect upper bound returned from To_Range"); - end if; - - end; - - -- Both function To_Domain and To_Range return the null string - -- when provided the Identity character map as an input parameter. - - if Maps.To_Domain(Maps.Identity) /= Null_Sequence then - Report.Failed("Function To_Domain did not return the null " & - "string when provided the Identity map as " & - "input"); - end if; - - if Maps.To_Range(Maps.Identity) /= Null_Sequence then - Report.Failed("Function To_Range did not return the null " & - "string when provided the Identity map as " & - "input"); - end if; - - exception - when others => - Report.Failed("Exception raised during the evaluation of " & - "Function To_Domain and To_Range"); - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4024; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a deleted file mode 100644 index 1665f7a46e8..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a +++ /dev/null @@ -1,376 +0,0 @@ --- CXA4025.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 found in packages Ada.Strings.Wide_Maps, --- Ada.Strings.Wide_Fixed, and Ada.Strings.Wide_Maps.Wide_Constants --- is available and produces correct results. --- --- TEST DESCRIPTION: --- This test validates the subprograms found in the various Wide_Map --- and Wide_String packages. It is based on the tests CXA4024 and --- CXA4026, which are tests for the complementary "non-wide" packages. --- --- The functions found in CXA4025_0 provide mapping capability, when --- used in conjunction with Wide_Character_Mapping_Function objects. --- --- --- CHANGE HISTORY: --- 23 Jun 95 SAIC Initial prerelease version. --- 15 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -package CXA4025_0 is - -- Functions used to supply mapping capability. - function Map_To_Lower_Case (From : Wide_Character) return Wide_Character; - function Map_To_Upper_Case (From : Wide_Character) return Wide_Character; -end CXA4025_0; - -with Ada.Characters.Handling; -package body CXA4025_0 is - -- Function Map_To_Lower_Case will return the lower case form of - -- Wide_Characters in the range 'A'..'Z' only, and return the input - -- wide_character otherwise. - - function Map_To_Lower_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Lower( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Lower_Case; - - -- Function Map_To_Upper_Case will return the upper case form of - -- Wide_Characters in the range 'a'..'z', or whose position is in one - -- of the ranges 223..246 or 248..255, provided the wide_character has - -- an upper case form. - - function Map_To_Upper_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Upper( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Upper_Case; - -end CXA4025_0; - - -with CXA4025_0; -with Report; -with Ada.Characters.Handling; -with Ada.Characters.Latin_1; -with Ada.Exceptions; -with Ada.Strings; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Maps.Wide_Constants; -with Ada.Strings.Wide_Fixed; - -procedure CXA4025 is -begin - Report.Test ("CXA4025", - "Check that subprograms defined in packages " & - "Ada.Strings.Wide_Maps and Ada.Strings.Wide_Fixed " & - "produce correct results"); - - Test_Block: - declare - - package ACL1 renames Ada.Characters.Latin_1; - - use Ada.Characters, Ada.Strings; - use Ada.Exceptions; - use type Wide_Maps.Wide_Character_Set; - - subtype LC_Characters is Wide_Character range 'a'..'z'; - - Last_Letter : constant := 26; - Vowels : constant Wide_Maps.Wide_Character_Sequence := "aeiou"; - TC_String : constant Wide_String := "A Standard String"; - - Alphabet : Wide_Maps.Wide_Character_Sequence (1..Last_Letter); - Alphabet_Set, - Consonant_Set, - Vowel_Set : Wide_Maps.Wide_Character_Set; - - String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" & - String_20; - String_80 : Wide_String(1..80) := String_40 & String_40; - TC_String_5 : Wide_String(1..5) := "ABCDE"; - - -- The following strings are used in examination of the Translation - -- subprograms. - New_Character_String : Wide_String(1..12) := - Handling.To_Wide_String( - ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong & - ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex & - ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde & - ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn & - ACL1.LC_German_Sharp_S & ACL1.LC_Y_Diaeresis); - - -- Note that there is no upper case version of the last two - -- characters from above. - - TC_New_Character_String : Wide_String(1..12) := - Handling.To_Wide_String( - ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong & - ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex & - ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde & - ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn & - ACL1.LC_German_Sharp_S & ACL1.LC_Y_Diaeresis); - - -- Access objects that will be provided as parameters to the - -- subprograms. - Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4025_0.Map_To_Lower_Case'Access; - Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4025_0.Map_To_Upper_Case'Access; - - begin - - -- - -- Testing of functionality found in Package Ada.Strings.Wide_Maps. - -- - - -- Load the alphabet strings for use in creating sets. - for i in 0..25 loop - Alphabet(i+1) := Wide_Character'Val(Wide_Character'Pos('a')+i); - end loop; - - -- Initialize a series of Character_Set objects. - Alphabet_Set := Wide_Maps.To_Set(Alphabet); - Vowel_Set := Wide_Maps.To_Set(Vowels); - Consonant_Set := Vowel_Set XOR Alphabet_Set; - - -- Evaluation of Set operator "-". - if - (Alphabet_Set - Consonant_Set) /= - "AND"(Alphabet_Set, "NOT"(Consonant_Set)) or - (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) - then - Report.Failed("Incorrect result from ""-"" operator for sets"); - end if; - - -- Evaluation of Functions To_Domain and To_Range. - declare - Null_Sequence : constant Wide_Maps.Wide_Character_Sequence := ""; - TC_UC_Sequence : constant Wide_Maps.Wide_Character_Sequence := - "ZYXWVUTSRQPONMABCDEFGHIJKL"; - TC_LC_Sequence : constant Wide_Maps.Wide_Character_Sequence := - "zyxwvutsrqponmabcdefghijkl"; - TC_Upper_to_Lower_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(TC_UC_Sequence, - TC_LC_Sequence); - TC_Lower_to_Upper_Map : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.To_Mapping(TC_LC_Sequence, - TC_UC_Sequence); - begin - declare - TC_Domain : constant Wide_Maps.Wide_Character_Sequence := - Wide_Maps.To_Domain(TC_Upper_to_Lower_Map); - TC_Range : constant Wide_Maps.Wide_Character_Sequence := - Wide_Maps.To_Range(TC_Lower_to_Upper_Map); - begin - -- Function To_Domain returns the shortest Wide_Character_Sequence - -- value such that each wide character not in the result maps to - -- itself, and all wide characters in the result are in ascending - -- order. - if TC_Domain /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then - Report.Failed("Incorrect result from To_Domain with " & - "TC_Upper_to_Lower_Map as input"); - end if; - - -- The lower bound on the returned Wide_Character_Sequence value - -- from To_Domain must be 1. - if TC_Domain'First /= 1 then - Report.Failed("Incorrect lower bound returned from To_Domain"); - end if; - - -- Check contents of result of To_Range. - if TC_Range /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then - Report.Failed("Incorrect result from To_Range with " & - "TC_Lower_to_Upper_Map as input"); - end if; - - -- The lower bound on the returned Character_Sequence value - -- must be 1. - if TC_Range'First /= 1 then - Report.Failed("Incorrect lower bound returned from To_Range"); - end if; - - if TC_Range'Last /= TC_LC_Sequence'Length then - Report.Failed("Incorrect upper bound returned from To_Range"); - end if; - end; - - -- Both function To_Domain and To_Range return the null string - -- when provided the Identity character map as an input parameter. - if Wide_Maps.To_Domain(Wide_Maps.Identity) /= Null_Sequence or - Wide_Maps.To_Range(Wide_Maps.Identity) /= Null_Sequence - then - Report.Failed("Null sequence not returned from To_Domain or " & - "To_Range when provided the Identity map as input"); - end if; - exception - when others => - Report.Failed("Exception raised during the evaluation of " & - "Function To_Domain and To_Range"); - end; - - -- Testing of functionality found in Package Ada.Strings.Wide_Fixed. - -- - -- Function Index, Forward direction search. - - if Wide_Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg", - "MIXED CASE STRING", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 12 or - Wide_Fixed.Index("STRING WITH NO MATCHING PATTERNS", - "WITH", - Ada.Strings.Forward, - Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Forward direction, using a Character Mapping " & - "Function parameter"); - end if; - - -- Function Index, Backward direction search. - if Wide_Fixed.Index("Case of a Mixed Case String", - "case", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 17 or - Wide_Fixed.Index("WOULD MATCH BUT FOR THE CASE", - "WOULD MATCH BUT FOR THE CASE", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Backward direction, using a Character Mapping " & - "Function parameter"); - end if; - - -- Function Count. - if Wide_Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /= 2 or - Wide_Fixed.Count("", "match", Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Count, using " & - "a Character Mapping Function parameter"); - end if; - - -- Function Translate. - if Wide_Fixed.Translate(Source => "A Sample Mixed Case String", - Mapping => Map_To_Lower_Case_Ptr) /= - "a sample mixed case string" or - Wide_Fixed.Translate(New_Character_String, - Map_To_Upper_Case_Ptr) /= - TC_New_Character_String - then - Report.Failed("Incorrect results from Function Translate, using " & - "a Wide_Character Mapping Function parameter"); - end if; - - -- Procedure Translate. - declare - use Ada.Strings.Wide_Fixed; - Str : Wide_String(1..19) := "A Mixed Case String"; - begin - Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr); - if Str /= "a mixed case string" then - Report.Failed("Incorrect result from Procedure Translate - 1"); - end if; - - Translate(New_Character_String, Map_To_Upper_Case_Ptr); - if New_Character_String /= TC_New_Character_String then - Report.Failed("Incorrect result from Procedure Translate - 2"); - end if; - end; - - -- Procedure Trim. - declare - use Ada.Strings.Wide_Fixed; - Trim_String : Wide_String(1..30) := " A string of characters "; - begin - Trim(Trim_String, Ada.Strings.Left, Ada.Strings.Right, 'x'); - if Trim_String /= "xxxxA string of characters " then - Report.Failed("Incorrect result from Procedure Trim, trim " & - "side = left, justify = right, pad = x"); - end if; - - Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center); - if Trim_String /= " xxxxA string of characters " then - Report.Failed("Incorrect result from Procedure Trim, trim " & - "side = right, justify = center, default pad"); - end if; - end; - - -- Procedure Head. - declare - Fixed_String : Wide_String(1..20) := "A sample test string"; - begin - Wide_Fixed.Head(Source => Fixed_String, Count => 14, - Justify => Ada.Strings.Center, Pad => '$'); - if Fixed_String /= "$$$A sample test $$$" then - Report.Failed("Incorrect result from Procedure Head, " & - "justify = center, pad = $"); - end if; - - Wide_Fixed.Head(Fixed_String, 11, Ada.Strings.Right); - if Fixed_String /= " $$$A sample" then - Report.Failed("Incorrect result from Procedure Head, " & - "justify = right, default pad"); - end if; - end; - - -- Procedure Tail. - declare - use Ada.Strings.Wide_Fixed; - Tail_String : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - begin - -- Default left justify. - Tail(Source => Tail_String, Count => 10, Pad => '-'); - if Tail_String /= "KLMNOPQRST----------" then - Report.Failed("Incorrect result from Procedure Tail, " & - "default justify, pad = -"); - end if; - - Tail(Tail_String, 6, Ada.Strings.Center, 'a'); - if Tail_String /= "aaaaaaa------aaaaaaa" then - Report.Failed("Incorrect result from Procedure Tail, " & - "justify = center, pad = a"); - end if; - end; - - 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 CXA4025; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a deleted file mode 100644 index 766979ad057..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a +++ /dev/null @@ -1,526 +0,0 @@ --- CXA4026.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.Strings.Fixed procedures Head, Tail, and Trim, as well --- as the versions of subprograms Translate (procedure and function), --- Index, and Count, available in the package which use a --- Maps.Character_Mapping_Function input parameter, produce correct --- results. --- --- TEST DESCRIPTION: --- This test examines the operation of several subprograms contained in --- the Ada.Strings.Fixed package. --- This includes procedure versions of Head, Tail, and Trim, as well as --- four subprograms that use a Character_Mapping_Function as a parameter --- to provide the mapping capability. --- --- Two functions are defined to provide the mapping. Access values --- are defined to refer to these functions. One of the functions will --- map upper case characters in the range 'A'..'Z' to their lower case --- counterparts, while the other function will map lower case characters --- ('a'..'z', or a character whose position is in one of the ranges --- 223..246 or 248..255, provided the character has an upper case form) --- to their upper case form. --- --- Function Index uses the mapping function access value to map the input --- string prior to searching for the appropriate index value to return. --- Function Count uses the mapping function access value to map the input --- string prior to counting the occurrences of the pattern string. --- Both the Procedure and Function version of Translate use the mapping --- function access value to perform the translation. --- --- Results of all subprograms are compared with expected results. --- --- --- CHANGE HISTORY: --- 10 Feb 95 SAIC Initial prerelease version --- 21 Apr 95 SAIC Modified definition of string variable Str_2. --- ---! - - -package CXA4026_0 is - - -- Function Map_To_Lower_Case will return the lower case form of - -- Characters in the range 'A'..'Z' only, and return the input - -- character otherwise. - - function Map_To_Lower_Case (From : Character) return Character; - - - -- Function Map_To_Upper_Case will return the upper case form of - -- Characters in the range 'a'..'z', or whose position is in one - -- of the ranges 223..246 or 248..255, provided the character has - -- an upper case form. - - function Map_To_Upper_Case (From : Character) return Character; - -end CXA4026_0; - - -with Ada.Characters.Handling; -package body CXA4026_0 is - - function Map_To_Lower_Case (From : Character) return Character is - begin - if From in 'A'..'Z' then - return Character'Val(Character'Pos(From) - - (Character'Pos('A') - Character'Pos('a'))); - else - return From; - end if; - end Map_To_Lower_Case; - - function Map_To_Upper_Case (From : Character) return Character is - begin - return Ada.Characters.Handling.To_Upper(From); - end Map_To_Upper_Case; - -end CXA4026_0; - - -with CXA4026_0; -with Ada.Strings.Fixed; -with Ada.Strings.Maps; -with Ada.Characters.Handling; -with Ada.Characters.Latin_1; -with Report; - -procedure CXA4026 is - -begin - - Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " & - "as well as the versions of subprograms " & - "Translate, Index, and Count, which use the " & - "Character_Mapping_Function input parameter," & - "produce correct results"); - - Test_Block: - declare - - use Ada.Strings, CXA4026_0; - - -- The following strings are used in examination of the Translation - -- subprograms. - - New_Character_String : String(1..10) := - Ada.Characters.Latin_1.LC_A_Grave & - Ada.Characters.Latin_1.LC_A_Ring & - Ada.Characters.Latin_1.LC_AE_Diphthong & - Ada.Characters.Latin_1.LC_C_Cedilla & - Ada.Characters.Latin_1.LC_E_Acute & - Ada.Characters.Latin_1.LC_I_Circumflex & - Ada.Characters.Latin_1.LC_Icelandic_Eth & - Ada.Characters.Latin_1.LC_N_Tilde & - Ada.Characters.Latin_1.LC_O_Oblique_Stroke & - Ada.Characters.Latin_1.LC_Icelandic_Thorn; - - - TC_New_Character_String : String(1..10) := - Ada.Characters.Latin_1.UC_A_Grave & - Ada.Characters.Latin_1.UC_A_Ring & - Ada.Characters.Latin_1.UC_AE_Diphthong & - Ada.Characters.Latin_1.UC_C_Cedilla & - Ada.Characters.Latin_1.UC_E_Acute & - Ada.Characters.Latin_1.UC_I_Circumflex & - Ada.Characters.Latin_1.UC_Icelandic_Eth & - Ada.Characters.Latin_1.UC_N_Tilde & - Ada.Characters.Latin_1.UC_O_Oblique_Stroke & - Ada.Characters.Latin_1.UC_Icelandic_Thorn; - - - -- Functions used to supply mapping capability. - - - -- Access objects that will be provided as parameters to the - -- subprograms. - - Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function := - Map_To_Lower_Case'Access; - - Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function := - Map_To_Upper_Case'Access; - - - begin - - -- Function Index, Forward direction search. - -- Note: Several of the following cases use the default value - -- Forward for the Going parameter. - - if Fixed.Index(Source => "The library package Strings.Fixed", - Pattern => "fix", - Going => Ada.Strings.Forward, - Mapping => Map_To_Lower_Case_Ptr) /= 29 or - Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN", - "ain", - Mapping => Map_To_Lower_Case_Ptr) /= 6 or - Fixed.Index("maximum number", - "um", - Ada.Strings.Forward, - Map_To_Lower_Case_Ptr) /= 6 or - Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg", - "MIXED CASE STRING", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 12 or - Fixed.Index("STRING WITH NO MATCHING PATTERNS", - "WITH", - Ada.Strings.Forward, - Map_To_Lower_Case_Ptr) /= 0 or - Fixed.Index("THIS STRING IS IN UPPER CASE", - "IS", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 3 or - Fixed.Index("", -- Null string. - "is", - Mapping => Map_To_Lower_Case_Ptr) /= 0 or - Fixed.Index("AAABBBaaabbb", - "aabb", - Mapping => Map_To_Lower_Case_Ptr) /= 2 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Forward direction, using a Character Mapping " & - "Function parameter"); - end if; - - - - -- Function Index, Backward direction search. - - if Fixed.Index("Case of a Mixed Case String", - "case", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 17 or - Fixed.Index("Case of a Mixed Case String", - "CASE", - Ada.Strings.Backward, - Map_To_Upper_Case_Ptr) /= 17 or - Fixed.Index("rain, Rain, and more RAIN", - "rain", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 22 or - Fixed.Index("RIGHT place, right time", - "RIGHT", - Ada.Strings.Backward, - Map_To_Upper_Case_Ptr) /= 14 or - Fixed.Index("WOULD MATCH BUT FOR THE CASE", - "WOULD MATCH BUT FOR THE CASE", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Backward direction, using a Character Mapping " & - "Function parameter"); - end if; - - - - -- Function Index, Pattern_Error if Pattern = Null_String - - declare - use Ada.Strings.Fixed; - Null_Pattern_String : constant String := ""; - TC_Natural : Natural := 1000; - begin - TC_Natural := Index("A Valid String", - Null_Pattern_String, - Ada.Strings.Forward, - Map_To_Lower_Case_Ptr); - Report.Failed("Pattern_Error not raised by Function Index when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Index " & - "using a Character Mapping Function parameter " & - "when given a null pattern string"); - end; - - - - -- Function Count. - - if Fixed.Count(Source => "ABABABA", - Pattern => "aba", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /= 0 or - Fixed.Count("This IS a MISmatched issue", - "is", - Map_To_Lower_Case_Ptr) /= 4 or - Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /= 2 or - Fixed.Count("This IS a MISmatched issue", - "is", - Map_To_Upper_Case_Ptr) /= 0 or - Fixed.Count("She sells sea shells by the sea shore", - "s", - Map_To_Lower_Case_Ptr) /= 8 or - Fixed.Count("", -- Null string. - "match", - Map_To_Upper_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Count, using " & - "a Character Mapping Function parameter"); - end if; - - - - -- Function Count, Pattern_Error if Pattern = Null_String - - declare - use Ada.Strings.Fixed; - Null_Pattern_String : constant String := ""; - TC_Natural : Natural := 1000; - begin - TC_Natural := Count("A Valid String", - Null_Pattern_String, - Map_To_Lower_Case_Ptr); - Report.Failed("Pattern_Error not raised by Function Count using " & - "a Character Mapping Function parameter when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Count " & - "using a Character Mapping Function parameter " & - "when given a null pattern string"); - end; - - - - -- Function Translate. - - if Fixed.Translate(Source => "A Sample Mixed Case String", - Mapping => Map_To_Lower_Case_Ptr) /= - "a sample mixed case string" or - - Fixed.Translate("ALL LOWER CASE", - Map_To_Lower_Case_Ptr) /= - "all lower case" or - - Fixed.Translate("end with lower case", - Map_To_Lower_Case_Ptr) /= - "end with lower case" or - - Fixed.Translate("", Map_To_Lower_Case_Ptr) /= - "" or - - Fixed.Translate("start with lower case", - Map_To_Upper_Case_Ptr) /= - "START WITH LOWER CASE" or - - Fixed.Translate("ALL UPPER CASE STRING", - Map_To_Upper_Case_Ptr) /= - "ALL UPPER CASE STRING" or - - Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs", - Map_To_Upper_Case_Ptr) /= - "LOTS OF MIXED CASE CHARACTERS" or - - Fixed.Translate("", Map_To_Upper_Case_Ptr) /= - "" or - - Fixed.Translate(New_Character_String, - Map_To_Upper_Case_Ptr) /= - TC_New_Character_String - then - Report.Failed("Incorrect results from Function Translate, using " & - "a Character Mapping Function parameter"); - end if; - - - - -- Procedure Translate. - - declare - - use Ada.Strings.Fixed; - - Str_1 : String(1..24) := "AN ALL UPPER CASE STRING"; - Str_2 : String(1..19) := "A Mixed Case String"; - Str_3 : String(1..32) := "a string with lower case letters"; - TC_Str_1 : constant String := Str_1; - TC_Str_3 : constant String := Str_3; - - begin - - Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr); - - if Str_1 /= "an all upper case string" then - Report.Failed("Incorrect result from Procedure Translate - 1"); - end if; - - Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr); - - if Str_1 /= TC_Str_1 then - Report.Failed("Incorrect result from Procedure Translate - 2"); - end if; - - Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr); - - if Str_2 /= "a mixed case string" then - Report.Failed("Incorrect result from Procedure Translate - 3"); - end if; - - Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr); - - if Str_2 /= "A MIXED CASE STRING" then - Report.Failed("Incorrect result from Procedure Translate - 4"); - end if; - - Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr); - - if Str_3 /= TC_Str_3 then - Report.Failed("Incorrect result from Procedure Translate - 5"); - end if; - - Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr); - - if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then - Report.Failed("Incorrect result from Procedure Translate - 6"); - end if; - - Translate(New_Character_String, Map_To_Upper_Case_Ptr); - - if New_Character_String /= TC_New_Character_String then - Report.Failed("Incorrect result from Procedure Translate - 6"); - end if; - - end; - - - -- Procedure Trim. - - declare - Use Ada.Strings.Fixed; - Trim_String : String(1..30) := " A string of characters "; - begin - - Trim(Source => Trim_String, - Side => Ada.Strings.Left, - Justify => Ada.Strings.Right, - Pad => 'x'); - - if Trim_String /= "xxxxA string of characters " then - Report.Failed("Incorrect result from Procedure Trim, trim " & - "side = left, justify = right, pad = x"); - end if; - - Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center); - - if Trim_String /= " xxxxA string of characters " then - Report.Failed("Incorrect result from Procedure Trim, trim " & - "side = right, justify = center, default pad"); - end if; - - Trim(Trim_String, Ada.Strings.Both, Pad => '*'); - - if Trim_String /= "xxxxA string of characters****" then - Report.Failed("Incorrect result from Procedure Trim, trim " & - "side = both, default justify, pad = *"); - end if; - - end; - - - -- Procedure Head. - - declare - Fixed_String : String(1..20) := "A sample test string"; - begin - - Fixed.Head(Source => Fixed_String, - Count => 14, - Justify => Ada.Strings.Center, - Pad => '$'); - - if Fixed_String /= "$$$A sample test $$$" then - Report.Failed("Incorrect result from Procedure Head, " & - "justify = center, pad = $"); - end if; - - Fixed.Head(Fixed_String, 11, Ada.Strings.Right); - - if Fixed_String /= " $$$A sample" then - Report.Failed("Incorrect result from Procedure Head, " & - "justify = right, default pad"); - end if; - - Fixed.Head(Fixed_String, 9, Pad => '*'); - - if Fixed_String /= " ***********" then - Report.Failed("Incorrect result from Procedure Head, " & - "default justify, pad = *"); - end if; - - end; - - - -- Procedure Tail. - - declare - Use Ada.Strings.Fixed; - Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - begin - - Tail(Source => Tail_String, Count => 10, Pad => '-'); - - if Tail_String /= "KLMNOPQRST----------" then - Report.Failed("Incorrect result from Procedure Tail, " & - "default justify, pad = -"); - end if; - - Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a'); - - if Tail_String /= "aaaaaaa------aaaaaaa" then - Report.Failed("Incorrect result from Procedure Tail, " & - "justify = center, pad = a"); - end if; - - Tail(Tail_String, 1, Ada.Strings.Right); - - if Tail_String /= " a" then - Report.Failed("Incorrect result from Procedure Tail, " & - "justify = right, default pad"); - end if; - - Tail(Tail_String, 19, Ada.Strings.Right, 'A'); - - if Tail_String /= "A a" then - Report.Failed("Incorrect result from Procedure Tail, " & - "justify = right, pad = A"); - end if; - - end; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - Report.Result; - -end CXA4026; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a deleted file mode 100644 index 05c66d4cc9f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a +++ /dev/null @@ -1,342 +0,0 @@ --- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate, --- (procedure and function), Index, and Count, which use the --- Maps.Character_Mapping_Function input parameter, produce correct --- results. --- --- TEST DESCRIPTION: --- This test examines the operation of several subprograms from within --- the Ada.Strings.Bounded package that use the --- Character_Mapping_Function mapping parameter to provide a mapping --- capability. --- --- Two functions are defined to provide the mapping. Access values --- are defined to refer to these functions. One of the functions will --- map upper case characters in the range 'A'..'Z' to their lower case --- counterparts, while the other function will map lower case characters --- ('a'..'z', or a character whose position is in one of the ranges --- 223..246 or 248..255, provided the character has an upper case form) --- to their upper case form. --- --- Function Index uses the mapping function access value to map the input --- string prior to searching for the appropriate index value to return. --- Function Count uses the mapping function access value to map the input --- string prior to counting the occurrences of the pattern string. --- Both the Procedure and Function version of Translate use the mapping --- function access value to perform the translation. --- --- --- CHANGE HISTORY: --- 16 FEB 95 SAIC Initial prerelease version --- 17 Jul 95 SAIC Incorporated reviewer comments. Replaced two --- internally declared functions with two library --- level functions to eliminate accessibility --- problems. --- ---! - - --- Function CXA4027_0 will return the lower case form of --- the character input if it is in upper case, and return the input --- character otherwise. - -with Ada.Characters.Handling; -function CXA4027_0 (From : Character) return Character; - -function CXA4027_0 (From : Character) return Character is -begin - return Ada.Characters.Handling.To_Lower(From); -end CXA4027_0; - - - --- Function CXA4027_1 will return the upper case form of --- Characters in the range 'a'..'z', or whose position is in one --- of the ranges 223..246 or 248..255, provided the character has --- an upper case form. - -with Ada.Characters.Handling; -function CXA4027_1 (From : Character) return Character; - -function CXA4027_1 (From : Character) return Character is -begin - return Ada.Characters.Handling.To_Upper(From); -end CXA4027_1; - - -with CXA4027_0, CXA4027_1; -with Ada.Strings.Bounded; -with Ada.Strings.Maps; -with Ada.Characters.Handling; -with Report; - -procedure CXA4027 is -begin - - Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms " & - "Translate, Index, and Count, which use the " & - "Character_Mapping_Function input parameter, " & - "produce correct results"); - - Test_Block: - declare - - use Ada.Strings; - - -- Functions used to supply mapping capability. - - function Map_To_Lower_Case (From : Character) return Character - renames CXA4027_0; - - function Map_To_Upper_Case (From : Character) return Character - renames CXA4027_1; - - Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function := - Map_To_Lower_Case'Access; - - Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function := - Map_To_Upper_Case'Access; - - - -- Instantiations of Bounded String generic package. - - package BS1 is new Ada.Strings.Bounded.Generic_Bounded_Length(1); - package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20); - package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40); - package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80); - - use type BS1.Bounded_String, BS20.Bounded_String, - BS40.Bounded_String, BS80.Bounded_String; - - String_1 : String(1..1) := "A"; - String_20 : String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - String_40 : String(1..40) := "abcdefghijklmnopqrst" & String_20; - String_80 : String(1..80) := String_40 & String_40; - - BString_1 : BS1.Bounded_String := BS1.Null_Bounded_String; - BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String; - BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String; - BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String; - - - begin - - -- Function Index. - - if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"), - Pattern => "s.b", - Going => Ada.Strings.Forward, - Mapping => Map_To_Lower_Case_Ptr) /= 15 or - BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"), - "tr", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - BS20.Index(BS20.To_Bounded_String("maximum number"), - "um", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 10 or - BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"), - "MIXED CASE STRING", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 12 or - BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"), - "WITH", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 0 or - BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"), - "I", - Ada.Strings.Backward, - Map_To_Upper_Case_Ptr) /= 16 or - BS1.Index(BS1.Null_Bounded_String, - "i", - Mapping => Map_To_Lower_Case_Ptr) /= 0 or - BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"), - "aabb", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"), - "WOULD MATCH BUT FOR THE CASE", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Index, using a " & - "Character Mapping Function parameter"); - end if; - - - -- Function Index, Pattern_Error if Pattern = Null_String - - declare - use BS20; - TC_Natural : Natural := 1000; - begin - TC_Natural := Index(To_Bounded_String("A Valid String"), - "", - Ada.Strings.Forward, - Map_To_Lower_Case_Ptr); - Report.Failed("Pattern_Error not raised by Function Index when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Index " & - "using a Character_Mapping_Function parameter " & - "when given a null pattern string"); - end; - - - -- Function Count. - - if BS20.Count(BS20.To_Bounded_String("ABABABA"), - Pattern => "aba", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - BS20.Count(BS20.To_Bounded_String("ABABABA"), - "ABA", - Map_To_Lower_Case_Ptr) /= 0 or - BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"), - "is", - Map_To_Lower_Case_Ptr) /= 4 or - BS80.Count(BS80.To_Bounded_String("ABABABA"), - "ABA", - Map_To_Upper_Case_Ptr) /= 2 or - BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"), - "is", - Map_To_Upper_Case_Ptr) /= 0 or - BS80.Count(BS80.To_Bounded_String - ("Peter Piper and his Pickled Peppers"), - "p", - Map_To_Lower_Case_Ptr) /= 7 or - BS20.Count(BS20.To_Bounded_String("She sells sea shells"), - "s", - Map_To_Upper_Case_Ptr) /= 0 or - BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"), - "matches", - Map_To_Upper_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Count, using " & - "a Character_Mapping_Function parameter"); - end if; - - - -- Function Count, Pattern_Error if Pattern = Null_String - - declare - use BS80; - TC_Natural : Natural := 1000; - begin - TC_Natural := Count(To_Bounded_String("A Valid String"), - "", - Map_To_Lower_Case_Ptr); - Report.Failed("Pattern_Error not raised by Function Count using " & - "a Character_Mapping_Function parameter when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Count " & - "using a Character_Mapping_Function parameter " & - "when given a null pattern string"); - end; - - - -- Function Translate. - - if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"), - Mapping => Map_To_Lower_Case_Ptr) /= - BS40.To_Bounded_String("a mixed case string") or - - BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"), - Map_To_Lower_Case_Ptr), - "all lower case") or - - BS20."/="("end with lower case", - BS20.Translate( - BS20.To_Bounded_String("end with lower case"), - Map_To_Lower_Case_Ptr)) or - - BS1.Translate(BS1.Null_Bounded_String, - Map_To_Lower_Case_Ptr) /= - BS1.Null_Bounded_String or - - BS80."/="(BS80.Translate(BS80.To_Bounded_String - ("start with lower case, end with upper case"), - Map_To_Upper_Case_Ptr), - "START WITH LOWER CASE, END WITH UPPER CASE") or - - BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"), - Map_To_Upper_Case_Ptr) /= - BS40.To_Bounded_String("ALL UPPER CASE STRING") or - - BS80."/="(BS80.Translate(BS80.To_Bounded_String - ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"), - Map_To_Upper_Case_Ptr), - "LOTS OF MIXED CASE CHARACTERS IN THE STRING") - - then - Report.Failed("Incorrect results from Function Translate, using " & - "a Character_Mapping_Function parameter"); - end if; - - - -- Procedure Translate. - - BString_1 := BS1.To_Bounded_String("A"); - - BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr); - - if not BS1."="(BString_1, "a") then -- "=" for Bounded_String, String - Report.Failed("Incorrect result from Procedure Translate - 1"); - end if; - - BString_20 := BS20.To_Bounded_String(String_20); - BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr); - - if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then - Report.Failed("Incorrect result from Procedure Translate - 2"); - end if; - - BString_40 := BS40.To_Bounded_String("String needing highlighting"); - BS40.Translate(BString_40, Map_To_Upper_Case_Ptr); - - if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then - Report.Failed("Incorrect result from Procedure Translate - 3"); - end if; - - BString_80 := BS80.Null_Bounded_String; - BS80.Translate(BString_80, Map_To_Upper_Case_Ptr); - - if not (BString_80 = BS80.Null_Bounded_String) then - Report.Failed("Incorrect result from Procedure Translate - 4"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4027; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a deleted file mode 100644 index bc6cac14c5e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a +++ /dev/null @@ -1,331 +0,0 @@ --- CXA4028.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.Strings.Bounded procedures Append, Head, Tail, and --- Trim, and relational operator functions "=", ">", ">=", "<", "<=" --- with parameter combinations of type String and Bounded_String, --- produce correct results. --- --- TEST DESCRIPTION: --- This test examines the operation of several subprograms from within --- the Ada.Strings.Bounded package. Four different instantiations of --- Ada.Strings.Bounded.Generic_Bounded_Length provide packages defined --- to manipulate bounded strings of lengths 1, 20, 40, and 80. --- Examples of the above mentioned procedures and relational operators --- from each of these instantiations are tested, with results compared --- against expected output. --- --- Testing of the function versions of many of the subprograms tested --- here is performed in tests CXA4006-CXA4009. --- --- --- CHANGE HISTORY: --- 16 Feb 95 SAIC Initial prerelease version --- 10 Mar 95 SAIC Incorporated reviewer comments. --- 15 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -with Ada.Exceptions; -with Ada.Strings.Bounded; -with Report; - -procedure CXA4028 is - -begin - - Report.Test ("CXA4028", "Check that Ada.Strings.Bounded procedures " & - "Append, Head, Tail, and Trim, and relational " & - "operator functions =, >, >=, <, <= with " & - "parameter combinations of type String and " & - "Bounded_String, produce correct results"); - - Test_Block: - declare - - use Ada.Exceptions; - use Ada.Strings; - - -- Instantiations of Bounded String generic package. - - package BS1 is new Ada.Strings.Bounded.Generic_Bounded_Length(1); - package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20); - package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40); - package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80); - - use type BS1.Bounded_String, BS20.Bounded_String, - BS40.Bounded_String, BS80.Bounded_String; - - String_1 : String(1..1) := "A"; - String_20 : String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - String_40 : String(1..40) := "abcdefghijklmnopqrst" & String_20; - String_80 : String(1..80) := String_40 & String_40; - - BString_1 : BS1.Bounded_String := BS1.Null_Bounded_String; - BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String; - BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String; - BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String; - - begin - - -- Procedure Append. - - declare - use BS1, BS20; - begin - Append(Source => BString_1, New_Item => To_Bounded_String("A")); - Append(BString_1, "B", Ada.Strings.Left); - Append(BString_1, 'C', Drop => Ada.Strings.Right); -- Drop appended - -- character. - if BString_1 /= To_Bounded_String("B") then - Report.Failed("Incorrect results from BS1 versions of " & - "procedure Append"); - end if; - - Append(BString_20, 'T'); -- Character. - Append(BString_20, "his string"); -- String. - Append(BString_20, - To_Bounded_String(" is complete."), -- Bounded string. - Drop => Ada.Strings.Right); -- Drop 4 characters. - - if BString_20 /= To_Bounded_String("This string is compl") then - Report.Failed("Incorrect results from BS20 versions of " & - "procedure Append"); - end if; - end; - - - -- Operator "=". - - BString_40 := BS40.To_Bounded_String(String_40); - BString_80 := BS80.To_Bounded_String( - BS40.To_String(BString_40) & - BS40.To_String(BString_40)); - - if not (BString_40 = String_40 and -- (Bounded_String, String) - BS80."="(String_80, BString_80)) -- (String, Bounded_String) - then - Report.Failed("Incorrect results from function ""="" with " & - "string - bounded string parameter combinations"); - end if; - - - -- Operator "<". - - BString_1 := BS1.To_Bounded_String("cat", -- string "c" only. - Drop => Ada.Strings.Right); - BString_20 := BS20.To_Bounded_String("Santa Claus"); - - if BString_1 < "C" or -- (Bounded_String, String) - BS1."<"(BString_1,"c") or -- (Bounded_String, String) - "x" < BString_1 or -- (String, Bounded_String) - BString_20 < "Santa " or -- (Bounded_String, String) - "Santa and his Elves" < BString_20 -- (String, Bounded_String) - then - Report.Failed("Incorrect results from function ""<"" with " & - "string - bounded string parameter combinations"); - end if; - - - -- Operator "<=". - - BString_20 := BS20.To_Bounded_String("Sample string"); - - if BString_20 <= "Sample strin" or -- (Bounded_String, String) - "sample string" <= BString_20 or -- (String, Bounded_String) - not("Sample string" <= BString_20) -- (String, Bounded_String) - then - Report.Failed("Incorrect results from function ""<="" with " & - "string - bounded string parameter combinations"); - end if; - - - -- Operator ">". - - BString_40 := BS40.To_Bounded_String("A MUCH LONGER SAMPLE STRING."); - - if BString_40 > "A much longer sample string" or -- (Bnd_Str, Str) - String_20 > BS40.To_Bounded_String(String_40) or -- (Str, Bnd_Str) - BS40.To_Bounded_String("ABCDEFGH") > "abcdefgh" -- (Str, Bnd_Str) - then - Report.Failed("Incorrect results from function "">"" with " & - "string - bounded string parameter combinations"); - end if; - - - -- Operator ">=". - - BString_80 := BS80.To_Bounded_String(String_80); - - if not (BString_80 >= String_80 and - BS80.To_Bounded_String("Programming") >= "PROGRAMMING" and - "test" >= BS80.To_Bounded_String("tess")) - then - Report.Failed("Incorrect results from function "">="" with " & - "string - bounded string parameter combinations"); - end if; - - - -- Procedure Trim - - BString_20 := BS20.To_Bounded_String(" Left Spaces "); - BS20.Trim(Source => BString_20, - Side => Ada.Strings.Left); - - if "Left Spaces " /= BString_20 then - Report.Failed("Incorrect results from Procedure Trim with " & - "Side = Left"); - end if; - - BString_40 := BS40.To_Bounded_String(" Right Spaces "); - BS40.Trim(BString_40, Side => Ada.Strings.Right); - - if BString_40 /= " Right Spaces" then - Report.Failed("Incorrect results from Procedure Trim with " & - "Side = Right"); - end if; - - BString_20 := BS20.To_Bounded_String(" Both Sides "); - BS20.Trim(BString_20, Ada.Strings.Both); - - if BString_20 /= BS20.To_Bounded_String("Both Sides") then - Report.Failed("Incorrect results from Procedure Trim with " & - "Side = Both"); - end if; - - BString_80 := BS80.To_Bounded_String("Centered Spaces"); - BS80.Trim(BString_80, Ada.Strings.Both); - - if BString_80 /= BS80.To_Bounded_String("Centered Spaces") then - Report.Failed("Incorrect results from Procedure Trim with " & - "no blank spaces on the ends of the string"); - end if; - - - -- Procedure Head - - BString_40 := BS40.To_Bounded_String("Test String"); - BS40.Head(Source => BString_40, - Count => 4); -- Count < Source'Length - - if BString_40 /= BS40.To_Bounded_String("Test") then - Report.Failed("Incorrect results from Procedure Head with " & - "the Count parameter less than Source'Length"); - end if; - - BString_1 := BS1.To_Bounded_String("X"); - BS1.Head(BString_1, BS1.Length(BString_1)); -- Count = Source'Length - - if BString_1 /= "X" then - Report.Failed("Incorrect results from Procedure Head with " & - "the Count parameter equal to Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_String("Sample string"); - BS20.Head(BString_20, - Count => BS20.Max_Length, -- Count > Source'Length - Pad => '*'); - - if BString_20 /= BS20.To_Bounded_String("Sample string*******") then - Report.Failed("Incorrect results from Procedure Head with " & - "the Count parameter greater than Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_String("Twenty Characters 20"); - BS20.Head(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left); - - if BString_20 /= "enty Characters 20**" then - Report.Failed("Incorrect results from Procedure Head with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Left"); - end if; - - BString_20 := BS20.To_Bounded_String("Short String"); - BS20.Head(BString_20, 23, '-', Ada.Strings.Right); - - if ("Short String--------") /= BString_20 then - Report.Failed("Incorrect results from Procedure Head with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Right"); - end if; - - - -- Procedure Tail - - BString_40 := BS40.To_Bounded_String("Test String"); - BS40.Tail(Source => BString_40, - Count => 6); -- Count < Source'Length - - if BString_40 /= BS40.To_Bounded_String("String") then - Report.Failed("Incorrect results from Procedure Tail with " & - "the Count parameter less than Source'Length"); - end if; - - BString_1 := BS1.To_Bounded_String("X"); - BS1.Tail(BString_1, BS1.Length(BString_1)); -- Count = Source'Length - - if BString_1 /= "X" then - Report.Failed("Incorrect results from Procedure Tail with " & - "the Count parameter equal to Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_String("Sample string"); - BS20.Tail(BString_20, - Count => BS20.Max_Length, -- Count > Source'Length - Pad => '*'); - - if BString_20 /= BS20.To_Bounded_String("*******Sample string") then - Report.Failed("Incorrect results from Procedure Tail with " & - "the Count parameter greater than Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_String("Twenty Characters"); -- Len = 17 - BS20.Tail(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left); - - if BString_20 /= "***Twenty Characters" then - Report.Failed("Incorrect results from Procedure Tail with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Left"); - end if; - - BString_20 := BS20.To_Bounded_String("Maximum Length Chars"); - BS20.Tail(BString_20, 23, '-', Ada.Strings.Right); - - if ("---Maximum Length Ch") /= BString_20 then - Report.Failed("Incorrect results from Procedure Tail with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Right"); - 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 CXA4028; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a deleted file mode 100644 index 7140674544a..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a +++ /dev/null @@ -1,333 +0,0 @@ --- CXA4029.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 found in packages Ada.Strings.Wide_Maps, --- Ada.Strings.Wide_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants --- is available and produces correct results. --- --- TEST DESCRIPTION: --- This test tests the subprograms found in the --- Ada.Strings.Wide_Bounded package. It is based on the tests --- CXA4027-28, which are tests for the complementary "non-wide" --- packages. --- --- The functions found in CXA4029_0 provide mapping capability, when --- used in conjunction with Wide_Character_Mapping_Function objects. --- --- --- CHANGE HISTORY: --- 23 Jun 95 SAIC Initial prerelease version. --- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -package CXA4029_0 is - -- Functions used to supply mapping capability. - function Map_To_Lower_Case (From : Wide_Character) return Wide_Character; - function Map_To_Upper_Case (From : Wide_Character) return Wide_Character; -end CXA4029_0; - -with Ada.Characters.Handling; -package body CXA4029_0 is - -- Function Map_To_Lower_Case will return the lower case form of - -- Wide_Characters in the range 'A'..'Z' only, and return the input - -- wide_character otherwise. - - function Map_To_Lower_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Lower( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Lower_Case; - - -- Function Map_To_Upper_Case will return the upper case form of - -- Wide_Characters in the range 'a'..'z', or whose position is in one - -- of the ranges 223..246 or 248..255, provided the wide_character has - -- an upper case form. - - function Map_To_Upper_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Upper( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Upper_Case; - -end CXA4029_0; - - -with CXA4029_0; -with Report; -with Ada.Characters.Handling; -with Ada.Characters.Latin_1; -with Ada.Strings; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Maps.Wide_Constants; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Bounded; - -procedure CXA4029 is -begin - Report.Test ("CXA4029", - "Check that subprograms defined in package " & - "Ada.Strings.Wide_Bounded produce correct results"); - - Test_Block: - declare - - package ACL1 renames Ada.Characters.Latin_1; - package BS1 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(1); - package BS20 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(20); - package BS40 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(40); - package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80); - - subtype LC_Characters is Wide_Character range 'a'..'z'; - - use Ada.Characters, Ada.Strings; - use type Wide_Maps.Wide_Character_Set; - use type BS1.Bounded_Wide_String, BS20.Bounded_Wide_String, - BS40.Bounded_Wide_String, BS80.Bounded_Wide_String; - - TC_String : constant Wide_String := "A Standard String"; - - BString_1 : BS1.Bounded_Wide_String := - BS1.Null_Bounded_Wide_String; - BString_20 : BS20.Bounded_Wide_String := - BS20.Null_Bounded_Wide_String; - BString_40 : BS40.Bounded_Wide_String := - BS40.Null_Bounded_Wide_String; - BString_80 : BS80.Bounded_Wide_String := - BS80.Null_Bounded_Wide_String; - String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" & - String_20; - String_80 : Wide_String(1..80) := String_40 & String_40; - TC_String_5 : Wide_String(1..5) := "ABCDE"; - - -- The following strings are used in examination of the Translation - -- subprograms. - New_Character_String : Wide_String(1..10) := - Handling.To_Wide_String( - ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong & - ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex & - ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde & - ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn); - - TC_New_Character_String : Wide_String(1..10) := - Handling.To_Wide_String( - ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong & - ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex & - ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde & - ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn); - - -- Access objects that will be provided as parameters to the - -- subprograms. - Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4029_0.Map_To_Lower_Case'Access; - Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4029_0.Map_To_Upper_Case'Access; - - begin - - -- Testing of functionality found in Package Ada.Strings.Wide_Bounded. - -- - -- Function Index. - - if BS80.Index(BS80.To_Bounded_Wide_String("CoMpLeTeLy MiXeD CaSe"), - "MIXED CASE", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 12 or - BS1.Index(BS1.Null_Bounded_Wide_String, - "i", - Mapping => Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from BND Function Index, going " & - "in Forward direction, using a Character Mapping " & - "Function parameter"); - end if; - - -- Function Count. - if BS40.Count(BS40.To_Bounded_Wide_String("This IS a MISmatched issue"), - "is", - Map_To_Lower_Case_Ptr) /= 4 or - BS80.Count(BS80.To_Bounded_Wide_String("ABABABA"), - "ABA", - Map_To_Upper_Case_Ptr) /= 2 - then - Report.Failed("Incorrect results from BND Function Count, using " & - "a Character_Mapping_Function parameter"); - end if; - - -- Function Translate. - if BS40.Translate(BS40.To_Bounded_Wide_String("A Mixed Case String"), - Mapping => Map_To_Lower_Case_Ptr) /= - BS40.To_Bounded_Wide_String("a mixed case string") or - BS20."/="("end with lower case", - BS20.Translate( - BS20.To_Bounded_Wide_String("end with lower case"), - Map_To_Lower_Case_Ptr)) - then - Report.Failed("Incorrect results from BND Function Translate, " & - "using a Character_Mapping_Function parameter"); - end if; - - -- Procedure Translate. - BString_20 := BS20.To_Bounded_Wide_String(String_20); - BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr); - if BString_20 /= BS20.To_Bounded_Wide_String("abcdefghijklmnopqrst") - then - Report.Failed("Incorrect result from BND Procedure Translate - 1"); - end if; - - BString_80 := BS80.Null_Bounded_Wide_String; - BS80.Translate(BString_80, Map_To_Upper_Case_Ptr); - if not (BString_80 = BS80.Null_Bounded_Wide_String) then - Report.Failed("Incorrect result from BND Procedure Translate - 2"); - end if; - - -- Procedure Append. - declare - use BS20; - begin - BString_20 := BS20.Null_Bounded_Wide_String; - Append(BString_20, 'T'); - Append(BString_20, "his string"); - Append(BString_20, - To_Bounded_Wide_String(" is complete."), - Drop => Ada.Strings.Right); -- Drop 4 characters. - if BString_20 /= To_Bounded_Wide_String("This string is compl") then - Report.Failed("Incorrect results from BS20 versions of " & - "procedure Append"); - end if; - exception - when others => Report.Failed("Exception raised in block checking " & - "BND Procedure Append"); - end; - - -- Operator "=". - BString_40 := BS40.To_Bounded_Wide_String(String_40); - BString_80 := BS80.To_Bounded_Wide_String( - BS40.To_Wide_String(BString_40) & - BS40.To_Wide_String(BString_40)); - if not (BString_40 = String_40 and - BS80."="(String_80, BString_80)) then - Report.Failed("Incorrect results from BND Function ""="" with " & - "string - bounded string parameter combinations"); - end if; - - -- Operator "<". - BString_1 := BS1.To_Bounded_Wide_String("cat", - Drop => Ada.Strings.Right); - BString_20 := BS20.To_Bounded_Wide_String("Santa Claus"); - if BString_1 < "C" or - BS1."<"(BString_1,"c") or - BS1."<"("x", BString_1) or - BS20."<"(BString_20,"Santa ") or - BS20."<"("Santa and his Elves", BString_20) - then - Report.Failed("Incorrect results from BND Function ""<"" with " & - "string - bounded string parameter combinations"); - end if; - - -- Operator "<=". - BString_20 := BS20.To_Bounded_Wide_String("Sample string"); - if BS20."<="(BString_20,"Sample strin") or - not(BS20."<="("Sample string",BString_20)) - then - Report.Failed("Incorrect results from BND Function ""<="" with " & - "string - bounded string parameter combinations"); - end if; - - -- Operator ">". - BString_40 := BS40.To_Bounded_Wide_String( - "A MUCH LONGER SAMPLE STRING."); - if BString_40 > "A much longer sample string" or - BS40.To_Bounded_Wide_String("ABCDEFGH") > "abcdefgh" - then - Report.Failed("Incorrect results from BND Function "">"" with " & - "string - bounded string parameter combinations"); - end if; - - -- Operator ">=". - BString_80 := BS80.To_Bounded_Wide_String(String_80); - if not (BString_80 >= String_80 and - BS80.To_Bounded_Wide_String("Programming") >= "PROGRAMMING" and - BS80.">="("test", BS80.To_Bounded_Wide_String("tess"))) - then - Report.Failed("Incorrect results from BND Function "">="" with " & - "string - bounded string parameter combinations"); - end if; - - -- Procedure Trim - BString_20 := BS20.To_Bounded_Wide_String(" Both Sides "); - BS20.Trim(BString_20, Ada.Strings.Both); - if BString_20 /= BS20.To_Bounded_Wide_String("Both Sides") then - Report.Failed("Incorrect results from BND Procedure Trim with " & - "Side = Both"); - end if; - - -- Procedure Head - BString_40 := BS40.To_Bounded_Wide_String("Test String"); - BS40.Head(Source => BString_40, - Count => 4); -- Count < Source'Length - if BString_40 /= BS40.To_Bounded_Wide_String("Test") then - Report.Failed("Incorrect results from BND Procedure Head with " & - "the Count parameter less than Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_Wide_String("Short String"); - BS20.Head(BString_20, 23, '-', Ada.Strings.Right); - if BS20.To_Bounded_Wide_String("Short String--------") /= BString_20 then - Report.Failed("Incorrect results from BND Procedure Head with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Right"); - end if; - - -- Procedure Tail - BString_40 := BS40.To_Bounded_Wide_String("Test String"); - BS40.Tail(Source => BString_40, - Count => 6); - if BString_40 /= BS40.To_Bounded_Wide_String("String") then - Report.Failed("Incorrect results from BND Procedure Tail with " & - "the Count parameter less than Source'Length"); - end if; - - BString_20 := BS20.To_Bounded_Wide_String("Maximum Length Chars"); - BS20.Tail(BString_20, 23, '-', Ada.Strings.Right); - if BS20.To_Bounded_Wide_String("---Maximum Length Ch") /= BString_20 then - Report.Failed("Incorrect results from BND Procedure Tail with " & - "the Count parameter greater than Source'Length, " & - "and the Drop parameter = Right"); - end if; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4029; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a deleted file mode 100644 index 475d0089921..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a +++ /dev/null @@ -1,414 +0,0 @@ --- CXA4030.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.Strings.Unbounded versions of subprograms Translate --- (procedure and function), Index, and Count, which use a --- Maps.Character_Mapping_Function input parameter, produce correct --- results. --- --- TEST DESCRIPTION: --- This test examines the operation of the four subprograms contained --- in the Ada.Strings.Unbounded package that use a --- Character_Mapping_Function parameter to provide the mapping --- capability. --- Two Character_Mapping_Function objects are defined that reference --- subprograms contained in the Ada.Characters.Handling package; --- To_Lower will return the lower-case form of the character provided --- as the input parameter, To_Upper will return the upper-case form --- of the character input parameter (provided there is an upper-case --- form). --- In several instances in this test, the character handling functions --- are referenced directly in the parameter list of the subprograms --- under test, demonstrating another form of expected common usage. --- --- Results of all subprograms are compared with expected results. --- --- This test, when taken in conjunction with tests CXA4010, CXA4011, --- CXA4031, and CXA4032 will constitute a test of all the functionality --- contained in package Ada.Strings.Unbounded. This test uses a variety --- of the subprograms defined in the unbounded string package in ways --- typical of common usage. --- --- --- CHANGE HISTORY: --- 21 Feb 95 SAIC Initial prerelease version --- 21 Apr 95 SAIC Modified header commentary. --- ---! - -with Ada.Strings.Unbounded; -with Ada.Strings.Maps; -with Ada.Characters.Handling; -with Ada.Characters.Latin_1; -with Report; - -procedure CXA4030 is - -begin - - Report.Test ("CXA4030", "Check that Ada.Strings.Unbounded versions " & - "of subprograms Translate (procedure and " & - "function), Index, and Count, which use a " & - "Maps.Character_Mapping_Function input " & - "parameter, produce correct results"); - - Test_Block: - declare - - package Unb renames Ada.Strings.Unbounded; - use type Unb.Unbounded_String; - use Ada.Strings; - use Ada.Characters; - - - -- The following strings are used in examination of the Translation - -- subprograms. - - New_Character_String : Unb.Unbounded_String := - Unb.To_Unbounded_String( - Latin_1.LC_A_Grave & - Latin_1.LC_A_Ring & - Latin_1.LC_AE_Diphthong & - Latin_1.LC_C_Cedilla & - Latin_1.LC_E_Acute & - Latin_1.LC_I_Circumflex & - Latin_1.LC_Icelandic_Eth & - Latin_1.LC_N_Tilde & - Latin_1.LC_O_Oblique_Stroke & - Latin_1.LC_Icelandic_Thorn); - - - TC_New_Character_String : Unb.Unbounded_String := - Unb.To_Unbounded_String( - Latin_1.UC_A_Grave & - Latin_1.UC_A_Ring & - Latin_1.UC_AE_Diphthong & - Latin_1.UC_C_Cedilla & - Latin_1.UC_E_Acute & - Latin_1.UC_I_Circumflex & - Latin_1.UC_Icelandic_Eth & - Latin_1.UC_N_Tilde & - Latin_1.UC_O_Oblique_Stroke & - Latin_1.UC_Icelandic_Thorn); - - - -- In this test, access objects are defined to refer to two functions - -- from the Ada.Characters.Handling package. These access objects - -- will be provided as parameters to the subprograms under test. - -- Note: There will be several examples in this test of these character - -- handling functions being referenced directly within the - -- parameter list of the subprograms under test. - - Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function := - Handling.To_Lower'Access; - - Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function := - Handling.To_Upper'Access; - - begin - - -- Function Index, Forward direction search. - -- Note: Several of the following cases use the default value - -- Forward for the Going parameter. - - if Unb.Index(Source => Unb.To_Unbounded_String( - "The library package Strings.Unbounded"), - Pattern => "unb", - Going => Ada.Strings.Forward, - Mapping => Map_To_Lower_Case_Ptr) /= 29 or - - Unb.Index(Unb.To_Unbounded_String( - "THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN"), - "ain", - Mapping => Map_To_Lower_Case_Ptr) /= 6 or - - Unb.Index(Unb.To_Unbounded_String("maximum number"), - "um", - Ada.Strings.Forward, - Handling.To_Lower'Access) /= 6 or - - Unb.Index(Unb.To_Unbounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"), - "MIXED CASE STRING", - Ada.Strings.Forward, - Map_To_Upper_Case_Ptr) /= 12 or - - Unb.Index(Unb.To_Unbounded_String( - "STRING WITH NO MATCHING PATTERNS"), - "WITH", - Mapping => Map_To_Lower_Case_Ptr) /= 0 or - - Unb.Index(Unb.To_Unbounded_String("THIS STRING IS IN UPPER CASE"), - "IS", - Ada.Strings.Forward, - Handling.To_Upper'Access) /= 3 or - - Unb.Index(Unb.Null_Unbounded_String, - "is", - Mapping => Map_To_Lower_Case_Ptr) /= 0 or - - Unb.Index(Unb.To_Unbounded_String("AAABBBaaabbb"), - "aabb", - Mapping => Handling.To_Lower'Access) /= 2 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Forward direction, using a Character Mapping " & - "Function parameter"); - end if; - - - - -- Function Index, Backward direction search. - - if Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), - "case", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 17 or - - Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), - "CASE", - Ada.Strings.Backward, - Mapping => Map_To_Upper_Case_Ptr) /= 17 or - - Unb.Index(Unb.To_Unbounded_String("rain, Rain, and more RAIN"), - "rain", - Ada.Strings.Backward, - Handling.To_Lower'Access) /= 22 or - - Unb.Index(Unb.To_Unbounded_String("RIGHT place, right time"), - "RIGHT", - Ada.Strings.Backward, - Handling.To_Upper'Access) /= 14 or - - Unb.Index(Unb.To_Unbounded_String("WOULD MATCH BUT FOR THE CASE"), - "WOULD MATCH BUT FOR THE CASE", - Going => Ada.Strings.Backward, - Mapping => Map_To_Lower_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Index, going " & - "in Backward direction, using a Character Mapping " & - "Function parameter"); - end if; - - - - -- Function Index, Pattern_Error if Pattern = Null_String - - declare - use Unbounded; - Null_String : constant String := ""; - TC_Natural : Natural := 1000; - begin - TC_Natural := Index(To_Unbounded_String("A Valid Unbounded String"), - Null_String, - Going => Ada.Strings.Forward, - Mapping => Handling.To_Lower'Access); - Report.Failed("Pattern_Error not raised by Function Index when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Index " & - "using a Character Mapping Function parameter " & - "when given a null pattern string"); - end; - - - - -- Function Count. - - if Unb.Count(Source => Unb.To_Unbounded_String("ABABABA"), - Pattern => "aba", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - - Unb.Count(Unb.To_Unbounded_String("ABABABA"), - "ABA", - Mapping => Map_To_Lower_Case_Ptr) /= 0 or - - Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"), - "is", - Handling.To_Lower'Access) /= 4 or - - Unb.Count(Unb.To_Unbounded_String("ABABABA"), - "ABA", - Map_To_Upper_Case_Ptr) /= 2 or - - Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"), - "is", - Mapping => Map_To_Upper_Case_Ptr) /= 0 or - - Unb.Count(Unb.To_Unbounded_String( - "She sells sea shells by the sea shore"), - "s", - Handling.To_Lower'Access) /= 8 or - - Unb.Count(Unb.Null_Unbounded_String, - "match", - Map_To_Upper_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Count, using " & - "a Character Mapping Function parameter"); - end if; - - - - -- Function Count, Pattern_Error if Pattern = Null_String - - declare - use Ada.Strings.Unbounded; - Null_Pattern_String : constant String := ""; - TC_Natural : Natural := 1000; - begin - TC_Natural := Count(To_Unbounded_String("A Valid String"), - Null_Pattern_String, - Map_To_Lower_Case_Ptr); - Report.Failed("Pattern_Error not raised by Function Count using " & - "a Character Mapping Function parameter when " & - "given a null pattern string"); - exception - when Pattern_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by Function Count " & - "using a Character Mapping Function parameter " & - "when given a null pattern string"); - end; - - - - -- Function Translate. - - if Unb.Translate(Source => Unb.To_Unbounded_String( - "A Sample Mixed Case String"), - Mapping => Map_To_Lower_Case_Ptr) /= - Unb.To_Unbounded_String("a sample mixed case string") or - - Unb.Translate(Unb.To_Unbounded_String("ALL LOWER CASE"), - Handling.To_Lower'Access) /= - Unb.To_Unbounded_String("all lower case") or - - Unb.Translate(Unb.To_Unbounded_String("end with lower case"), - Map_To_Lower_Case_Ptr) /= - Unb.To_Unbounded_String("end with lower case") or - - Unb.Translate(Unb.Null_Unbounded_String, - Handling.To_Lower'Access) /= - Unb.Null_Unbounded_String or - - Unb.Translate(Unb.To_Unbounded_String("start with lower case"), - Map_To_Upper_Case_Ptr) /= - Unb.To_Unbounded_String("START WITH LOWER CASE") or - - Unb.Translate(Unb.To_Unbounded_String("ALL UPPER CASE STRING"), - Handling.To_Upper'Access) /= - Unb.To_Unbounded_String("ALL UPPER CASE STRING") or - - Unb.Translate(Unb.To_Unbounded_String( - "LoTs Of MiXeD CaSe ChArAcTeRs"), - Map_To_Upper_Case_Ptr) /= - Unb.To_Unbounded_String("LOTS OF MIXED CASE CHARACTERS") or - - Unb.Translate(New_Character_String, - Handling.To_Upper'Access) /= - TC_New_Character_String - - then - Report.Failed("Incorrect results from Function Translate, using " & - "a Character Mapping Function parameter"); - end if; - - - - -- Procedure Translate. - - declare - - use Ada.Strings.Unbounded; - use Ada.Characters.Handling; - - Str_1 : Unbounded_String := - To_Unbounded_String("AN ALL UPPER CASE STRING"); - Str_2 : Unbounded_String := - To_Unbounded_String("A Mixed Case String"); - Str_3 : Unbounded_String := - To_Unbounded_String("a string with lower case letters"); - TC_Str_1 : constant Unbounded_String := Str_1; - TC_Str_3 : constant Unbounded_String := Str_3; - - begin - - Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr); - - if Str_1 /= To_Unbounded_String("an all upper case string") then - Report.Failed("Incorrect result from Procedure Translate - 1"); - end if; - - Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr); - - if Str_1 /= TC_Str_1 then - Report.Failed("Incorrect result from Procedure Translate - 2"); - end if; - - Translate(Str_2, Mapping => Map_To_Lower_Case_Ptr); - - if Str_2 /= To_Unbounded_String("a mixed case string") then - Report.Failed("Incorrect result from Procedure Translate - 3"); - end if; - - Translate(Str_2, Mapping => To_Upper'Access); - - if Str_2 /= To_Unbounded_String("A MIXED CASE STRING") then - Report.Failed("Incorrect result from Procedure Translate - 4"); - end if; - - Translate(Str_3, To_Lower'Access); - - if Str_3 /= TC_Str_3 then - Report.Failed("Incorrect result from Procedure Translate - 5"); - end if; - - Translate(Str_3, To_Upper'Access); - - if Str_3 /= - To_Unbounded_String("A STRING WITH LOWER CASE LETTERS") - then - Report.Failed("Incorrect result from Procedure Translate - 6"); - end if; - - Translate(New_Character_String, Map_To_Upper_Case_Ptr); - - if New_Character_String /= TC_New_Character_String then - Report.Failed("Incorrect result from Procedure Translate - 6"); - end if; - - end; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4030; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a deleted file mode 100644 index 91bc68ce6e7..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a +++ /dev/null @@ -1,291 +0,0 @@ --- CXA4031.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 subprograms defined in package Ada.Strings.Unbounded --- are available, and that they produce correct results. Specifically, --- check the functions To_Unbounded_String (version with Length --- parameter), "=", "<", "<=", ">", ">=" (all with String-Unbounded --- String parameter mix), as well as three versions of Procedure Append. --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the subprograms defined --- in package Ada.Strings.Unbounded for use with unbounded strings. --- The test simulates how unbounded strings could be processed in a --- user environment, using the subprograms provided in this package. --- --- This test, when taken in conjunction with tests CXA4010, CXA4011, --- CXA4030, and CXA4032 will constitute a test of all the functionality --- contained in package Ada.Strings.Unbounded. This test uses a variety --- of the subprograms defined in the unbounded string package in ways --- typical of common usage. --- --- --- CHANGE HISTORY: --- 27 Feb 95 SAIC Initial prerelease version. --- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -with Report; -with Ada.Exceptions; -with Ada.Strings.Maps; -with Ada.Strings.Unbounded; - -procedure CXA4031 is -begin - - Report.Test ("CXA4031", "Check that the subprograms defined in " & - "package Ada.Strings.Unbounded are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package Unb renames Ada.Strings.Unbounded; - use Unb; - use Ada.Exceptions; - - subtype LC_Characters is Character range 'a'..'z'; - - Null_String : constant String := ""; - TC_String : constant String := "A Standard String"; - - TC_Unb_String, - TC_New_Unb_String : Unb.Unbounded_String := Unb.Null_Unbounded_String; - - begin - - -- Function To_Unbounded_String (version with Length parameter) - -- returns an unbounded string that represents an uninitialized String - -- whose length is Length. - -- Note: Unbounded_String length can vary conceptually between 0 and - -- Natural'Last. - - if Unb.Length(Unb.To_Unbounded_String(Length => 10)) /= 10 or - Unb.Length(Unb.To_Unbounded_String(1)) /= 1 or - Unb.Length(Unb.To_Unbounded_String(0)) /= 0 or - Unb.Length(Unb."&"(Unb.To_Unbounded_String(Length => 10), - Unb."&"(Unb.To_Unbounded_String(1), - Unb.To_Unbounded_String(0) ))) /= 10+1+0 - then - Report.Failed - ("Incorrect results from Function To_Unbounded_String with " & - "Length parameter"); - end if; - - - -- Procedure Append (Unbounded - Unbounded) - -- Note: For each of the Append procedures, the resulting string - -- represented by the Source parameter is given by the - -- concatenation of the original value of Source and the value - -- of New_Item. - - TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L"); - TC_New_Unb_String := Unb.To_Unbounded_String(" and then some"); - - Unb.Append(Source => TC_Unb_String, New_Item => TC_New_Unb_String); - - if TC_Unb_String /= - Unb.To_Unbounded_String("Sample string of length L and then some") - then - Report.Failed("Incorrect results from Procedure Append with " & - "unbounded string parameters - 1"); - end if; - - - TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L"); - TC_New_Unb_String := Unb.Null_Unbounded_String; - - Unb.Append(TC_Unb_String, TC_New_Unb_String); - - if TC_Unb_String /= - Unb.To_Unbounded_String("Sample string of length L") - then - Report.Failed("Incorrect results from Procedure Append with " & - "unbounded string parameters - 2"); - end if; - - - TC_Unb_String := Unb.Null_Unbounded_String; - - Unb.Append(TC_Unb_String, - Unb.To_Unbounded_String("New Unbounded String")); - - if TC_Unb_String /= - Unb.To_Unbounded_String("New Unbounded String") - then - Report.Failed("Incorrect results from Procedure Append with " & - "unbounded string parameters - 3"); - end if; - - - -- Procedure Append (Unbounded - String) - - TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String and "); - - Unb.Append(Source => TC_Unb_String, New_Item => TC_String); - - if TC_Unb_String /= - Unb.To_Unbounded_String("An Unbounded String and A Standard String") - then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded string parameter and a string " & - "parameter - 1"); - end if; - - - TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String"); - - Unb.Append(TC_Unb_String, New_Item => Null_String); - - if TC_Unb_String /= - Unb.To_Unbounded_String("An Unbounded String") - then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded string parameter and a string " & - "parameter - 2"); - end if; - - - TC_Unb_String := Unb.Null_Unbounded_String; - - Unb.Append(TC_Unb_String, TC_String); - - if TC_Unb_String /= Unb.To_Unbounded_String("A Standard String") then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded string parameter and a string " & - "parameter - 3"); - end if; - - - -- Procedure Append (Unbounded - Character) - - TC_Unb_String := Unb.To_Unbounded_String("Lower Case = "); - - for i in LC_Characters'Range loop - Unb.Append(Source => TC_Unb_String, New_Item => LC_Characters(i)); - end loop; - - if TC_Unb_String /= - Unb.To_Unbounded_String("Lower Case = abcdefghijklmnopqrstuvwxyz") - then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded string parameter and a character " & - "parameter - 1"); - end if; - - - TC_Unb_String := Unb.Null_Unbounded_String; - - Unb.Append(TC_Unb_String, New_Item => 'a'); - - if TC_Unb_String /= Unb.To_Unbounded_String("a") then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded string parameter and a character " & - "parameter - 2"); - end if; - - - -- Function "=" - - TC_Unb_String := Unb.To_Unbounded_String(TC_String); - - if not (TC_Unb_String = TC_String) or -- (Unb_Str, Str) - not Unb."="("A Standard String", TC_Unb_String) or -- (Str, Unb_Str) - not ((Unb.Null_Unbounded_String = "") and -- (Unb_Str, Str) - ("Test String" = -- (Str, Unb_Str) - Unb.To_Unbounded_String("Test String"))) - then - Report.Failed("Incorrect results from function ""="" with " & - "string - unbounded string parameter combinations"); - end if; - - - -- Function "<" - - if not ("Extra Space" < Unb.To_Unbounded_String("Extra Space ") and - Unb.To_Unbounded_String("tess") < "test" and - Unb.To_Unbounded_String("best") < "test") or - Unb.Null_Unbounded_String < Null_String or - " leading blank" < Unb.To_Unbounded_String(" leading blank") or - "ending blank " < Unb.To_Unbounded_String("ending blank ") - then - Report.Failed("Incorrect results from function ""<"" with " & - "string - unbounded string parameter combinations"); - end if; - - - -- Function "<=" - - TC_Unb_String := Unb.To_Unbounded_String("Sample string"); - - if TC_Unb_String <= "Sample strin" or -- (Unb_Str, Str) - "sample string" <= TC_Unb_String or -- (Str, Unb_Str) - not(Unb.Null_Unbounded_String <= "") or -- (Unb_Str, Str) - not("Sample string" <= TC_Unb_String) -- (Str, Unb_Str) - then - Report.Failed("Incorrect results from function ""<="" with " & - "string - unbounded string parameter combinations"); - end if; - - - -- Function ">" - - TC_Unb_String := Unb.To_Unbounded_String("A MUCH LONGER STRING"); - - if not ("A much longer string" > TC_Unb_String and - Unb.To_Unbounded_String(TC_String) > "A Standard Strin" and - "abcdefgh" > Unb.To_Unbounded_String("ABCDEFGH")) or - Unb.Null_Unbounded_String > Null_String - then - Report.Failed("Incorrect results from function "">"" with " & - "string - unbounded string parameter combinations"); - end if; - - - -- Function ">=" - - TC_Unb_String := Unb.To_Unbounded_String(TC_String); - - if not (TC_Unb_String >= TC_String and - Null_String >= Unb.Null_Unbounded_String and - "test" >= Unb.To_Unbounded_String("tess") and - Unb.To_Unbounded_String("Programming") >= "PROGRAMMING") - then - Report.Failed("Incorrect results from function "">="" with " & - "string - unbounded string parameter combinations"); - 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 CXA4031; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a deleted file mode 100644 index 031d01c6cb7..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a +++ /dev/null @@ -1,457 +0,0 @@ --- CXA4032.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 procedures defined in package Ada.Strings.Unbounded --- are available, and that they produce correct results. Specifically, --- check the procedures Replace_Slice, Insert, Overwrite, Delete, --- Trim (2 versions), Head, and Tail. --- --- TEST DESCRIPTION: --- This test demonstrates the uses of many of the procedures defined --- in package Ada.Strings.Unbounded for use with unbounded strings. --- The test simulates how unbounded strings could be processed in a --- user environment, using the procedures provided in this package. --- --- This test, when taken in conjunction with tests CXA4010, CXA4011, --- CXA4030, and CXA4031 will constitute a test of all the functionality --- contained in package Ada.Strings.Unbounded. This test uses a variety --- of the procedures defined in the unbounded string package in ways --- typical of common usage. --- --- --- CHANGE HISTORY: --- 02 Mar 95 SAIC Initial prerelease version. --- ---! - -with Report; -with Ada.Strings; -with Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; -with Ada.Strings.Unbounded; - -procedure CXA4032 is -begin - - Report.Test ("CXA4032", "Check that the subprograms defined in " & - "package Ada.Strings.Unbounded are available, " & - "and that they produce correct results"); - - Test_Block: - declare - - package Unb renames Ada.Strings.Unbounded; - use Unb; - use Ada.Strings; - - TC_Null_String : constant String := ""; - TC_String_5 : String(1..5) := "ABCDE"; - - TC_Unb_String : Unb.Unbounded_String := - Unb.To_Unbounded_String("Test String"); - - begin - - -- Procedure Replace_Slice - - begin -- Low > Source'Last+1 - Unb.Replace_Slice(Source => TC_Unb_String, - Low => Unb.Length(TC_Unb_String) + 2, - High => Unb.Length(TC_Unb_String), - By => TC_String_5); - Report.Failed("Index_Error not raised by Replace_Slice when Low " & - "> Source'Last+1"); - exception - when Index_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Replace_Slice" & - "when Low > Source'Last+1"); - end; - - -- High >= Low - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Replace_Slice(TC_Unb_String, 5, 5, TC_String_5); - - if TC_Unb_String /= Unb.To_Unbounded_String("TestABCDEString") then - Report.Failed("Incorrect results from Replace_Slice - 1"); - end if; - - Unb.Replace_Slice(TC_Unb_String, 1, 4, TC_String_5); - - if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDEString") then - Report.Failed("Incorrect results from Replace_Slice - 2"); - end if; - - Unb.Replace_Slice(TC_Unb_String, - 11, - Unb.Length(TC_Unb_String), - TC_Null_String); - - if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDE") then - Report.Failed("Incorrect results from Replace_Slice - 3"); - end if; - - -- High < Low - - Unb.Replace_Slice(TC_Unb_String, Low => 4, High => 1, By => "xxx"); - - if TC_Unb_String /= Unb.To_Unbounded_String("ABCxxxDEABCDE") then - Report.Failed("Incorrect results from Replace_Slice - 4"); - end if; - - Unb.Replace_Slice(TC_Unb_String, Low => 1, High => 0, By => "yyy"); - - if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDE") then - Report.Failed("Incorrect results from Replace_Slice - 5"); - end if; - - Unb.Replace_Slice(TC_Unb_String, - Unb.Length(TC_Unb_String) + 1, - Unb.Length(TC_Unb_String), - By => "zzz"); - - if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDEzzz") then - Report.Failed("Incorrect results from Replace_Slice - 6"); - end if; - - - -- Procedure Insert - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - begin -- Before not in Source'First..Source'Last + 1 - Unb.Insert(Source => TC_Unb_String, - Before => Unb.Length(TC_Unb_String) + 2, - New_Item => TC_String_5); - Report.Failed("Index_Error not raised by Insert when Before " & - "not in the range Source'First..Source'Last+1"); - exception - when Index_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Unexpected exception raised by Insert when Before not in " & - "the range Source'First..Source'Last+1"); - end; - - Unb.Insert(TC_Unb_String, 1, "**"); - - if TC_Unb_String /= Unb.To_Unbounded_String("**Test String") then - Report.Failed("Incorrect results from Insert - 1"); - end if; - - Unb.Insert(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**"); - - if TC_Unb_String /= Unb.To_Unbounded_String("**Test String**") then - Report.Failed("Incorrect results from Insert - 2"); - end if; - - Unb.Insert(TC_Unb_String, 8, "---"); - - if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then - Report.Failed("Incorrect results from Insert - 3"); - end if; - - Unb.Insert(TC_Unb_String, 3, TC_Null_String); - - if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then - Report.Failed("Incorrect results from Insert - 4"); - end if; - - - -- Procedure Overwrite - - begin -- Position not in Source'First..Source'Last + 1 - Unb.Overwrite(Source => TC_Unb_String, - Position => Unb.Length(TC_Unb_String) + 2, - New_Item => TC_String_5); - Report.Failed("Index_Error not raised by Overwrite when Position " & - "not in the range Source'First..Source'Last+1"); - exception - when Index_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Unexpected exception raised by Overwrite when Position not " & - "in the range Source'First..Source'Last+1"); - end; - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Overwrite(Source => TC_Unb_String, - Position => 1, - New_Item => "XXXX"); - - if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String") then - Report.Failed("Incorrect results from Overwrite - 1"); - end if; - - Unb.Overwrite(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**"); - - if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then - Report.Failed("Incorrect results from Overwrite - 2"); - end if; - - Unb.Overwrite(TC_Unb_String, 3, TC_Null_String); - - if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then - Report.Failed("Incorrect results from Overwrite - 3"); - end if; - - Unb.Overwrite(TC_Unb_String, 1, "abcdefghijklmn"); - - if TC_Unb_String /= Unb.To_Unbounded_String("abcdefghijklmn") then - Report.Failed("Incorrect results from Overwrite - 4"); - end if; - - - -- Procedure Delete - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - -- From > Through (No change to Source) - - Unb.Delete(Source => TC_Unb_String, - From => Unb.Length(TC_Unb_String), - Through => Unb.Length(TC_Unb_String)-1); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then - Report.Failed("Incorrect results from Delete - 1"); - end if; - - Unb.Delete(TC_Unb_String, 1, 0); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then - Report.Failed("Incorrect results from Delete - 2"); - end if; - - -- From <= Through - - Unb.Delete(TC_Unb_String, 1, 5); - - if TC_Unb_String /= Unb.To_Unbounded_String("String") then - Report.Failed("Incorrect results from Delete - 3"); - end if; - - Unb.Delete(TC_Unb_String, 3, 3); - - if TC_Unb_String /= Unb.To_Unbounded_String("Sting") then - Report.Failed("Incorrect results from Delete - 4"); - end if; - - - -- Procedure Trim - - TC_Unb_String := Unb.To_Unbounded_String("No Spaces"); - - Unb.Trim(Source => TC_Unb_String, Side => Ada.Strings.Both); - - if TC_Unb_String /= Unb.To_Unbounded_String("No Spaces") then - Report.Failed("Incorrect results from Trim - 1"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String(" Leading Spaces "); - - Unb.Trim(TC_Unb_String, Ada.Strings.Left); - - if TC_Unb_String /= Unb.To_Unbounded_String("Leading Spaces ") then - Report.Failed("Incorrect results from Trim - 2"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String(" Ending Spaces "); - - Unb.Trim(TC_Unb_String, Ada.Strings.Right); - - if TC_Unb_String /= Unb.To_Unbounded_String(" Ending Spaces") then - Report.Failed("Incorrect results from Trim - 3"); - end if; - - TC_Unb_String := - Unb.To_Unbounded_String(" Spaces on both ends "); - - Unb.Trim(TC_Unb_String, Ada.Strings.Both); - - if TC_Unb_String /= - Unb.To_Unbounded_String("Spaces on both ends") - then - Report.Failed("Incorrect results from Trim - 4"); - end if; - - - -- Procedure Trim (with Character Set parameters) - - TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters"); - - Unb.Trim(Source => TC_Unb_String, - Left => Ada.Strings.Maps.Constants.Lower_Set, - Right => Ada.Strings.Maps.Constants.Lower_Set); - - if TC_Unb_String /= Unb.To_Unbounded_String("CASE") then - Report.Failed("Incorrect results from Trim with Sets - 1"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters"); - - Unb.Trim(TC_Unb_String, - Ada.Strings.Maps.Constants.Upper_Set, - Ada.Strings.Maps.Constants.Upper_Set); - - if TC_Unb_String /= Unb.To_Unbounded_String("lowerCASEletters") then - Report.Failed("Incorrect results from Trim with Sets - 2"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("012abcdefghGFEDCBA789ab"); - - Unb.Trim(TC_Unb_String, - Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set, - Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set); - - if TC_Unb_String /= Unb.To_Unbounded_String("ghG") then - Report.Failed("Incorrect results from Trim with Sets - 3"); - end if; - - - -- Procedure Head - - -- Count <= Source'Length - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Head(Source => TC_Unb_String, - Count => 0, - Pad => '*'); - - if TC_Unb_String /= Unb.Null_Unbounded_String then - Report.Failed("Incorrect results from Head - 1"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Head(Source => TC_Unb_String, - Count => 4, - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test") then - Report.Failed("Incorrect results from Head - 2"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Head(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String), - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then - Report.Failed("Incorrect results from Head - 3"); - end if; - - -- Count > Source'Length - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Head(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String) + 4, - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test String****") then - Report.Failed("Incorrect results from Head - 4"); - end if; - - TC_Unb_String := Unb.Null_Unbounded_String; - - Unb.Head(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String) + 3, - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("***") then - Report.Failed("Incorrect results from Head - 5"); - end if; - - - -- Procedure Tail - - -- Count <= Source'Length - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Tail(Source => TC_Unb_String, - Count => 0, - Pad => '*'); - - if TC_Unb_String /= Unb.Null_Unbounded_String then - Report.Failed("Incorrect results from Tail - 1"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Tail(Source => TC_Unb_String, - Count => 6, - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("String") then - Report.Failed("Incorrect results from Tail - 2"); - end if; - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Tail(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String), - Pad => '*'); - - if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then - Report.Failed("Incorrect results from Tail - 3"); - end if; - - -- Count > Source'Length - - TC_Unb_String := Unb.To_Unbounded_String("Test String"); - - Unb.Tail(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String) + 5, - Pad => 'x'); - - if TC_Unb_String /= Unb.To_Unbounded_String("xxxxxTest String") then - Report.Failed("Incorrect results from Tail - 4"); - end if; - - TC_Unb_String := Unb.Null_Unbounded_String; - - Unb.Tail(Source => TC_Unb_String, - Count => Unb.Length(TC_Unb_String) + 3, - Pad => 'X'); - - if TC_Unb_String /= Unb.To_Unbounded_String("XXX") then - Report.Failed("Incorrect results from Tail - 5"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4032; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a deleted file mode 100644 index 8f39b4cff05..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a +++ /dev/null @@ -1,405 +0,0 @@ --- CXA4033.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 found in packages Ada.Strings.Wide_Maps, --- Ada.Strings.Wide_Unbounded, and Ada.Strings.Wide_Maps.Wide_Constants --- is available and produces correct results. --- --- TEST DESCRIPTION: --- This test tests the subprograms found in the --- Ada.Strings.Wide_Unbounded package. It is based on the tests --- CXA4030-32, which are tests for the complementary "non-wide" --- packages. --- --- The functions found in CXA4033_0 provide mapping capability, when --- used in conjunction with Wide_Character_Mapping_Function objects. --- --- --- CHANGE HISTORY: --- 23 Jun 95 SAIC Initial prerelease version. --- 24 Feb 97 PWB.CTA Removed attempt to create wide string of length --- Natural'Last ---! - -package CXA4033_0 is - -- Functions used to supply mapping capability. - function Map_To_Lower_Case (From : Wide_Character) return Wide_Character; - function Map_To_Upper_Case (From : Wide_Character) return Wide_Character; -end CXA4033_0; - -with Ada.Characters.Handling; -package body CXA4033_0 is - -- Function Map_To_Lower_Case will return the lower case form of - -- Wide_Characters in the range 'A'..'Z' only, and return the input - -- wide_character otherwise. - - function Map_To_Lower_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Lower( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Lower_Case; - - -- Function Map_To_Upper_Case will return the upper case form of - -- Wide_Characters in the range 'a'..'z', or whose position is in one - -- of the ranges 223..246 or 248..255, provided the wide_character has - -- an upper case form. - - function Map_To_Upper_Case (From : Wide_Character) - return Wide_Character is - begin - return Ada.Characters.Handling.To_Wide_Character( - Ada.Characters.Handling.To_Upper( - Ada.Characters.Handling.To_Character(From))); - end Map_To_Upper_Case; - -end CXA4033_0; - - -with CXA4033_0; -with Report; -with Ada.Characters.Handling; -with Ada.Characters.Latin_1; -with Ada.Strings; -with Ada.Strings.Wide_Maps; -with Ada.Strings.Wide_Maps.Wide_Constants; -with Ada.Strings.Wide_Fixed; -with Ada.Strings.Wide_Unbounded; - -procedure CXA4033 is -begin - Report.Test ("CXA4033", - "Check that subprograms defined in the package " & - "Ada.Strings.Wide_Unbounded produce correct results"); - - Test_Block: - declare - - package ACL1 renames Ada.Characters.Latin_1; - package Unb renames Ada.Strings.Wide_Unbounded; - - subtype LC_Characters is Wide_Character range 'a'..'z'; - - use Ada.Characters, Ada.Strings, Unb; - use type Wide_Maps.Wide_Character_Set; - - TC_String : constant Wide_String := "A Standard String"; - - String_20 : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST"; - String_40 : Wide_String(1..40) := "abcdefghijklmnopqrst" & - String_20; - String_80 : Wide_String(1..80) := String_40 & String_40; - TC_String_5 : Wide_String(1..5) := "ABCDE"; - TC_Unb_String : Unbounded_Wide_String := Null_Unbounded_Wide_String; - - -- The following strings are used in examination of the Translation - -- subprograms. - New_Character_String : Wide_String(1..10) := - Handling.To_Wide_String( - ACL1.LC_A_Grave & ACL1.LC_A_Ring & ACL1.LC_AE_Diphthong & - ACL1.LC_C_Cedilla & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex & - ACL1.LC_Icelandic_Eth & ACL1.LC_N_Tilde & - ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn); - - TC_New_Character_String : Wide_String(1..10) := - Handling.To_Wide_String( - ACL1.UC_A_Grave & ACL1.UC_A_Ring & ACL1.UC_AE_Diphthong & - ACL1.UC_C_Cedilla & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex & - ACL1.UC_Icelandic_Eth & ACL1.UC_N_Tilde & - ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn); - - New_UB_Character_String : Unbounded_Wide_String := - To_Unbounded_Wide_String(New_Character_String); - - TC_New_UB_Character_String : Unbounded_Wide_String := - To_Unbounded_Wide_String(TC_New_Character_String); - - -- Access objects that will be provided as parameters to the - -- subprograms. - Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4033_0.Map_To_Lower_Case'Access; - Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function := - CXA4033_0.Map_To_Upper_Case'Access; - - begin - - -- Testing functionality found in Package Ada.Strings.Wide_Unbounded. - -- - -- Function Index. - - if Index(To_Unbounded_Wide_String("AAABBBaaabbb"), - "aabb", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - Index(To_Unbounded_Wide_String("Case of a Mixed Case String"), - "case", - Ada.Strings.Backward, - Map_To_Lower_Case_Ptr) /= 17 - then - Report.Failed("Incorrect results from Function Index, " & - "using a Wide Character Mapping Function parameter"); - end if; - - -- Function Count. - if Count(Source => To_Unbounded_Wide_String("ABABABA"), - Pattern => "aba", - Mapping => Map_To_Lower_Case_Ptr) /= 2 or - Count(Null_Unbounded_Wide_String, "mat", Map_To_Upper_Case_Ptr) /= 0 - then - Report.Failed("Incorrect results from Function Count, using " & - "a Character Mapping Function parameter"); - end if; - - -- Function Translate. - if Translate(To_Unbounded_Wide_String("A Sample Mixed Case String"), - Mapping => Map_To_Lower_Case_Ptr) /= - To_Unbounded_Wide_String("a sample mixed case string") or - Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr) /= - TC_New_UB_Character_String - then - Report.Failed("Incorrect results from Function Translate, " & - "using a Character Mapping Function parameter"); - end if; - - -- Procedure Translate. - declare - use Ada.Characters.Handling; - Str : Unbounded_Wide_String := - To_Unbounded_Wide_String("AN ALL UPPER CASE STRING"); - begin - Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr); - if Str /= To_Unbounded_Wide_String("an all upper case string") then - Report.Failed("Incorrect result from Procedure Translate 1"); - end if; - - Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr); - if New_UB_Character_String /= TC_New_UB_Character_String then - Report.Failed("Incorrect result from Procedure Translate 2"); - end if; - end; - - -- Function To_Unbounded_Wide_String (version with Length parameter) - if Length(To_Unbounded_Wide_String(Length => 10)) /= 10 or - Length(To_Unbounded_Wide_String(0)) /= 0 or - Length( To_Unbounded_Wide_String(10) & - To_Unbounded_Wide_String(1) & - To_Unbounded_Wide_String(0) ) /= 10 + 1 + 0 - then - Report.Failed - ("Incorrect results from Function To_Unbounded_Wide_String " & - "with Length parameter"); - end if; - - -- Procedure Append (Wide_Unbounded - Wide_Unbounded) - TC_Unb_String := Null_Unbounded_Wide_String; - Append(TC_Unb_String, To_Unbounded_Wide_String("New Unbounded String")); - if TC_Unb_String /= To_Unbounded_Wide_String("New Unbounded String") - then - Report.Failed("Incorrect results from Procedure Append with " & - "unbounded wide string parameters"); - end if; - - - -- Procedure Append (Wide_Unbounded - Wide_String) - TC_Unb_String := To_Unbounded_Wide_String("An Unbounded String and "); - Append(Source => TC_Unb_String, New_Item => TC_String); - if TC_Unb_String /= - To_Unbounded_Wide_String("An Unbounded String and A Standard String") - then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded wide string parameter and a wide " & - "string parameter"); - end if; - - -- Procedure Append (Wide_Unbounded - Wide_Character) - TC_Unb_String := To_Unbounded_Wide_String("Lower Case = "); - for i in LC_Characters'Range loop - Append(Source => TC_Unb_String, New_Item => LC_Characters(i)); - end loop; - if TC_Unb_String /= - Unb.To_Unbounded_Wide_String - ("Lower Case = abcdefghijklmnopqrstuvwxyz") - then - Report.Failed("Incorrect results from Procedure Append with " & - "an unbounded wide string parameter and a wide " & - "character parameter"); - end if; - - -- Function "=" - TC_Unb_String := To_Unbounded_Wide_String(TC_String); - if not (TC_Unb_String = TC_String) or - not "="("A Standard String", TC_Unb_String) or - not ((Null_Unbounded_Wide_String = "") and - ("Test String" = To_Unbounded_Wide_String("Test String"))) - then - Report.Failed("Incorrect results from Function ""="" with " & - "wide_string - unbounded wide string parameters"); - end if; - - -- Function "<" - if not ("Extra Space" < To_Unbounded_Wide_String("Extra Space ") and - To_Unbounded_Wide_String("tess") < "test" and - To_Unbounded_Wide_String("best") < "test") - then - Report.Failed("Incorrect results from Function ""<"" with " & - "wide string - unbounded wide string parameters"); - end if; - - -- Function "<=" - TC_Unb_String := To_Unbounded_Wide_String("Sample string"); - if TC_Unb_String <= "Sample strin" or - not("Sample string" <= TC_Unb_String) - then - Report.Failed("Incorrect results from Function ""<="" with " & - "wide string - unbounded wide string parameters"); - end if; - - -- Function ">" - TC_Unb_String := To_Unbounded_Wide_String("A MUCH LONGER STRING"); - if not ("A much longer string" > TC_Unb_String and - To_Unbounded_Wide_String(TC_String) > "A Standard Strin" and - "abcdefgh" > To_Unbounded_Wide_String("ABCDEFGH")) - then - Report.Failed("Incorrect results from Function "">"" with " & - "wide string - unbounded wide string parameters"); - end if; - - -- Function ">=" - TC_Unb_String := To_Unbounded_Wide_String(TC_String); - if not (TC_Unb_String >= TC_String and - "test" >= To_Unbounded_Wide_String("tess") and - To_Unbounded_Wide_String("Programming") >= "PROGRAMMING") - then - Report.Failed("Incorrect results from Function "">="" with " & - "wide string - unbounded wide string parameters"); - end if; - - -- Procedure Replace_Slice - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Replace_Slice(TC_Unb_String, 5, 5, TC_String_5); - if TC_Unb_String /= To_Unbounded_Wide_String("TestABCDEString") then - Report.Failed("Incorrect results from Replace_Slice - 1"); - end if; - - Replace_Slice(TC_Unb_String, 1, 4, TC_String_5); - if TC_Unb_String /= To_Unbounded_Wide_String("ABCDEABCDEString") then - Report.Failed("Incorrect results from Replace_Slice - 2"); - end if; - - -- Procedure Insert - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Insert(TC_Unb_String, 1, "**"); - if TC_Unb_String /= To_Unbounded_Wide_String("**Test String") then - Report.Failed("Incorrect results from Procedure Insert - 1"); - end if; - - Insert(TC_Unb_String, Length(TC_Unb_String)+1, "**"); - if TC_Unb_String /= To_Unbounded_Wide_String("**Test String**") then - Report.Failed("Incorrect results from Procedure Insert - 2"); - end if; - - -- Procedure Overwrite - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Overwrite(TC_Unb_String, 1, New_Item => "XXXX"); - if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String") then - Report.Failed("Incorrect results from Procedure Overwrite - 1"); - end if; - - Overwrite(TC_Unb_String, Length(TC_Unb_String)+1, "**"); - if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String**") then - Report.Failed("Incorrect results from Procedure Overwrite - 2"); - end if; - - -- Procedure Delete - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Delete(TC_Unb_String, 1, 0); - if TC_Unb_String /= To_Unbounded_Wide_String("Test String") then - Report.Failed("Incorrect results from Procedure Delete - 1"); - end if; - - Delete(TC_Unb_String, 1, 5); - if TC_Unb_String /= To_Unbounded_Wide_String("String") then - Report.Failed("Incorrect results from Procedure Delete - 2"); - end if; - - -- Procedure Trim - TC_Unb_String := To_Unbounded_Wide_String(" Leading Spaces "); - Trim(TC_Unb_String, Ada.Strings.Left); - if TC_Unb_String /= To_Unbounded_Wide_String("Leading Spaces ") then - Report.Failed("Incorrect results from Procedure Trim - 1"); - end if; - - TC_Unb_String := - To_Unbounded_Wide_String(" Spaces on both ends "); - Trim(TC_Unb_String, Ada.Strings.Both); - if TC_Unb_String /= - To_Unbounded_Wide_String("Spaces on both ends") - then - Report.Failed("Incorrect results from Procedure Trim - 2"); - end if; - - -- Procedure Trim (with Wide_Character_Set parameters) - TC_Unb_String := To_Unbounded_Wide_String("012abcdefghGFEDCBA789ab"); - Trim(TC_Unb_String, - Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set, - Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set); - if TC_Unb_String /= To_Unbounded_Wide_String("ghG") then - Report.Failed("Incorrect results from Procedure Trim with Sets"); - end if; - - -- Procedure Head - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Head(Source => TC_Unb_String, Count => 0, Pad => '*'); - if TC_Unb_String /= Null_Unbounded_Wide_String then - Report.Failed("Incorrect results from Procedure Head - 1"); - end if; - - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Head(Source => TC_Unb_String, Count => 4, Pad => '*'); - if TC_Unb_String /= To_Unbounded_Wide_String("Test") then - Report.Failed("Incorrect results from Procedure Head - 2"); - end if; - - -- Procedure Tail - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Tail(Source => TC_Unb_String, Count => 0, Pad => '*'); - if TC_Unb_String /= Null_Unbounded_Wide_String then - Report.Failed("Incorrect results from Procedure Tail - 1"); - end if; - - TC_Unb_String := To_Unbounded_Wide_String("Test String"); - Tail(TC_Unb_String, Length(TC_Unb_String) + 5, 'x'); - if TC_Unb_String /= To_Unbounded_Wide_String("xxxxxTest String") then - Report.Failed("Incorrect results from Procedure Tail - 2"); - end if; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA4033; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a b/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a deleted file mode 100644 index a1ed53de0f7..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a +++ /dev/null @@ -1,281 +0,0 @@ --- CXA4034.A --- --- Grant of Unlimited Rights --- --- The Ada Conformity Assessment Authority (ACAA) holds unlimited --- rights in the software and documentation contained herein. Unlimited --- rights are the same as those granted by the U.S. Government for older --- parts of the Ada Conformity Assessment Test Suite, and are defined --- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA --- intends to confer upon all recipients unlimited rights equal to those --- held by the ACAA. 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.Strings.Bounded.Slice raises Index_Error if --- High > Length (Source) or Low > Length (Source) + 1. --- (Defect Report 8652/0049). --- --- Check that Ada.Strings.Wide_Bounded.Slice raises Index_Error if --- High > Length (Source) or Low > Length (Source) + 1. --- --- CHANGE HISTORY: --- 12 FEB 2001 PHL Initial version --- 14 MAR 2001 RLB Added Wide_Bounded subtest. --- ---! -with Ada.Exceptions; -use Ada.Exceptions; -with Ada.Strings.Bounded; -with Ada.Strings.Wide_Bounded; -use Ada.Strings; -with Report; -use Report; -procedure CXA4034 is - - package Bs is new Ada.Strings.Bounded.Generic_Bounded_Length (40); - - package WBs is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length (32); - - Source : String (Ident_Int (1) .. Ident_Int (30)); - - Wide_Source : Wide_String (Ident_Int (1) .. Ident_Int (24)); - - X : Bs.Bounded_String; - - WX : WBs.Bounded_Wide_String; - -begin - Test ("CXA4034", - "Check that Slice raises Index_Error if either Low or High is " & - "greater than the Length(Source) for Ada.Strings.Bounded and " & - "Ada.Strings.Wide_Bounded"); - - -- Fill Source with "ABC..." - for I in Source'Range loop - Source (I) := Ident_Char (Character'Val (I + - Character'Pos ('A') - Source'First)); - end loop; - -- and W with "ABC..." - for I in Wide_Source'Range loop - Wide_Source (I) := Ident_Wide_Char (Wide_Character'Val (I + - Wide_Character'Pos ('A') - Wide_Source'First)); - end loop; - - X := Bs.To_Bounded_String (Source); - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (28), High => Ident_Int (41)); - begin - Failed ("No exception raised by Slice - 1"); - if S = Source then - Comment ("Don't optimize S"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 1"); - end; - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (8), High => Ident_Int (31)); - begin - Failed ("No exception raised by Slice - 2"); - if S = Source then - Comment ("Don't optimize S"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 2"); - end; - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (15), High => Ident_Int (30)); - begin - if S /= Source(15..30) then - Failed ("Wrong result - 3"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 3"); - end; - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (42), High => Ident_Int (28)); - begin - Failed ("No exception raised by Slice - 4"); - if S = Source then - Comment ("Don't optimize S"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 4"); - end; - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (31), High => Ident_Int (28)); - begin - if S /= "" then - Failed ("Wrong result - 5"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 5"); - end; - - begin - declare - S : constant String := - Bs.Slice (X, Low => Ident_Int (30), High => Ident_Int (30)); - begin - if S /= Source(30..30) then - Failed ("Wrong result - 6"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 6"); - end; - - WX := WBs.To_Bounded_Wide_String (Wide_Source); - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (21), High => Ident_Int (33)); - begin - Failed ("No exception raised by Slice - 7"); - if W = Wide_Source then - Comment ("Don't optimize W"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 7"); - end; - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (8), High => Ident_Int (25)); - begin - Failed ("No exception raised by Slice - 8"); - if W = Wide_Source then - Comment ("Don't optimize W"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 8"); - end; - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (15), High => Ident_Int (24)); - begin - if W /= Wide_Source(15..24) then - Failed ("Wrong result - 8"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 9"); - end; - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (36), High => Ident_Int (20)); - begin - Failed ("No exception raised by Slice - 10"); - if W = Wide_Source then - Comment ("Don't optimize W"); - end if; - end; - exception - when Index_Error => - null; -- Expected exception. - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 10"); - end; - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (25), High => Ident_Int (21)); - begin - if W /= "" then - Failed ("Wrong result - 11"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 11"); - end; - - begin - declare - W : constant Wide_String := - WBs.Slice (WX, Low => Ident_Int (24), High => Ident_Int (24)); - begin - if W /= Wide_Source(24..24) then - Failed ("Wrong result - 12"); - end if; - end; - exception - when E: others => - Failed ("Exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E) & " - 12"); - end; - - Result; -end CXA4034; - diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a deleted file mode 100644 index c9a007e524f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a +++ /dev/null @@ -1,471 +0,0 @@ --- CXA5011.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, for both Float_Random and Discrete_Random packages, --- the following are true: --- 1) two objects of type Generator are initialized to the same state. --- 2) when the Function Reset is used to reset two generators --- to different time-dependent states, the resulting random values --- from each generator are different. --- 3) when the Function Reset uses the same integer initiator --- to reset two generators to the same state, the resulting random --- values from each generator are identical. --- 4) when the Function Reset uses different integer initiator --- values to reset two generators, the resulting random numbers are --- different. --- --- TEST DESCRIPTION: --- This test evaluates components of the Ada.Numerics.Float_Random and --- Ada.Numerics.Discrete_Random packages. --- This test checks to see that objects of type Generator are initialized --- to the same state. In addition, the functionality of Function Reset is --- validated. --- For each of the objectives above, evaluation of the various generators --- is performed using each of the following techniques. When the states of --- two generators are to be compared, each state is saved, then --- transformed to a bounded-string variable. The bounded-strings can --- then be compared for equality. In this case, matching bounded-strings --- are evidence that the states of two generators are the same. --- In addition, two generators are compared by evaluating a series of --- random numbers they produce. A matching series of random numbers --- implies that the generators were in the same state prior to producing --- the numbers. --- --- --- CHANGE HISTORY: --- 20 Apr 95 SAIC Initial prerelease version. --- 07 Jul 95 SAIC Incorporated reviewer comments/suggestions. --- 22 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 17 Aug 96 SAIC Deleted Subtest #2. --- 09 Feb 01 RLB Repaired to work on implementations with a 16-bit --- Integer. - ---! - -with Ada.Exceptions; -with Ada.Numerics.Float_Random; -with Ada.Numerics.Discrete_Random; -with Ada.Strings.Bounded; -with ImpDef; -with Report; - -procedure CXA5011 is -begin - - Report.Test ("CXA5011", "Check the effect of Function Reset on the " & - "state of random number generators"); - - Test_Block: - declare - - use Ada.Exceptions; - use Ada.Numerics; - use Ada.Strings.Bounded; - - -- Declare an modular subtype, and use it to instantiate the discrete - -- random number generator generic package. - - type Discrete_Range is mod 2**(Integer'Size-1); - package Discrete_Package is new Discrete_Random(Discrete_Range); - - -- Declaration of random number generator objects. - - Discrete_Generator_1, - Discrete_Generator_2 : Discrete_Package.Generator; - Float_Generator_1, - Float_Generator_2 : Float_Random.Generator; - - -- Declaration of bounded string packages instantiated with the - -- value of Max_Image_Width constant from each random number generator - -- package, and bounded string variables used to hold the image of - -- random number generator states. - - package Discrete_String_Pack is - new Generic_Bounded_Length(Discrete_Package.Max_Image_Width); - - package Float_String_Pack is - new Generic_Bounded_Length(Float_Random.Max_Image_Width); - - use Discrete_String_Pack, Float_String_Pack; - - TC_Seed : Integer; - TC_Max_Loop_Count : constant Natural := 1000; - Allowed_Matches : constant Natural := 2; - -- - -- In a sequence of TC_Max_Loop_Count random numbers that should - -- not match, some may match by chance. Up to Allowed_Matches - -- numbers may match before the test is considered to fail. - -- - - - procedure Check_Float_State (Gen_1, Gen_2 : Float_Random.Generator; - Sub_Test : Integer; - States_Should_Match : Boolean) is - - use type Float_Random.State; - - State_1, - State_2 : Float_Random.State; - - State_String_1, - State_String_2 : Float_String_Pack.Bounded_String := - Float_String_Pack.Null_Bounded_String; - begin - - Float_Random.Save(Gen => Gen_1, To_State => State_1); - Float_Random.Save(Gen_2, State_2); - - State_String_1 := - Float_String_Pack.To_Bounded_String(Source => - Float_Random.Image(Of_State => State_1)); - - State_String_2 := - Float_String_Pack.To_Bounded_String(Float_Random.Image(State_2)); - - case States_Should_Match is - when True => - if State_1 /= State_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State values from Float generators " & - "are not the same"); - end if; - if State_String_1 /= State_String_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State strings from Float generators " & - "are not the same"); - end if; - when False => - if State_1 = State_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State values from Float generators " & - "are the same"); - end if; - if State_String_1 = State_String_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State strings from Float generators " & - "are the same"); - end if; - end case; - end Check_Float_State; - - - - procedure Check_Discrete_State (Gen_1, - Gen_2 : Discrete_Package.Generator; - Sub_Test : Integer; - States_Should_Match : Boolean) is - - use type Discrete_Package.State; - - State_1, State_2 : Discrete_Package.State; - - State_String_1, - State_String_2 : Discrete_String_Pack.Bounded_String := - Discrete_String_Pack.Null_Bounded_String; - begin - - Discrete_Package.Save(Gen => Gen_1, - To_State => State_1); - Discrete_Package.Save(Gen_2, To_State => State_2); - - State_String_1 := - Discrete_String_Pack.To_Bounded_String(Source => - Discrete_Package.Image(Of_State => State_1)); - - State_String_2 := - Discrete_String_Pack.To_Bounded_String(Source => - Discrete_Package.Image(Of_State => State_2)); - - case States_Should_Match is - when True => - if State_1 /= State_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State values from Discrete " & - "generators are not the same"); - end if; - if State_String_1 /= State_String_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State strings from Discrete " & - "generators are not the same"); - end if; - when False => - if State_1 = State_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State values from Discrete " & - "generators are the same"); - end if; - if State_String_1 = State_String_2 then - Report.Failed("Subtest #" & Integer'Image(Sub_Test) & - " State strings from Discrete " & - "generators are the same"); - end if; - end case; - end Check_Discrete_State; - - - - procedure Check_Float_Values (Gen_1, Gen_2 : Float_Random.Generator; - Sub_Test : Integer; - Values_Should_Match : Boolean) is - Matches : Natural := 0; - Check_Failed : Boolean := False; - begin - case Values_Should_Match is - when True => - for i in 1..TC_Max_Loop_Count loop - if Float_Random.Random(Gen_1) /= Float_Random.Random(Gen_2) - then - Check_Failed := True; - exit; - end if; - end loop; - if Check_Failed then - Report.Failed("Sub_Test # " & Integer'Image(Sub_Test) & - " Random numbers from Float generators " & - "Failed check"); - end if; - when False => - for i in 1..TC_Max_Loop_Count loop - if Float_Random.Random(Gen_1) = Float_Random.Random(Gen_2) - then - Matches := Matches + 1; - end if; - end loop; - end case; - - if (Values_Should_Match and Check_Failed) or - (not Values_Should_Match and Matches > Allowed_Matches) - then - Report.Failed("Sub_Test # " & Integer'Image(Sub_Test) & - " Random numbers from Float generators " & - "Failed check"); - end if; - - end Check_Float_Values; - - - - procedure Check_Discrete_Values (Gen_1, - Gen_2 : Discrete_Package.Generator; - Sub_Test : Integer; - Values_Should_Match : Boolean) is - Matches : Natural := 0; - Check_Failed : Boolean := False; - begin - case Values_Should_Match is - when True => - for i in 1..TC_Max_Loop_Count loop - if Discrete_Package.Random(Gen_1) /= - Discrete_Package.Random(Gen_2) - then - Check_Failed := True; - exit; - end if; - end loop; - when False => - for i in 1..TC_Max_Loop_Count loop - if Discrete_Package.Random(Gen_1) = - Discrete_Package.Random(Gen_2) - then - Matches := Matches + 1; - end if; - end loop; - end case; - - if (Values_Should_Match and Check_Failed) or - (not Values_Should_Match and Matches > Allowed_Matches) - then - Report.Failed("Sub_Test # " & Integer'Image(Sub_Test) & - " Random numbers from Discrete generators " & - "Failed check"); - end if; - - end Check_Discrete_Values; - - - - begin - - Sub_Test_1: - -- Check that two objects of type Generator are initialized to the - -- same state. - begin - - -- Since the discrete and float random generators are in the initial - -- state, using Procedure Save to save the states of the generator - -- objects, and transforming these states into strings using - -- Function Image, should yield identical strings. - - Check_Discrete_State (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 1, - States_Should_Match => True); - - Check_Float_State (Float_Generator_1, - Float_Generator_2, - Sub_Test => 1, - States_Should_Match => True); - - -- Since the two random generator objects are in their initial - -- state, the values produced from each (upon calls to Random) - -- should be identical. - - Check_Discrete_Values (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 1, - Values_Should_Match => True); - - Check_Float_Values (Float_Generator_1, - Float_Generator_2, - Sub_Test => 1, - Values_Should_Match => True); - - end Sub_Test_1; - - - - Sub_Test_3: - -- Check that when the Function Reset uses the same integer - -- initiator to reset two generators to the same state, the - -- resulting random values and the state from each generator - -- are identical. - declare - use Discrete_Package, Float_Random; - begin - - -- Reset the generators to the same states, using the version of - -- Function Reset with both generator parameter and initiator - -- specified. - - TC_Seed := Integer(Random(Discrete_Generator_1)); - Reset(Gen => Discrete_Generator_1, Initiator => TC_Seed); - Reset(Discrete_Generator_2, Initiator => TC_Seed); - Reset(Float_Generator_1, TC_Seed); - Reset(Float_Generator_2, TC_Seed); - - -- Since the random generators have been reset to identical states, - -- bounded string images of these states should yield identical - -- strings. - - Check_Discrete_State (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 3, - States_Should_Match => True); - - Check_Float_State (Float_Generator_1, - Float_Generator_2, - Sub_Test => 3, - States_Should_Match => True); - - -- Since the random generators have been reset to identical states, - -- the values produced from each (upon calls to Random) should - -- be identical. - - Check_Discrete_Values (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 3, - Values_Should_Match => True); - - Check_Float_Values (Float_Generator_1, - Float_Generator_2, - Sub_Test => 3, - Values_Should_Match => True); - - end Sub_Test_3; - - - - Sub_Test_4: - -- Check that when the Function Reset uses different integer - -- initiator values to reset two generators, the resulting random - -- numbers and states are different. - begin - - -- Reset the generators to different states. - - TC_Seed := - Integer(Discrete_Package.Random(Discrete_Generator_1)); - - Discrete_Package.Reset(Gen => Discrete_Generator_1, - Initiator => TC_Seed); - - -- Set the seed value to a different value for the second call - -- to Reset. - -- Note: A second call to Random could be made, as above, but that - -- would not ensure that the resulting seed value was - -- different from the first. - - if TC_Seed /= Integer'Last then - TC_Seed := TC_Seed + 1; - else - TC_Seed := TC_Seed - 1; - end if; - - Discrete_Package.Reset(Gen => Discrete_Generator_2, - Initiator => TC_Seed); - - Float_Random.Reset(Float_Generator_1, 16#FF#); -- 255 - Float_Random.Reset(Float_Generator_2, 2#1110_0000#); -- 224 - - -- Since the two float random generators are in different - -- states, the bounded string images depicting their states should - -- differ. - - Check_Discrete_State (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 4, - States_Should_Match => False); - - Check_Float_State (Float_Generator_1, - Float_Generator_2, - Sub_Test => 4, - States_Should_Match => False); - - -- Since the two discrete random generator objects were reset - -- to different states, the values produced from each (upon calls - -- to Random) should differ. - - Check_Discrete_Values (Discrete_Generator_1, - Discrete_Generator_2, - Sub_Test => 4, - Values_Should_Match => False); - - Check_Float_Values (Float_Generator_1, - Float_Generator_2, - Sub_Test => 4, - Values_Should_Match => False); - - end Sub_Test_4; - - 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 CXA5011; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a deleted file mode 100644 index a286fa71ed0..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a +++ /dev/null @@ -1,536 +0,0 @@ --- CXA5012.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, for both Float_Random and Discrete_Random packages, --- the following are true: --- 1) the procedures Save and Reset can be used to save the --- specific state of a random number generator, and then restore --- the specific state to the generator following some intermediate --- generator activity. --- 2) the Function Image can be used to obtain a string --- representation of the state of a generator; and that the --- Function Value will transform a string representation of the --- state of a random number generator into the actual state object. --- 3) a call to Function Value, with a string value that is --- not the image of any generator state, is a bounded error. This --- error either raises Constraint_Error or Program_Error, or is --- accepted. (See Technical Corrigendum 1). --- --- TEST DESCRIPTION: --- This test evaluates components of the Ada.Numerics.Float_Random and --- Ada.Numerics.Discrete_Random packages. --- The first objective block of this test uses Procedure Save to --- save the particular state of a random number generator. The random --- number generator then generates a series of random numbers. The --- saved state variable is then used to reset (using Procedure Reset) --- the generator back to the state it was in at the point of the call --- to Save. Random values are then generated from this restored --- generator, and compared with expected values. --- The second objective block of this test uses Function Image to --- provide a string representation of a state code. This string is --- then transformed back to a state code value, and used to reset a --- random number generator to the saved state. Random values are --- likewise generated from this restored generator, and compared with --- expected values. --- --- --- CHANGE HISTORY: --- 25 Apr 95 SAIC Initial prerelease version. --- 17 Jul 95 SAIC Incorporated reviewer comments. --- 17 Dec 97 EDS Change subtype upper limit from 100_000 to 10_000. --- 16 Sep 99 RLB Updated objective 3 for Technical Corrigendum 1 --- changes. - ---! - -with Ada.Numerics.Float_Random; -with Ada.Numerics.Discrete_Random; -with Ada.Strings.Bounded; -with ImpDef; -with Report; - -procedure CXA5012 is - -begin - - Report.Test ("CXA5012", "Check the effect of Procedures Save and " & - "Reset, and Functions Image and Value " & - "from the Ada.Numerics.Discrete_Random " & - "and Float_Random packages"); - - Test_Block: - declare - - use Ada.Numerics, Ada.Strings.Bounded; - - -- Declare an integer subtype and an enumeration subtype, and use them - -- to instantiate the discrete random number generator generic package. - - subtype Discrete_Range is Integer range 1..10_000; - type Suit_Of_Cards is (Ace, One, Two, Three, Four, Five, Six, - Seven, Eight, Nine, Ten, Jack, Queen, King); - package Discrete_Pack is new Discrete_Random(Discrete_Range); - package Card_Pack is new Discrete_Random(Suit_Of_Cards); - - -- Declaration of random number generator objects. - - DGen_1, DGen_2 : Discrete_Pack.Generator; - EGen_1, EGen_2 : Card_Pack.Generator; - FGen_1, FGen_2 : Float_Random.Generator; - - -- Variables declared to hold random numbers over the inclusive range - -- of their corresponding type. - - DVal_1, DVal_2 : Discrete_Range; - EVal_1, EVal_2 : Suit_Of_Cards; - FVal_1, FVal_2 : Float_Random.Uniformly_Distributed; - - -- Declaration of State variables used to hold the state of the - -- random number generators. - - DState_1, DState_2 : Discrete_Pack.State; - EState_1, EState_2 : Card_Pack.State; - FState_1, FState_2 : Float_Random.State; - - -- Declaration of bounded string packages instantiated with the - -- value of Max_Image_Width constant, and bounded string variables - -- used to hold the image of random number generator states. - - package DString_Pack is - new Generic_Bounded_Length(Discrete_Pack.Max_Image_Width); - package EString_Pack is - new Generic_Bounded_Length(Card_Pack.Max_Image_Width); - package FString_Pack is - new Generic_Bounded_Length(Float_Random.Max_Image_Width); - - use DString_Pack, EString_Pack, FString_Pack; - - DString_1, DString_2 : DString_Pack.Bounded_String := - DString_Pack.Null_Bounded_String; - EString_1, EString_2 : EString_Pack.Bounded_String := - EString_Pack.Null_Bounded_String; - FString_1, FString_2 : FString_Pack.Bounded_String := - FString_Pack.Null_Bounded_String; - - -- Test variables. - - TC_Count : Natural; - TC_Discrete_Check_Failed, - TC_Enum_Check_Failed, - TC_Float_Check_Failed : Boolean := False; - TC_Seed : Integer; - - begin - - Objective_1: - -- Check that the procedures Save and Reset can be used to save the - -- specific state of a random number generator, and then restore the - -- specific state to the generator following some intermediate - -- generator activity. - declare - - First_Row : constant := 1; - Second_Row : constant := 2; - TC_Max_Values : constant := 100; - - TC_Discrete_Array : array (First_Row..Second_Row, 1..TC_Max_Values) - of Discrete_Range; - TC_Enum_Array : array (First_Row..Second_Row, 1..TC_Max_Values) - of Suit_Of_Cards; - TC_Float_Array : array (First_Row..Second_Row, 1..TC_Max_Values) - of Float_Random.Uniformly_Distributed; - begin - - -- The state of the random number generators are saved to state - -- variables using the procedure Save. - - Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1); - Card_Pack.Save (Gen => EGen_1, To_State => EState_1); - Float_Random.Save (Gen => FGen_1, To_State => FState_1); - - -- Random number generators are used to fill the first half of the - -- first row of the arrays with randomly generated values. - - for i in 1..TC_Max_Values/2 loop - TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1); - TC_Enum_Array(First_Row, i) := Card_Pack.Random(EGen_1); - TC_Float_Array(First_Row, i) := Float_Random.Random(FGen_1); - end loop; - - -- The random number generators are reset to the states saved in the - -- state variables, using the procedure Reset. - - Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1); - Card_Pack.Reset (Gen => EGen_1, From_State => EState_1); - Float_Random.Reset (Gen => FGen_1, From_State => FState_1); - - -- The same random number generators are used to fill the first half - -- of the second row of the arrays with randomly generated values. - - for i in 1..TC_Max_Values/2 loop - TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1); - TC_Enum_Array(Second_Row, i) := Card_Pack.Random(EGen_1); - TC_Float_Array(Second_Row, i) := Float_Random.Random(FGen_1); - end loop; - - -- Run the random number generators many times (not using results). - - for i in Discrete_Range'Range loop - DVal_1 := Discrete_Pack.Random(DGen_1); - EVal_1 := Card_Pack.Random(EGen_1); - FVal_1 := Float_Random.Random(FGen_1); - end loop; - - -- The states of the random number generators are saved to state - -- variables using the procedure Save. - - Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1); - Card_Pack.Save(Gen => EGen_1, To_State => EState_1); - Float_Random.Save (Gen => FGen_1, To_State => FState_1); - - -- The last half of the first row of the arrays are filled with - -- values generated from the same random number generators. - - for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop - TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1); - TC_Enum_Array(First_Row, i) := Card_Pack.Random(EGen_1); - TC_Float_Array(First_Row, i) := Float_Random.Random(FGen_1); - end loop; - - -- The random number generators are reset to the states saved in the - -- state variables, using the procedure Reset. - - Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1); - Card_Pack.Reset(Gen => EGen_1, From_State => EState_1); - Float_Random.Reset (Gen => FGen_1, From_State => FState_1); - - -- The last half of the second row of the arrays are filled with - -- values generated from the same random number generator. - -- These values should exactly mirror the values in the last half - -- of the first row of the arrays that had been previously generated. - - for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop - TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1); - TC_Enum_Array(Second_Row, i) := Card_Pack.Random(EGen_1); - TC_Float_Array(Second_Row, i) := Float_Random.Random(FGen_1); - end loop; - - -- Check that the values in the two rows of the arrays are identical. - - for i in 1..TC_Max_Values loop - if TC_Discrete_Array(First_Row,i) /= - TC_Discrete_Array(Second_Row,i) - then - TC_Discrete_Check_Failed := True; - exit; - end if; - end loop; - - for i in 1..TC_Max_Values loop - if TC_Enum_Array(First_Row,i) /= TC_Enum_Array(Second_Row,i) then - TC_Enum_Check_Failed := True; - exit; - end if; - end loop; - - for i in 1..TC_Max_Values loop - if TC_Float_Array(First_Row,i) /= TC_Float_Array(Second_Row,i) - then - TC_Float_Check_Failed := True; - exit; - end if; - end loop; - - if TC_Discrete_Check_Failed then - Report.Failed("Discrete random values generated following use " & - "of procedures Save and Reset were not the same"); - TC_Discrete_Check_Failed := False; - end if; - - if TC_Enum_Check_Failed then - Report.Failed("Enumeration random values generated following " & - "use of procedures Save and Reset were not the " & - "same"); - TC_Enum_Check_Failed := False; - end if; - - if TC_Float_Check_Failed then - Report.Failed("Float random values generated following use " & - "of procedures Save and Reset were not the same"); - TC_Float_Check_Failed := False; - end if; - - end Objective_1; - - - - Objective_2: - -- Check that the Function Image can be used to obtain a string - -- representation of the state of a generator. - -- Check that the Function Value will transform a string - -- representation of the state of a random number generator - -- into the actual state object. - begin - - -- Use two discrete and float random number generators to generate - -- a series of values (so that the generators are no longer in their - -- initial states, and they have generated the same number of - -- random values). - - TC_Seed := Integer(Discrete_Pack.Random(DGen_1)); - Discrete_Pack.Reset(DGen_1, TC_Seed); - Discrete_Pack.Reset(DGen_2, TC_Seed); - Card_Pack.Reset (EGen_1, TC_Seed); - Card_Pack.Reset (EGen_2, TC_Seed); - Float_Random.Reset (FGen_1, TC_Seed); - Float_Random.Reset (FGen_2, TC_Seed); - - for i in 1..1000 loop - DVal_1 := Discrete_Pack.Random(DGen_1); - DVal_2 := Discrete_Pack.Random(DGen_2); - EVal_1 := Card_Pack.Random(EGen_1); - EVal_2 := Card_Pack.Random(EGen_2); - FVal_1 := Float_Random.Random(FGen_1); - FVal_2 := Float_Random.Random(FGen_2); - end loop; - - -- Use the Procedure Save to save the states of the generators - -- to state variables. - - Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1); - Discrete_Pack.Save(DGen_2, To_State => DState_2); - Card_Pack.Save (Gen => EGen_1, To_State => EState_1); - Card_Pack.Save (EGen_2, To_State => EState_2); - Float_Random.Save (FGen_1, To_State => FState_1); - Float_Random.Save (FGen_2, FState_2); - - -- Use the Function Image to produce a representation of the state - -- codes as (bounded) string objects. - - DString_1 := DString_Pack.To_Bounded_String( - Discrete_Pack.Image(Of_State => DState_1)); - DString_2 := DString_Pack.To_Bounded_String( - Discrete_Pack.Image(DState_2)); - EString_1 := EString_Pack.To_Bounded_String( - Card_Pack.Image(Of_State => EState_1)); - EString_2 := EString_Pack.To_Bounded_String( - Card_Pack.Image(EState_2)); - FString_1 := FString_Pack.To_Bounded_String( - Float_Random.Image(Of_State => FState_1)); - FString_2 := FString_Pack.To_Bounded_String( - Float_Random.Image(FState_2)); - - -- Compare the bounded string objects for equality. - - if DString_1 /= DString_2 then - Report.Failed("String values returned from Function Image " & - "depict different states of Discrete generators"); - end if; - if EString_1 /= EString_2 then - Report.Failed("String values returned from Function Image " & - "depict different states of Enumeration " & - "generators"); - end if; - if FString_1 /= FString_2 then - Report.Failed("String values returned from Function Image " & - "depict different states of Float generators"); - end if; - - -- The string representation of a state code is transformed back - -- to a state code variable using the Function Value. - - DState_1 := Discrete_Pack.Value(Coded_State => - DString_Pack.To_String(DString_1)); - EState_1 := Card_Pack.Value(EString_Pack.To_String(EString_1)); - FState_1 := Float_Random.Value(FString_Pack.To_String(FString_1)); - - -- One of the (pair of each type of ) generators is used to generate - -- a series of random values, getting them "out of synch" with the - -- specific generation sequence of the other generators. - - for i in 1..100 loop - DVal_1 := Discrete_Pack.Random(DGen_1); - EVal_1 := Card_Pack.Random(EGen_1); - FVal_1 := Float_Random.Random (FGen_1); - end loop; - - -- The "out of synch" generators are reset to the previous state they - -- had when their states were saved, and they should now have the same - -- states as the generators that did not generate the values above. - - Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1); - Card_Pack.Reset (Gen => EGen_1, From_State => EState_1); - Float_Random.Reset (Gen => FGen_1, From_State => FState_1); - - -- All generators should now be in the same state, so the - -- random values they produce should be the same. - - for i in 1..1000 loop - if Discrete_Pack.Random(DGen_1) /= Discrete_Pack.Random(DGen_2) - then - TC_Discrete_Check_Failed := True; - exit; - end if; - end loop; - - for i in 1..1000 loop - if Card_Pack.Random(EGen_1) /= Card_Pack.Random(EGen_2) then - TC_Enum_Check_Failed := True; - exit; - end if; - end loop; - - for i in 1..1000 loop - if Float_Random.Random(FGen_1) /= Float_Random.Random(FGen_2) - then - TC_Float_Check_Failed := True; - exit; - end if; - end loop; - - if TC_Discrete_Check_Failed then - Report.Failed("Random values generated following use of " & - "procedures Image and Value were not the same " & - "for Discrete generator"); - end if; - if TC_Enum_Check_Failed then - Report.Failed("Random values generated following use of " & - "procedures Image and Value were not the same " & - "for Enumeration generator"); - end if; - if TC_Float_Check_Failed then - Report.Failed("Random values generated following use of " & - "procedures Image and Value were not the same " & - "for Float generator"); - end if; - - end Objective_2; - - - - Objective_3: - -- Check that a call to Function Value, with a string value that is - -- not the image of any generator state, is a bounded error. This - -- error either raises Constraint_Error or Program_Error, or is - -- accepted. (See Technical Corrigendum 1). - declare - Not_A_State : constant String := ImpDef.Non_State_String; - begin - - begin - DState_1 := Discrete_Pack.Value(Not_A_State); - if Not_A_State /= "**NONE**" then - Report.Failed("Exception not raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - else - Report.Comment("All strings represent states for Function " & - "Ada.Numerics.Discrete_Random.Value"); - end if; - Discrete_Pack.Reset(DGen_1, DState_1); - exception - when Constraint_Error => null; -- OK, expected exception. - Report.Comment("Constraint_Error raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - when Program_Error => -- OK, expected exception. - Report.Comment("Program_Error raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - when others => - Report.Failed("Unexpected exception raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - end; - - begin - EState_1 := Card_Pack.Value(Not_A_State); - if Not_A_State /= "**NONE**" then - Report.Failed("Exception not raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of an enumeration " & - "random number generator"); - else - Report.Comment("All strings represent states for Function " & - "Ada.Numerics.Discrete_Random.Value"); - end if; - Card_Pack.Reset(EGen_1, EState_1); - exception - when Constraint_Error => null; -- OK, expected exception. - when Program_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function " & - "Ada.Numerics.Discrete_Random.Value when " & - "provided a string input that does not " & - "represent the state of an enumeration " & - "random number generator"); - end; - - begin - FState_1 := Float_Random.Value(Not_A_State); - if Not_A_State /= "**NONE**" then - Report.Failed("Exception not raised by an " & - "instantiated version of " & - "Ada.Numerics.Float_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - else - Report.Comment("All strings represent states for Function " & - "Ada.Numerics.Float_Random.Value"); - end if; - Float_Random.Reset(FGen_1, FState_1); - exception - when Constraint_Error => null; -- OK, expected exception. - when Program_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by an " & - "instantiated version of " & - "Ada.Numerics.Float_Random.Value when " & - "provided a string input that does not " & - "represent the state of a random number " & - "generator"); - end; - - end Objective_3; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5012; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a deleted file mode 100644 index e1035db271b..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a +++ /dev/null @@ -1,342 +0,0 @@ --- CXA5015.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 following representation-oriented attributes are --- available and that the produce correct results: --- 'Denorm, 'Signed_Zeros, 'Exponent 'Fraction, 'Compose, 'Scaling, --- 'Floor, 'Ceiling, 'Rounding, 'Unbiased_Rounding, 'Truncation, --- 'Remainder, 'Adjacent, 'Copy_Sign, 'Leading_Part, 'Machine, and --- 'Model_Small. --- --- TEST DESCRIPTION: --- This test checks whether certain attributes of floating point types --- are available from an implementation. Where attribute correctness --- can be verified in a straight forward manner, the appropriate checks --- are included here. However, this test is not intended to ensure the --- correctness of the results returned from all of the attributes --- examined in this test; that process will occur in the tests of the --- Numerics_Annex. --- --- --- CHANGE HISTORY: --- 26 Jun 95 SAIC Initial prerelease version. --- 29 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 01 DEC 97 EDS Fix value for checking the S'Adjacent attribute ---! - -with Report; - -procedure CXA5015 is - - subtype Float_Subtype is Float range -10.0..10.0; - type Derived_Float_1 is digits 8; - type Derived_Float_2 is new Derived_Float_1 range -10.0..10.0E10; - - use type Float, Float_Subtype, Derived_Float_1, Derived_Float_2; - - TC_Boolean : Boolean; - TC_Float : Float; - TC_SFloat : Float_Subtype; - TC_DFloat_1 : Derived_Float_1; - TC_DFloat_2 : Derived_Float_2; - TC_Tolerance : Float := 0.001; - - function Not_Equal (Actual_Result, Expected_Result, Tolerance : Float) - return Boolean is - begin - return abs(Actual_Result - Expected_Result) > Tolerance; - end Not_Equal; - - -begin - - Report.Test ("CXA5015", "Check that certain representation-oriented " & - "attributes are available and that they " & - "produce correct results"); - - -- New Representation-Oriented Attributes. - -- - -- Check the S'Denorm attribute. - - TC_Boolean := Float'Denorm; - TC_Boolean := Float_Subtype'Denorm; - TC_Boolean := Derived_Float_1'Denorm; - TC_Boolean := Derived_Float_2'Denorm; - - - -- Check the S'Signed_Zeroes attribute. - - TC_Boolean := Float'Signed_Zeros; - TC_Boolean := Float_Subtype'Signed_Zeros; - TC_Boolean := Derived_Float_1'Signed_Zeros; - TC_Boolean := Derived_Float_2'Signed_Zeros; - - - -- New Primitive Function Attributes. - -- - -- Check the S'Exponent attribute. - - TC_Float := 0.5; - TC_SFloat := 0.99; - TC_DFloat_1 := 2.45; - TC_DFloat_2 := 2.65; - - if Float'Exponent(TC_Float) > Float_Subtype'Exponent(TC_SFloat) or - Float'Exponent(TC_Float) > 2 - then - Report.Failed("Incorrect result from the 'Exponent attribute"); - end if; - - - -- Check the S'Fraction attribute. - - if Not_Equal - (Float'Fraction(TC_Float), - TC_Float * Float(Float'Machine_Radix)**(-Float'Exponent(TC_Float)), - TC_Tolerance) - then - Report.Failed("Incorrect result from the 'Fraction attribute - 1"); - end if; - - if Float'Fraction(TC_Float) < - (1.0/Float(Float'Machine_Radix)) - TC_Tolerance or - Float'Fraction(TC_Float) >= 1.0 - TC_Tolerance - then - Report.Failed("Incorrect result from the 'Fraction attribute - 2"); - end if; - - - -- Check the S'Compose attribute. - - if Not_Equal - (Float'Compose(TC_Float, 3), - TC_Float * Float(Float'Machine_Radix)**(3-Float'Exponent(TC_Float)), - TC_Tolerance) - then - Report.Failed("Incorrect result from the 'Compose attribute"); - end if; - - - -- Check the S'Scaling attribute. - - if Not_Equal - (Float'Scaling(TC_Float, 2), - TC_Float * Float(Float'Machine_Radix)**2, - TC_Tolerance) - then - Report.Failed("Incorrect result from the 'Scaling attribute"); - end if; - - - -- Check the S'Floor attribute. - - TC_Float := 0.99; - TC_SFloat := 1.00; - TC_DFloat_1 := 2.50; - TC_DFloat_2 := -2.50; - - if Float'Floor(TC_Float) /= 0.0 or - Float_Subtype'Floor(TC_SFloat) /= 1.0 or - Derived_Float_1'Floor(TC_DFloat_1) /= 2.0 or - Derived_Float_2'Floor(TC_DFloat_2) /= -3.0 - then - Report.Failed("Incorrect result from the 'Floor attribute"); - end if; - - - -- Check the S'Ceiling attribute. - - TC_Float := 0.99; - TC_SFloat := 1.00; - TC_DFloat_1 := 2.50; - TC_DFloat_2 := -2.99; - - if Float'Ceiling(TC_Float) /= 1.0 or - Float_Subtype'Ceiling(TC_SFloat) /= 1.0 or - Derived_Float_1'Ceiling(TC_DFloat_1) /= 3.0 or - Derived_Float_2'Ceiling(TC_DFloat_2) /= -2.0 - then - Report.Failed("Incorrect result from the 'Ceiling attribute"); - end if; - - - -- Check the S'Rounding attribute. - - TC_Float := 0.49; - TC_SFloat := 1.00; - TC_DFloat_1 := 2.50; - TC_DFloat_2 := -2.50; - - if Float'Rounding(TC_Float) /= 0.0 or - Float_Subtype'Rounding(TC_SFloat) /= 1.0 or - Derived_Float_1'Rounding(TC_DFloat_1) /= 3.0 or - Derived_Float_2'Rounding(TC_DFloat_2) /= -3.0 - then - Report.Failed("Incorrect result from the 'Rounding attribute"); - end if; - - - -- Check the S'Unbiased_Rounding attribute. - - TC_Float := 0.50; - TC_SFloat := 1.50; - TC_DFloat_1 := 2.50; - TC_DFloat_2 := -2.50; - - if Float'Unbiased_Rounding(TC_Float) /= 0.0 or - Float_Subtype'Unbiased_Rounding(TC_SFloat) /= 2.0 or - Derived_Float_1'Unbiased_Rounding(TC_DFloat_1) /= 2.0 or - Derived_Float_2'Unbiased_Rounding(TC_DFloat_2) /= -2.0 - then - Report.Failed("Incorrect result from the 'Unbiased_Rounding " & - "attribute"); - end if; - - - -- Check the S'Truncation attribute. - - TC_Float := -0.99; - TC_SFloat := 1.50; - TC_DFloat_1 := 2.99; - TC_DFloat_2 := -2.50; - - if Float'Truncation(TC_Float) /= 0.0 or - Float_Subtype'Truncation(TC_SFloat) /= 1.0 or - Derived_Float_1'Truncation(TC_DFloat_1) /= 2.0 or - Derived_Float_2'Truncation(TC_DFloat_2) /= -2.0 - then - Report.Failed("Incorrect result from the 'Truncation attribute"); - end if; - - - -- Check the S'Remainder attribute. - - TC_Float := 9.0; - TC_SFloat := 7.5; - TC_DFloat_1 := 5.0; - TC_DFloat_2 := 8.0; - - if Float'Remainder(TC_Float, 2.0) /= 1.0 or - Float_Subtype'Remainder(TC_SFloat, 3.0) /= 1.5 or - Derived_Float_1'Remainder(TC_DFloat_1, 2.0) /= 1.0 or - Derived_Float_2'Remainder(TC_DFloat_2, 4.0) /= 0.0 - then - Report.Failed("Incorrect result from the 'Remainder attribute"); - end if; - - - -- Check the S'Adjacent attribute. - - TC_Float := 4.0; - TC_SFloat := -1.0; - - if Float'Adjacent(TC_Float, TC_Float) /= TC_Float or - Float_Subtype'Adjacent(TC_SFloat, -1.0) /= TC_SFloat - then - Report.Failed("Incorrect result from the 'Adjacent attribute"); - end if; - - - -- Check the S'Copy_Sign attribute. - - TC_Float := 0.0; - TC_SFloat := -1.0; - TC_DFloat_1 := 5.0; - TC_DFloat_2 := -2.5; - - if Float'Copy_Sign(TC_Float, -2.0) /= 0.0 or - Float_Subtype'Copy_Sign(TC_SFloat, 4.0) /= 1.0 or - Derived_Float_1'Copy_Sign(TC_DFloat_1, -2.0) /= -5.0 or - Derived_Float_2'Copy_Sign(TC_DFloat_2, -2.0) /= -2.5 - then - Report.Failed("Incorrect result from the 'Copy_Sign attribute"); - end if; - - - -- Check the S'Leading_Part attribute. - - TC_Float := 0.0; - TC_SFloat := -1.0; - TC_DFloat_1 := 5.88; - TC_DFloat_2 := -2.52; - - -- Leading part obtained in the variables. - TC_Float := Float'Leading_Part(TC_Float, 2); - TC_SFloat := Float_Subtype'Leading_Part(TC_SFloat, 2); - TC_DFloat_1 := Derived_Float_1'Leading_Part(TC_DFloat_1, 2); - TC_DFloat_2 := Derived_Float_2'Leading_Part(TC_DFloat_2, 2); - - -- Checking for the leading part of the variables at this point should - -- produce the same values. - if Float'Leading_Part(TC_Float, 2) /= TC_Float or - Float_Subtype'Leading_Part(TC_SFloat, 2) /= TC_SFloat or - Derived_Float_1'Leading_Part(TC_DFloat_1, 2) /= TC_DFloat_1 or - Derived_Float_2'Leading_Part(TC_DFloat_2, 2) /= TC_DFloat_2 - then - Report.Failed("Incorrect result from the 'Leading_Part attribute"); - end if; - - - -- Check the S'Machine attribute. - - TC_Float := 0.0; - TC_SFloat := -1.0; - TC_DFloat_1 := 5.88; - TC_DFloat_2 := -2.52; - - -- Closest machine number obtained in the variables. - TC_Float := Float'Machine(TC_Float); - TC_SFloat := Float_Subtype'Machine(TC_SFloat); - TC_DFloat_1 := Derived_Float_1'Machine(TC_DFloat_1); - TC_DFloat_2 := Derived_Float_2'Machine(TC_DFloat_2); - - -- Checking for the closest machine number to each of the variables at - -- this point should produce the same values. - if Float'Machine(TC_Float) /= TC_Float or - Float_Subtype'Machine(TC_SFloat) /= TC_SFloat or - Derived_Float_1'Machine(TC_DFloat_1) /= TC_DFloat_1 or - Derived_Float_2'Machine(TC_DFloat_2) /= TC_DFloat_2 - then - Report.Failed("Incorrect result from the 'Machine attribute"); - end if; - - - -- New Model-Oriented Attributes. - -- - -- Check the S'Model_Small attribute. - - if Not_Equal - (Float'Model_Small, - Float(Float'Machine_Radix)**(Float'Model_Emin-1), - TC_Tolerance) - then - Report.Failed("Incorrect result from the 'Model_Small attribute"); - end if; - - - Report.Result; - -end CXA5015; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a deleted file mode 100644 index 12db5e7e108..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a +++ /dev/null @@ -1,338 +0,0 @@ --- CXA5A01.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 functions Sin and Sinh provide correct results. --- --- TEST DESCRIPTION: --- This test examines both the version of Sin and Sinh resulting from --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, as well as instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A01.A --- --- --- CHANGE HISTORY: --- 06 Mar 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 26 Jun 98 EDS Protected exception tests by first testing --- for 'Machine_Overflows ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A01 is -begin - - Report.Test ("CXA5A01", "Check that the functions Sin and Sinh provide " & - "correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Sin Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Sin with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when others => - Report.Failed("Unexpected exception on GEF.Sin with large " & - "positive value"); - end; - - begin - The_Result := EF.Sin (FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 2); - exception - when others => - Report.Failed("Unexpected exception on GEF.Sin with large " & - "negative value"); - end; - - - -- Test of Sin for prescribed result at zero. - - if GEF.Sin (0.0) /= 0.0 or - EF.Sin (0.0) /= 0.0 - then - Report.Failed("Incorrect value returned from Sin(0.0)"); - end if; - - - -- Test of Sin with expected result value between 0.0 and 1.0. - - if not (GEF.Sin (Ada.Numerics.Pi/4.0) < 1.0) or - not ( EF.Sin (Ada.Numerics.Pi/4.0) < 1.0) or - not FXA5A00.Result_Within_Range(GEF.Sin(0.35), 0.343, 0.001) or - not FXA5A00.Result_Within_Range( EF.Sin(1.18), 0.924, 0.001) - then - Report.Failed("Incorrect value returned from Sin function when " & - "the expected result is between 0.0 and 1.0"); - end if; - - - -- Test of Sin with expected result value between -1.0 and 0.0. - - if not (GEF.Sin (-Ada.Numerics.Pi/4.0) > -1.0) or - not ( EF.Sin (-Ada.Numerics.Pi/4.0) > -1.0) or - not FXA5A00.Result_Within_Range(GEF.Sin(-0.24), -0.238, 0.001) or - not FXA5A00.Result_Within_Range( EF.Sin(-1.00), -0.841, 0.001) - then - Report.Failed("Incorrect value returned from Sin function when " & - "the expected result is between -1.0 and 0.0"); - end if; - - - -- Testing of the Sin function with Cycle parameter. - - -- Check that Argument_Error is raised when the value of the Cycle - -- parameter is zero. - - begin - New_Float_Result := GEF.Sin (X => 1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by GEF.Sin function " & - "when the Cycle parameter is zero"); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.Sin function " & - "when the Cycle parameter is zero"); - end; - - begin - The_Result := EF.Sin (X => 0.34, Cycle => 0.0); - Report.Failed("Argument_Error not raised by EF.Sin function when " & - "the Cycle parameter is zero"); - Dont_Optimize_Float(The_Result, 4); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by EF.Sin function " & - "when the Cycle parameter is zero"); - end; - - -- Check that Argument_Error is raised when the value of the Cycle - -- parameter is negative. - - begin - New_Float_Result := GEF.Sin (X => 0.45, Cycle => -1.0); - Report.Failed("Argument_Error not raised by GEF.Sin function " & - "when the Cycle parameter is negative"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.Sin function " & - "when the Cycle parameter is negative"); - end; - - begin - The_Result := EF.Sin (X => 0.10, Cycle => -4.0); - Report.Failed("Argument_Error not raised by EF.Sin function when " & - "the Cycle parameter is negative"); - Dont_Optimize_Float(The_Result, 6); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by EF.Sin function " & - "when the Cycle parameter is negative"); - end; - - - -- Check that no exception occurs on computing the Sin with very - -- large (positive and negative) input values and Cycle parameter. - - begin - New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large), 360.0); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when others => - Report.Failed("Unexpected exception on GEF.Sin with large " & - "positive value and Cycle parameter"); - end; - - begin - The_Result := EF.Sin (FXA5A00.Minus_Large, 720.0); - Dont_Optimize_Float(The_Result, 8); - exception - when others => - Report.Failed("Unexpected exception on EF.Sin with large " & - "negative value and Cycle parameter"); - end; - - - -- Test of Sin with Cycle parameter for prescribed result at zero. - - if GEF.Sin (0.0, 360.0) /= 0.0 or - EF.Sin (0.0, 180.0) /= 0.0 - then - Report.Failed("Incorrect value returned from Sin function with " & - "cycle parameter for a zero input parameter value"); - end if; - - - -- Tests of Sin function with Cycle parameter for prescribed results. - - if GEF.Sin(0.0, 360.0) /= 0.0 or - EF.Sin(180.0, 360.0) /= 0.0 or - GEF.Sin(90.0, 360.0) /= 1.0 or - EF.Sin(450.0, 360.0) /= 1.0 or - GEF.Sin(270.0, 360.0) /= -1.0 or - EF.Sin(630.0, 360.0) /= -1.0 - then - Report.Failed("Incorrect result from the Sin function with " & - "various cycle values for prescribed results"); - end if; - - - -- Testing of Sinh Function, both instantiated and pre-instantiated - -- version. - - -- Test for Constraint_Error on parameter with large positive magnitude. - - begin - - if New_Float'Machine_Overflows then - New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Large)); - Report.Failed("Constraint_Error not raised when the GEF.Sinh " & - "function is provided a parameter with a large " & - "positive value"); - Dont_Optimize_New_Float(New_Float_Result, 9); - end if; - - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Constraint_Error not raised when the GEF.Sinh " & - "function is provided a parameter with a large " & - "positive value"); - end; - - -- Test for Constraint_Error on parameter with large negative magnitude. - - begin - - if Float'Machine_Overflows then - The_Result := EF.Sinh (FXA5A00.Minus_Large); - Report.Failed("Constraint_Error not raised when the EF.Sinh " & - "function is provided a parameter with a " & - "large negative value"); - Dont_Optimize_Float(The_Result, 10); - end if; - - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Constraint_Error not raised when the EF.Sinh " & - "function is provided a parameter with a " & - "large negative value"); - end; - - - -- Test that no exception occurs when the Sinh function is provided a - -- very small positive or negative value. - - begin - New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 11); - exception - when others => - Report.Failed("Unexpected exception on GEF.Sinh with a very" & - "small positive value"); - end; - - begin - The_Result := EF.Sinh (-FXA5A00.Small); - Dont_Optimize_Float(The_Result, 12); - exception - when others => - Report.Failed("Unexpected exception on EF.Sinh with a very" & - "small negative value"); - end; - - - -- Test for prescribed 0.0 result of Function Sinh with 0.0 parameter. - - if GEF.Sinh (0.0) /= 0.0 or - EF.Sinh (0.0) /= 0.0 - then - Report.Failed("Incorrect value returned from Sinh(0.0)"); - end if; - - - -- Test of Sinh function with various input parameters. - - if not FXA5A00.Result_Within_Range(GEF.Sinh(0.01), 0.010, 0.001) or - not FXA5A00.Result_Within_Range( EF.Sinh(0.61), 0.649, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Sinh(1.70), 2.65, 0.01) or - not FXA5A00.Result_Within_Range( EF.Sinh(3.15), 11.65, 0.01) - then - Report.Failed("Incorrect result returned from Sinh function " & - "with various input parameters"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A01; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a deleted file mode 100644 index 9e6c575dd2c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a +++ /dev/null @@ -1,328 +0,0 @@ --- CXA5A02.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 functions Cos and Cosh provide correct results. --- --- TEST DESCRIPTION: --- This test examines both the version of Cos and Cosh resulting from --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with type derived from type Float, as well as the pre-instantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A02.A --- --- --- CHANGE HISTORY: --- 09 Mar 95 SAIC Initial prerelease version. --- 03 Apr 95 SAIC Removed reference to derived type. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 28 Feb 97 PWB.CTA Removed checks specifying Cycle => 2.0 * Pi --- 26 Jun 98 EDS Protected exception checks by first testing --- for 'Machine_Overflows. Removed code deleted --- by comment. --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks have been deleted. ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A02 is -begin - - Report.Test ("CXA5A02", "Check that the functions Cos and Cosh provide " & - "correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Cos Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Cos with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Cos (New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when others => - Report.Failed("Unexpected exception on GEF.Cos with large " & - "positive value"); - end; - - begin - The_Result := EF.Cos (FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 2); - exception - when others => - Report.Failed("Unexpected exception on GEF.Cos with large " & - "negative value"); - end; - - - -- Test of Cos for prescribed result at zero. - - if GEF.Cos (0.0) /= 1.0 or - EF.Cos (0.0) /= 1.0 - then - Report.Failed("Incorrect value returned from Cos(0.0)"); - end if; - - - -- Test of Cos with expected result value between 1.0 and -1.0. - - if not (Result_Within_Range( EF.Cos(Ada.Numerics.Pi/3.0), - 0.500, - 0.001) and - Result_Within_Range(GEF.Cos(0.6166), 0.816, 0.001) and - Result_Within_Range(GEF.Cos(0.1949), 0.981, 0.001) and - Result_Within_Range( EF.Cos(Ada.Numerics.Pi/2.0), - 0.00, - 0.001) and - Result_Within_Range( EF.Cos(2.0*Ada.Numerics.Pi/3.0), - -0.500, - 0.001) and - Result_Within_Range(GEF.Cos(New_Float(Ada.Numerics.Pi)), - -1.00, - 0.001)) - then - Report.Failed("Incorrect value returned from Cos function when " & - "the expected result is between 1.0 and -1.0"); - end if; - - - -- Testing of the Cos function with Cycle parameter. - - -- Check that Argument_Error is raised when the value of the Cycle - -- parameter is zero. - - begin - New_Float_Result := GEF.Cos (X => 1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by GEF.Cos function " & - "when the Cycle parameter is zero"); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.cos function " & - "when the Cycle parameter is zero"); - end; - - begin - The_Result := EF.Cos (X => 0.55, Cycle => 0.0); - Report.Failed("Argument_Error not raised by EF.Cos function when " & - "the Cycle parameter is zero"); - Dont_Optimize_Float(The_Result, 4); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by EF.Cos function " & - "when the Cycle parameter is zero"); - end; - - -- Check that Argument_Error is raised when the value of the Cycle - -- parameter is negative. - - begin - New_Float_Result := GEF.Cos (X => 0.45, Cycle => -2.0*Pi); - Report.Failed("Argument_Error not raised by GEF.Cos function " & - "when the Cycle parameter is negative"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.Cos function " & - "when the Cycle parameter is negative"); - end; - - begin - The_Result := EF.Cos (X => 0.10, Cycle => -Pi/2.0); - Report.Failed("Argument_Error not raised by EF.Cos function when " & - "the Cycle parameter is negative"); - Dont_Optimize_Float(The_Result, 6); - exception - when Ada.Numerics.Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by EF.Cos function " & - "when the Cycle parameter is negative"); - end; - - -- Test of Cos with Cycle parameter for prescribed result at zero. - - if GEF.Cos (0.0, 360.0) /= 1.0 or - EF.Cos (0.0, 360.0) /= 1.0 - then - Report.Failed("Incorrect value returned from Cos function with " & - "cycle parameter for a zero input parameter value"); - end if; - - - -- Tests of Cos function with specified Cycle, using various input - -- parameter values for prescribed results. - - if GEF.Cos(0.0, 360.0) /= 1.0 or - EF.Cos(360.0, 360.0) /= 1.0 or - GEF.Cos(90.0, 360.0) /= 0.0 or - EF.Cos(270.0, 360.0) /= 0.0 or - GEF.Cos(180.0, 360.0) /= -1.0 or - EF.Cos(540.0, 360.0) /= -1.0 - then - Report.Failed("Incorrect result from the Cos function with " & - "specified cycle for prescribed results"); - end if; - - - - -- Testing of Cosh Function, both instantiated and pre-instantiated - -- version. - - -- Test for Constraint_Error on parameter with large positive magnitude. - - begin - - if New_Float'Machine_Overflows then - - New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Large)); - Report.Failed("Constraint_Error not raised when the GEF.Cosh " & - "function is provided a parameter with a large " & - "positive value"); - Dont_Optimize_New_Float(New_Float_Result, 9); - end if; - - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Constraint_Error not raised when the GEF.Cosh " & - "function is provided a parameter with a large " & - "positive value"); - end; - - -- Test for Constraint_Error on parameter with large negative magnitude. - - begin - - if Float'Machine_Overflows then - The_Result := EF.Cosh (FXA5A00.Minus_Large); - Report.Failed("Constraint_Error not raised when the EF.Cosh " & - "function is provided a parameter with a " & - "large negative value"); - Dont_Optimize_Float(The_Result, 10); - end if; - - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Constraint_Error not raised when the EF.Cosh " & - "function is provided a parameter with a " & - "large negative value"); - end; - - - -- Test that no exception occurs when the Cosh function is provided a - -- very small positive or negative value. - - begin - New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 11); - exception - when others => - Report.Failed("Unexpected exception on GEF.Cosh with a very" & - "small positive value"); - end; - - begin - The_Result := EF.Cosh (-FXA5A00.Small); - Dont_Optimize_Float(The_Result, 12); - exception - when others => - Report.Failed("Unexpected exception on EF.Cosh with a very" & - "small negative value"); - end; - - - -- Test for prescribed 1.0 result of Function Cosh with 0.0 parameter. - - if GEF.Cosh (0.0) /= 1.0 or - EF.Cosh (0.0) /= 1.0 - then - Report.Failed("Incorrect value returned from Cosh(0.0)"); - end if; - - - -- Test of Cosh function with various input parameters. - - if not FXA5A00.Result_Within_Range(GEF.Cosh(0.24), 1.029, 0.001) or - not FXA5A00.Result_Within_Range( EF.Cosh(0.59), 1.179, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Cosh(1.06), 1.616, 0.001) or - not FXA5A00.Result_Within_Range( EF.Cosh(1.50), 2.352, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Cosh(1.84), 3.228, 0.001) or - not FXA5A00.Result_Within_Range( EF.Cosh(3.40), 14.99, 0.01) - then - Report.Failed("Incorrect result from Cosh function with " & - "various input parameters"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A02; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a deleted file mode 100644 index d99ba9bdcf0..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a +++ /dev/null @@ -1,426 +0,0 @@ --- CXA5A03.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 functions Tan, Tanh, and Arctanh provide correct --- results. --- --- TEST DESCRIPTION: --- This test examines both the version of Tan, Tanh, and Arctanh --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A03.A --- --- --- CHANGE HISTORY: --- 14 Mar 95 SAIC Initial prerelease version. --- 06 Apr 95 SAIC Corrected errors in context clause references --- and usage of Cycle parameter. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 29 Jun 98 EDS Protected exception tests by first testing --- for 'Machine_Overflows --- ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A03 is -begin - - Report.Test ("CXA5A03", "Check that the functions Tan, Tanh, and " & - "Arctanh provide correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Tan Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Tan with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when others => - Report.Failed("Unexpected exception on GEF.Tan with large " & - "positive value"); - end; - - begin - The_Result := EF.Tan (FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 2); - exception - when others => - Report.Failed("Unexpected exception on EF.Tan with large " & - "negative value"); - end; - - - -- Check that no exception occurs on computing the Tan with very - -- small (positive and negative) input values. - - begin - New_Float_Result := GEF.Tan (New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when others => - Report.Failed("Unexpected exception on GEF.Tan with small " & - "positive value"); - end; - - begin - The_Result := EF.Tan (-FXA5A00.Small); - Dont_Optimize_Float(The_Result, 4); - exception - when others => - Report.Failed("Unexpected exception on EF.Tan with small " & - "negative value"); - end; - - - -- Check prescribed result from Tan function. When the parameter X - -- has the value zero, the Tan function yields a result of zero. - - if GEF.Tan(0.0) /= 0.0 or - EF.Tan(0.0) /= 0.0 - then - Report.Failed("Incorrect result from Tan function with zero " & - "value input parameter"); - end if; - - - -- Check the results of the Tan function with various input parameters. - - if not (Result_Within_Range(GEF.Tan(0.7854), 1.0, 0.001) and - Result_Within_Range(GEF.Tan(0.8436), 1.124, 0.001) and - Result_Within_Range( EF.Tan(Pi), 0.0, 0.001) and - Result_Within_Range( EF.Tan(-Pi), 0.0, 0.001) and - Result_Within_Range(GEF.Tan(0.5381), 0.597, 0.001) and - Result_Within_Range( EF.Tan(0.1978), 0.200, 0.001)) - then - Report.Failed("Incorrect result from Tan function with various " & - "input parameters"); - end if; - - - -- Testing of Tan function with cycle parameter. - - -- Check that Constraint_Error is raised by the Tan function with - -- specified cycle, when the value of the parameter X is an odd - -- multiple of the quarter cycle. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Tan(270.0, 360.0); - Report.Failed("Constraint_Error not raised by GEF.Tan on odd " & - "multiple of the quarter cycle"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.Tan on odd " & - "multiple of the quarter cycle"); - end; - end if; - - -- Check that the exception Numerics.Argument_Error is raised, when - -- the value of the parameter Cycle is zero or negative. - - begin - New_Float_Result := GEF.Tan(X => 1.0, Cycle => -360.0); - Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " & - "parameter has negative value"); - Dont_Optimize_New_Float(New_Float_Result, 6); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by GEF.Tan when Cycle " & - "parameter has negative value"); - end; - - begin - The_Result := EF.Tan(1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " & - "parameter has a zero value"); - Dont_Optimize_Float(The_Result, 7); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by EF.Tan when Cycle " & - "parameter has a zero value"); - end; - - - -- Check that no exception occurs on computing the Tan with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large), 360.0); - Dont_Optimize_New_Float(New_Float_Result, 8); - exception - when others => - Report.Failed("Unexpected exception on GEF.Tan with large " & - "positive value"); - end; - - begin - The_Result := EF.Tan (FXA5A00.Minus_Large, Cycle => 360.0); - Dont_Optimize_Float(The_Result, 9); - exception - when others => - Report.Failed("Unexpected exception on EF.Tan with large " & - "negative value"); - end; - - - -- Check prescribed result from Tan function with Cycle parameter. - - if GEF.Tan(0.0, 360.0) /= 0.0 or - EF.Tan(0.0, Cycle => 360.0) /= 0.0 - then - Report.Failed("Incorrect result from Tan function with cycle " & - "parameter, using a zero value input parameter"); - end if; - - - -- Check the Tan function, with specified Cycle parameter, with a - -- variety of input parameters. - - if not Result_Within_Range(GEF.Tan(30.0, 360.0), 0.577, 0.001) or - not Result_Within_Range( EF.Tan(57.0, 360.0), 1.540, 0.001) or - not Result_Within_Range(GEF.Tan(115.0, 360.0), -2.145, 0.001) or - not Result_Within_Range( EF.Tan(299.0, 360.0), -1.804, 0.001) or - not Result_Within_Range(GEF.Tan(390.0, 360.0), 0.577, 0.001) or - not Result_Within_Range( EF.Tan(520.0, 360.0), -0.364, 0.001) - then - Report.Failed("Incorrect result from the Tan function with " & - "cycle parameter, with various input parameter " & - "values"); - end if; - - - - -- Testing of Tanh Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Tan with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Tanh (New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 10); - exception - when others => - Report.Failed("Unexpected exception on GEF.Tanh with large " & - "positive value"); - end; - - begin - The_Result := EF.Tanh (FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 11); - exception - when others => - Report.Failed("Unexpected exception on EF.Tanh with large " & - "negative value"); - end; - - - -- Check for prescribed result of Tanh with zero value input parameter. - - if GEF.Tanh (0.0) /= 0.0 or - EF.Tanh (0.0) /= 0.0 - then - Report.Failed("Incorrect result from Tanh with zero parameter"); - end if; - - - -- Check the results of the Tanh function with various input - -- parameters. - - if not (FXA5A00.Result_Within_Range(GEF.Tanh(2.99), 0.995, 0.001) and - FXA5A00.Result_Within_Range(GEF.Tanh(0.130), 0.129, 0.001) and - FXA5A00.Result_Within_Range( EF.Tanh(Pi), 0.996, 0.001) and - FXA5A00.Result_Within_Range( EF.Tanh(-Pi), -0.996, 0.001) and - FXA5A00.Result_Within_Range(GEF.Tanh(0.60), 0.537, 0.001) and - FXA5A00.Result_Within_Range( EF.Tanh(1.04), 0.778, 0.001) and - FXA5A00.Result_Within_Range(GEF.Tanh(1.55), 0.914, 0.001) and - FXA5A00.Result_Within_Range( EF.Tanh(-2.14), -0.973, 0.001)) - then - Report.Failed("Incorrect result from Tanh function with various " & - "input parameters"); - end if; - - - - -- Testing of Arctanh Function, both instantiated and pre-instantiated - -- version. - - -- Check that Constraint_Error is raised by the Arctanh function - -- when the absolute value of the parameter X is one. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Arctanh(X => 1.0); - Report.Failed("Constraint_Error not raised by Function Arctanh " & - "when provided a parameter value of 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 12); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " - & "when provided a parameter value of 1.0"); - end; - end if; - - if Float'Machine_Overflows = True then - begin - The_Result := EF.Arctanh(-1.0); - Report.Failed("Constraint_Error not raised by Function Arctanh " & - "when provided a parameter value of -1.0"); - Dont_Optimize_Float(The_Result, 13); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " - & "when provided a parameter value of -1.0"); - end; - end if; - - -- Check that Function Arctanh raises Argument_Error when the absolute - -- value of the parameter X exceeds one. - - begin - New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.One_Plus_Delta)); - Report.Failed("Argument_Error not raised by Function Arctanh " & - "when provided a parameter value greater than 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 14); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " & - "when provided a parameter value greater than 1.0"); - end; - - - begin - The_Result := EF.Arctanh(FXA5A00.Minus_One_Minus_Delta); - Report.Failed("Argument_Error not raised by Function Arctanh " & - "when provided a parameter value less than -1.0"); - Dont_Optimize_Float(The_Result, 15); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " & - "when provided a parameter value less than -1.0"); - end; - - - begin - New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.Large)); - Report.Failed("Argument_Error not raised by Function Arctanh " & - "when provided a large positive parameter value"); - Dont_Optimize_New_Float(New_Float_Result, 16); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " & - "when provided a large positive parameter value"); - end; - - - begin - The_Result := EF.Arctanh(FXA5A00.Minus_Large); - Report.Failed("Argument_Error not raised by Function Arctanh " & - "when provided a large negative parameter value"); - Dont_Optimize_Float(The_Result, 17); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arctanh " & - "when provided a large negative parameter value"); - end; - - - -- Prescribed results for Function Arctanh with zero input value. - - if GEF.Arctanh(0.0) /= 0.0 or - EF.Arctanh(0.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Arctanh with a " & - "parameter value of zero"); - end if; - - - -- Check the results of the Arctanh function with various input - -- parameters. - - if not (Result_Within_Range(GEF.Arctanh(0.15), 0.151, 0.001) and - Result_Within_Range( EF.Arctanh(0.44), 0.472, 0.001) and - Result_Within_Range(GEF.Arctanh(0.81), 1.127, 0.001) and - Result_Within_Range( EF.Arctanh(0.99), 2.647, 0.001)) - then - Report.Failed("Incorrect result from Arctanh function with " & - "various input parameters"); - end if; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A03; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a deleted file mode 100644 index 9b590a23cb8..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a +++ /dev/null @@ -1,434 +0,0 @@ --- CXA5A04.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 functions Cot, Coth, and Arccoth provide correct --- results. --- --- TEST DESCRIPTION: --- This test examines both the version of Cot, Coth, and Arccoth --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A04.A --- --- --- CHANGE HISTORY: --- 15 Mar 95 SAIC Initial prerelease version. --- 07 Apr 95 SAIC Corrected errors in context clause reference, --- added trigonometric relationship checks. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 28 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi --- 29 Jun 98 EDS Protected exception tests by first testing --- for 'Machine_Overflows --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with Ada.Exceptions; -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A04 is -begin - - Report.Test ("CXA5A04", "Check that the functions Cot, Coth, and " & - "Arccoth provide correct results"); - - Test_Block: - declare - - use Ada.Exceptions; - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Cot Function, both instantiated and pre-instantiated - -- version. - - -- Check that Constraint_Error is raised with the Cot function is - -- given a parameter input value of 0.0. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Cot (0.0); - Report.Failed("Constraint_Error not raised by Function Cot " & - "when provided a zero input parameter value"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Cot " & - "when provided a zero input parameter value"); - end; - end if; - - -- Check that no exception occurs on computing the Cot with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 2); - exception - when others => - Report.Failed("Unexpected exception on GEF.Cot with large " & - "positive value"); - end; - - begin - The_Result := EF.Cot (FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 3); - exception - when others => - Report.Failed("Unexpected exception on EF.Cot with large " & - "negative value"); - end; - - - -- Check the results of the Cot function with various input parameters. - - if not (FXA5A00.Result_Within_Range(GEF.Cot(Pi/4.0), 1.0, 0.001) and - FXA5A00.Result_Within_Range( EF.Cot(Pi/2.0), 0.0, 0.001) and - FXA5A00.Result_Within_Range(GEF.Cot(3.0*Pi/4.0),-1.0, 0.001) and - FXA5A00.Result_Within_Range( EF.Cot(3.0*Pi/2.0), 0.0, 0.001)) - then - Report.Failed("Incorrect result from Cot function with various " & - "input parameters"); - end if; - - - -- Check the results of the Cot function against the results of - -- various trigonometric relationships. - - if not FXA5A00.Result_Within_Range(GEF.Cot(New_Float(Pi/4.0)), - 1.0/EF.Tan(Pi/4.0), - 0.001) or - not FXA5A00.Result_Within_Range(EF.Cot(Pi/4.0), - EF.Cos(Pi/4.0)/EF.Sin(Pi/4.0), - 0.001) or - not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(Pi/4.0)), - Pi/4.0, - 0.001) - then - Report.Failed("Incorrect result from Cot function with respect " & - "to various trigonometric relationship expected " & - "results"); - end if; - - - -- Testing of Cot with Cycle parameter. - - -- Check that Argument_Error is raised by the Cot function when the - -- value of the Cycle parameter is zero or negative. - - begin - New_Float_Result := GEF.Cot (1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by the Cot Function " & - "with a specified cycle value of 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 4); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Unexpected exception raised by the Cot Function with " & - "a specified cycle value of 0.0"); - end; - - begin - The_Result := EF.Cot (X => 1.0, Cycle => -360.0); - Report.Failed("Argument_Error not raised by the Cot Function " & - "with a specified cycle value of -360.0"); - Dont_Optimize_Float(The_Result, 5); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed - ("Unexpected exception raised by the Cot Function with " & - "a specified cycle value of -360.0"); - end; - - - -- Check that Constraint_Error is raised by the Cot Function with - -- specified cycle, when the value of the parameter X is 0.0. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Cot (0.0, 360.0); - Report.Failed("Constraint_Error not raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 6); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is 0.0"); - end; - end if; - - -- Check that Constraint_Error is raised by the Cot Function with - -- specified cycle, when the value of the parameter X is a multiple - -- of the half cycle. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Cot (180.0, 360.0); - Report.Failed("Constraint_Error not raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is a multiple of the half cycle (180.0, 360.0)"); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is a multiple of the half cycle" & - " (180.0, 360.0)"); - end; - end if; - - if Float'Machine_Overflows = True then - begin - The_Result := EF.Cot (540.0, 360.0); - Report.Failed("Constraint_Error not raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is a multiple of the half cycle (540.0, 360.0)"); - Dont_Optimize_Float(The_Result, 8); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Cot " & - "with specified cycle, when value of parameter " & - "X is a multiple of the half cycle (540.0, 360.0)"); - end; - end if; - ---pwb-math -- Check that no exception occurs on computing the Cot with very ---pwb-math -- large (positive and negative) input values. ---pwb-math ---pwb-math begin ---pwb-math New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large), 2.0*Pi); ---pwb-math Dont_Optimize_New_Float(New_Float_Result, 9); ---pwb-math exception ---pwb-math when others => ---pwb-math Report.Failed("Unexpected exception on GEF.Cot with large " & ---pwb-math "positive value"); ---pwb-math end; ---pwb-math ---pwb-math begin ---pwb-math The_Result := EF.Cot (FXA5A00.Minus_Large, Cycle => 2.0*Pi); ---pwb-math Dont_Optimize_Float(The_Result, 10); ---pwb-math exception ---pwb-math when others => ---pwb-math Report.Failed("Unexpected exception on EF.Cot with large " & ---pwb-math "negative value"); ---pwb-math end; ---pwb-math ---pwb-math ---pwb-math -- Check prescribed result from Cot function with Cycle parameter. ---pwb-math ---pwb-math if not FXA5A00.Result_Within_Range ---pwb-math (GEF.Cot(New_Float(FXA5A00.Half_Pi), 2.0*Pi), 0.0, 0.001) or ---pwb-math not FXA5A00.Result_Within_Range ---pwb-math (EF.Cot(3.0*Pi/2.0, Cycle => 2.0*Pi), 0.0, 0.001) ---pwb-math then ---pwb-math Report.Failed("Incorrect result from Cot function with cycle " & ---pwb-math "parameter, using a multiple of Pi/2 as the " & ---pwb-math "input parameter"); ---pwb-math end if; - - - -- Testing of Coth Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Coth with very - -- large (positive and negative) input values. - - begin - The_Result := EF.Coth (FXA5A00.Large); - if The_Result > 1.0 then - Report.Failed("Result of Coth function with large positive " & - "value greater than 1.0"); - end if; - exception - when others => - Report.Failed("Unexpected exception on EF.Coth with large " & - "positive value"); - end; - - begin - The_Result := EF.Coth (FXA5A00.Minus_Large); - if The_Result < -1.0 then - Report.Failed("Result of Coth function with large negative " & - "value less than -1.0"); - end if; - exception - when others => - Report.Failed("Unexpected exception on EF.Coth with large " & - "negative value"); - end; - - - -- Check that Constraint_Error is raised by the Coth function, when - -- the value of the parameter X is 0.0. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Coth (X => 0.0); - Report.Failed("Constraint_Error not raised by the Coth function " & - "when the value of parameter X is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 11); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Coth " & - "function when the value of parameter X is 0.0"); - end; - end if; - - - -- Testing of Arccoth Function, both instantiated and pre-instantiated - -- version. - - -- Check that Constraint_Error is raised by the Arccoth function - -- when the absolute value of the parameter X is 1.0. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Arccoth (X => 1.0); - Report.Failed("Constraint_Error not raised by the Arccoth " & - "function when the value of parameter X is 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 12); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccoth " & - "function when the value of parameter X is 1.0"); - end; - end if; - - if Float'Machine_Overflows = True then - begin - The_Result := EF.Arccoth (-1.0); - Report.Failed("Constraint_Error not raised by the Arccoth " & - "function when the value of parameter X is -1.0"); - Dont_Optimize_Float(The_Result, 13); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccoth " & - "function when the value of parameter X is -1.0"); - end; - end if; - - -- Check that Argument_Error is raised by the Arccoth function when - -- the absolute value of the parameter X is less than 1.0. - - begin - New_Float_Result := GEF.Arccoth (X => New_Float(One_Minus_Delta)); - Report.Failed("Argument_Error not raised by the Arccoth " & - "function with parameter value less than 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 14); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccoth " & - "function with parameter value less than 1.0"); - end; - - begin - The_Result := EF.Arccoth (X => FXA5A00.Minus_One_Plus_Delta); - Report.Failed("Argument_Error not raised by the Arccoth function " & - "with parameter value between 0.0 and -1.0"); - Dont_Optimize_Float(The_Result, 15); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccoth " & - "function with parameter value between 0.0 " & - "and -1.0"); - end; - - - -- Check the results of the Arccoth function with various input - -- parameters. - - if not (Result_Within_Range(GEF.Arccoth(1.01), 2.652, 0.01) and - Result_Within_Range( EF.Arccoth(1.25), 1.099, 0.01) and - Result_Within_Range(GEF.Arccoth(1.56), 0.760, 0.001) and - Result_Within_Range( EF.Arccoth(1.97), 0.560, 0.001) and - Result_Within_Range(GEF.Arccoth(2.40), 0.444, 0.001) and - Result_Within_Range( EF.Arccoth(4.30), 0.237, 0.001) and - Result_Within_Range(GEF.Arccoth(5.80), 0.174, 0.001) and - Result_Within_Range( EF.Arccoth(7.00), 0.144, 0.001)) - then - Report.Failed("Incorrect result from Arccoth function with various " & - "input parameters"); - 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 CXA5A04; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a deleted file mode 100644 index b50da3a6ab5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a +++ /dev/null @@ -1,338 +0,0 @@ --- CXA5A05.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 functions Arcsin and Arcsinh provide correct --- results. --- --- TEST DESCRIPTION: --- This test examines both the version of Arcsin and Arcsinh --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A05.A --- --- --- CHANGE HISTORY: --- 20 Mar 95 SAIC Initial prerelease version. --- 06 Apr 95 SAIC Corrected errors in context clause reference and --- use of Cycle parameter. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 28 Feb 97 PWB.CTA Removed checks with explict Cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A05 is -begin - - Report.Test ("CXA5A05", "Check that the functions Arcsin and Arcsinh " & - "provide correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Function Arcsin, both instantiated and pre-instantiated - -- versions. - - -- Check that Argument_Error is raised by the Arcsin function when - -- the absolute value of the parameter X is greater than 1.0. - - begin - New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.One_Plus_Delta)); - Report.Failed("Argument_Error not raised by Arcsin function " & - "when provided a parameter value larger than 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Arcsin function " & - "when provided a parameter value larger than 1.0"); - end; - - begin - The_Result := EF.Arcsin(FXA5A00.Minus_Large); - Report.Failed("Argument_Error not raised by Arcsin function " & - "when provided a large negative parameter value"); - Dont_Optimize_Float(The_Result, 2); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Arcsin function " & - "when provided a large negative parameter value"); - end; - - - -- Check the prescribed result of function Arcsin with parameter 0.0. - - if GEF.Arcsin(X => 0.0) /= 0.0 or - EF.Arcsin(0.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Arcsin when the " & - "value of the parameter X is 0.0"); - end if; - - - -- Check the results of the Arcsin function with various input - -- parameters. - - if not Result_Within_Range(GEF.Arcsin(1.0), 1.571, 0.001) or - not Result_Within_Range( EF.Arcsin(0.62), 0.669, 0.001) or - not Result_Within_Range(GEF.Arcsin(0.01), 0.010, 0.001) or - not Result_Within_Range( EF.Arcsin(-0.29), -0.294, 0.001) or - not Result_Within_Range(GEF.Arcsin(-0.50), -0.524, 0.001) or - not Result_Within_Range( EF.Arcsin(-1.0), -1.571, 0.001) - then - Report.Failed("Incorrect result from Function Arcsin with " & - "various input parameters"); - end if; - - - -- Testing of Function Arcsin with specified Cycle parameter. - ---pwb-math -- Check that Argument_Error is raised by the Arcsin function with ---pwb-math -- specified cycle, whenever the absolute value of the parameter X ---pwb-math -- is greater than 1.0. ---pwb-math ---pwb-math begin ---pwb-math New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.Large), 2.0*Pi); ---pwb-math Report.Failed("Argument_Error not raised by Function Arcsin " & ---pwb-math "with specified cycle, when provided a large " & ---pwb-math "positive input parameter"); ---pwb-math Dont_Optimize_New_Float(New_Float_Result, 3); ---pwb-math exception ---pwb-math when Argument_Error => null; -- OK, expected exception. ---pwb-math when others => ---pwb-math Report.Failed("Unexpected exception raised by Function Arcsin " & ---pwb-math "with specified cycle, when provided a large " & ---pwb-math "positive input parameter"); ---pwb-math end; ---pwb-math ---pwb-math begin ---pwb-math The_Result := EF.Arcsin(FXA5A00.Minus_One_Minus_Delta, 2.0*Pi); ---pwb-math Report.Failed("Argument_Error not raised by Function Arcsin " & ---pwb-math "with specified cycle, when provided an input " & ---pwb-math "parameter less than -1.0"); ---pwb-math Dont_Optimize_Float(The_Result, 4); ---pwb-math exception ---pwb-math when Argument_Error => null; -- OK, expected exception. ---pwb-math when others => ---pwb-math Report.Failed("Unexpected exception raised by Function Arcsin " & ---pwb-math "with specified cycle, when provided an input " & ---pwb-math "parameter less than -1.0"); ---pwb-math end; ---pwb-math - -- Check that Argument_Error is raised by the Arcsin function with - -- specified cycle, whenever the Cycle parameter is zero or negative. - - begin - New_Float_Result := GEF.Arcsin(2.0, 0.0); - Report.Failed("Argument_Error not raised by Function Arcsin " & - "with specified cycle of 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arcsin " & - "with specified cycle of 0.0"); - end; - - begin - The_Result := EF.Arcsin(2.0, -2.0*Pi); - Report.Failed("Argument_Error not raised by Function Arcsin " & - "with specified negative cycle parameter"); - Dont_Optimize_Float(The_Result, 6); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Arcsin " & - "with specified negative cycle parameter"); - end; - - ---pwb-math -- Check the prescribed result of function Arcsin with specified Cycle ---pwb-math -- parameter, when the value of parameter X is 0.0. ---pwb-math ---pwb-math if GEF.Arcsin(X => 0.0, Cycle => 2.0*Pi) /= 0.0 or ---pwb-math EF.Arcsin(0.0, 2.0*Pi) /= 0.0 ---pwb-math then ---pwb-math Report.Failed("Incorrect result from Function Arcsin with " & ---pwb-math "specified Cycle parameter, when the value " & ---pwb-math "of parameter X is 0.0"); ---pwb-math end if; ---pwb-math ---pwb-math ---pwb-math -- Test of the Arcsin function with specified Cycle parameter with ---pwb-math -- various input parameters. ---pwb-math ---pwb-math if not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.01, 2.0*Pi), ---pwb-math 0.010, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range( EF.Arcsin( 0.14, 2.0*Pi), ---pwb-math 0.141, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.37, 2.0*Pi), ---pwb-math 0.379, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range( EF.Arcsin( 0.55, 2.0*Pi), ---pwb-math 0.582, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range(GEF.Arcsin(-0.22, 2.0*Pi), ---pwb-math -0.222, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range( EF.Arcsin(-0.99, 2.0*Pi), ---pwb-math -1.43, ---pwb-math 0.01) or ---pwb-math not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 360.0), ---pwb-math 90.0, ---pwb-math 0.1) or ---pwb-math not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 100.0), ---pwb-math 25.0, ---pwb-math 0.1) ---pwb-math then ---pwb-math Report.Failed("Incorrect result from Arcsin with specified " & ---pwb-math "cycle parameter with various input parameters"); ---pwb-math end if; - - -- Testing of Arcsinh Function, both instantiated and pre-instantiated - -- version. - - -- Check that no exception occurs on computing the Arcsinh with very - -- large (positive and negative) input values. - - begin - New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when others => - Report.Failed("Unexpected exception on Arcsinh with large " & - "positive value"); - end; - - begin - The_Result := EF.Arcsinh(FXA5A00.Minus_Large); - Dont_Optimize_Float(The_Result, 8); - exception - when others => - Report.Failed("Unexpected exception on Arcsinh with large " & - "negative value"); - end; - - - -- Check that no exception occurs on computing the Arcsinh with very - -- small (positive and negative) input values. - - begin - New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 9); - exception - when others => - Report.Failed("Unexpected exception on Arcsinh with small " & - "positive value"); - end; - - begin - The_Result := EF.Arcsinh(-FXA5A00.Small); - Dont_Optimize_Float(The_Result, 10); - exception - when others => - Report.Failed("Unexpected exception on Arcsinh with small " & - "negative value"); - end; - - - -- Check function Arcsinh for prescribed result with parameter 0.0. - - if GEF.Arcsinh(X => 0.0) /= 0.0 or - EF.Arcsinh(X => 0.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Arcsinh when " & - "provided a 0.0 input parameter"); - end if; - - - -- Check the results of the Arcsinh function with various input - -- parameters. - - if not Result_Within_Range(GEF.Arcsinh(0.15), 0.149, 0.001) or - not Result_Within_Range( EF.Arcsinh(0.82), 0.748, 0.001) or - not Result_Within_Range(GEF.Arcsinh(1.44), 1.161, 0.001) or - not Result_Within_Range(GEF.Arcsinh(6.70), 2.601, 0.001) or - not Result_Within_Range( EF.Arcsinh(Pi), 1.862, 0.001) or - not Result_Within_Range( EF.Arcsinh(-Pi), -1.862, 0.001) or - not Result_Within_Range(GEF.Arcsinh(-1.0), -0.881, 0.001) or - not Result_Within_Range( EF.Arcsinh(-5.5), -2.406, 0.001) - then - Report.Failed("Incorrect result from Function Arcsin with " & - "various input parameters"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A05; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a deleted file mode 100644 index 191a96d7567..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a +++ /dev/null @@ -1,334 +0,0 @@ --- CXA5A06.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 functions Arccos and Arccosh provide correct --- results. --- --- TEST DESCRIPTION: --- This test examines both the version of Arccos and Arccosh --- the instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A06.A --- --- --- CHANGE HISTORY: --- 27 Mar 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 28 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A06 is -begin - - Report.Test ("CXA5A06", "Check that the functions Arccos and Arccosh " & - "provide correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - The_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Arccos Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the Arccos function when the - -- absolute value of the input parameter is greater than 1.0. - - begin - New_Float_Result := GEF.Arccos(New_Float(FXA5A00.One_Plus_Delta)); - Report.Failed("Argument_Error not raised by the Arccos function " & - "when the input parameter is greater than 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function when the input parameter is greater " & - "than 1.0"); - end; - - begin - The_Result := EF.Arccos(-FXA5A00.Large); - Report.Failed("Argument_Error not raised by the Arccos function " & - "when the input parameter is a large negative value"); - Dont_Optimize_Float(The_Result, 2); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function when the input parameter is a " & - "large negative value"); - end; - - - -- Check the prescribed results of the Arccos function. - - if GEF.Arccos(X => 1.0) /= 0.0 or - EF.Arccos(1.0) /= 0.0 - then - Report.Failed("Incorrect result returned by the Arccos function " & - "when provided a parameter value of 0.0"); - end if; - - - -- Check the results of the Arccos function with various input - -- parameters. - - if not Result_Within_Range(GEF.Arccos(0.77), 0.692, 0.001) or - not Result_Within_Range( EF.Arccos(0.37), 1.19, 0.01) or - not Result_Within_Range(GEF.Arccos(0.0), Pi/2.0, 0.01) or - not Result_Within_Range( EF.Arccos(-0.11), 1.68, 0.01) or - not Result_Within_Range(GEF.Arccos(-0.67), 2.31, 0.01) or - not Result_Within_Range( EF.Arccos(-0.94), 2.79, 0.01) or - not Result_Within_Range(GEF.Arccos(-1.0), Pi, 0.01) - then - Report.Failed("Incorrect result returned from the Arccos " & - "function when provided a variety of input " & - "parameters"); - end if; - - - -- Testing of the Arccos function with specified Cycle parameter. - - -- Check that Argument_Error is raised by the Arccos function, with - -- specified Cycle parameter, when the absolute value of the input - -- parameter is greater than 1.0. - - begin ---pwb-math: Next line: Changed 2.0*Pi to 360.0 - New_Float_Result := GEF.Arccos(New_Float(Large), Cycle => 360.0); - Report.Failed("Argument_Error not raised by the Arccos function " & - "with specified Cycle parameter, when the input " & - "parameter is a large positive value"); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function with specified Cycle parameter, when " & - "the input parameter is a large positive value"); - end; - - begin ---pwb-math: Next line: Changed 2.0*Pi to 360.0 - The_Result := EF.Arccos(FXA5A00.Minus_One_Minus_Delta, 360.0); - Report.Failed("Argument_Error not raised by the Arccos function " & - "with specified Cycle parameter, when the input " & - "parameter is less than -1.0"); - Dont_Optimize_Float(The_Result, 4); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function with specified Cycle parameter, " & - "when the input parameter is less than -1.0"); - end; - - - -- Check that Argument_Error is raised by the Arccos function with - -- specified cycle when the value of the Cycle parameter is zero or - -- negative. - - begin - New_Float_Result := GEF.Arccos(X => 1.0, Cycle => 0.0 ); - Report.Failed("Argument_Error not raised by the Arccos function " & - "with specified Cycle parameter, when the Cycle " & - "parameter is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function with specified Cycle parameter, when " & - "the Cycle parameter is 0.0"); - end; - - begin - The_Result := EF.Arccos(1.0, Cycle => -2.0*Pi); - Report.Failed("Argument_Error not raised by the Arccos function " & - "with specified Cycle parameter, when the Cycle " & - "parameter is negative"); - Dont_Optimize_Float(The_Result, 6); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccos " & - "function with specified Cycle parameter, when " & - "the Cycle parameter is negative"); - end; - - - -- Check the prescribed result of the Arccos function with specified - -- Cycle parameter. - ---pwb-math: Next two lines: Changed 2.0*Pi to 360.0 - if GEF.Arccos(X => 1.0, Cycle => 360.0) /= 0.0 or - EF.Arccos(1.0, 360.0) /= 0.0 - then - Report.Failed("Incorrect result from the Arccos function with " & - "specified Cycle parameter, when the input " & - "parameter value is 1.0"); - end if; - - - -- Check the results of the Arccos function, with specified Cycle - -- parameter, with various input parameters. - - if --pwb-math not Result_Within_Range(GEF.Arccos( 0.04, 2.0*Pi), 1.53, 0.01) or ---pwb-math not Result_Within_Range( EF.Arccos( 0.14, 2.0*Pi), 1.43, 0.01) or ---pwb-math not Result_Within_Range(GEF.Arccos( 0.57, 2.0*Pi), 0.96, 0.01) or ---pwb-math not Result_Within_Range( EF.Arccos( 0.99, 2.0*Pi), 0.14, 0.01) or - not Result_Within_Range(GEF.Arccos(-1.0, 360.0), 180.0, 0.1) or - not Result_Within_Range(GEF.Arccos(-1.0, 100.0), 50.0, 0.1) or - not Result_Within_Range(GEF.Arccos( 0.0, 360.0), 90.0, 0.1) or - not Result_Within_Range(GEF.Arccos( 0.0, 100.0), 25.0, 0.1) - then - Report.Failed("Incorrect result returned from the Arccos " & - "function with specified Cycle parameter, " & - "when provided a variety of input parameters"); - end if; - - - - -- Testing of Arccosh Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the Arccosh function when - -- the value of the parameter X is less than 1.0. - - begin - New_Float_Result := GEF.Arccosh(New_Float(FXA5A00.One_Minus_Delta)); - Report.Failed("Argument_Error not raised by the Arccosh function " & - "when the parameter value is less than 1.0"); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccosh " & - "function when given a parameter value less " & - "than 1.0"); - end; - - begin - The_Result := EF.Arccosh(0.0); - Report.Failed("Argument_Error not raised by the Arccosh function " & - "when the parameter value is 0.0"); - Dont_Optimize_Float(The_Result, 8); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccosh " & - "function when given a parameter value of 0.0"); - end; - - begin - New_Float_Result := GEF.Arccosh(New_Float(-FXA5A00.Large)); - Report.Failed("Argument_Error not raised by the Arccosh function " & - "when the large negative parameter value"); - Dont_Optimize_New_Float(New_Float_Result, 9); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Arccosh " & - "function when given a large negative parameter " & - "value"); - end; - - - -- Check the prescribed results of the Arccosh function. - - if GEF.Arccosh(X => 1.0) /= 0.0 or - EF.Arccosh(1.0) /= 0.0 - then - Report.Failed("Incorrect result returned by the Arccosh " & - "function when provided a parameter value of 0.0"); - end if; - - - -- Check the results of the Arccosh function with various input - -- parameters. - - if not Result_Within_Range(GEF.Arccosh(1.03), 0.244, 0.001) or - not Result_Within_Range( EF.Arccosh(1.28), 0.732, 0.001) or - not Result_Within_Range(GEF.Arccosh(1.50), 0.962, 0.001) or - not Result_Within_Range( EF.Arccosh(1.77), 1.17, 0.01) or - not Result_Within_Range(GEF.Arccosh(2.00), 1.32, 0.01) or - not Result_Within_Range( EF.Arccosh(4.30), 2.14, 0.01) or - not Result_Within_Range(GEF.Arccosh(6.90), 2.62, 0.01) - then - Report.Failed("Incorrect result returned from the Arccosh " & - "function when provided a variety of input " & - "parameters"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A06; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a deleted file mode 100644 index 179d54c44bf..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a +++ /dev/null @@ -1,413 +0,0 @@ --- CXA5A07.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 Arctan provides correct results. --- --- TEST DESCRIPTION: --- This test examines both the version of Arctan resulting from the --- instantiation of the Ada.Numerics.Generic_Elementary_Functions with --- a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A07.A --- --- --- CHANGE HISTORY: --- 04 Apr 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 28 Feb 97 PWB.CTA Removed checks with explicit Cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A07 is -begin - - Report.Test ("CXA5A07", "Check that the Arctan function provides " & - "correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - Float_Result : Float; - New_Float_Result : New_Float; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Arctan Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the Arctan function when - -- provided parameter values of 0.0, 0.0. - - begin - New_Float_Result := GEF.Arctan(Y => 0.0, X => 0.0); - Report.Failed("Argument_Error not raised when the Arctan " & - "function is provided input of 0.0, 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arctan " & - "function when provided 0.0, 0.0 input parameters"); - end; - - - -- Check that no exception is raised by the Arctan function when - -- provided a large positive or negative Y parameter value, when - -- using the default value for parameter X. - - begin - Float_Result := EF.Arctan(Y => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 2); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a large positive Y parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a large negative Y parameter value"); - end; - - - -- Check that no exception is raised by the Arctan function when - -- provided a small positive or negative Y parameter value, when - -- using the default value for parameter X. - - begin - Float_Result := EF.Arctan(Y => FXA5A00.Small); - Dont_Optimize_Float(Float_Result, 4); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a small positive Y parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a small negative Y parameter value"); - end; - - - -- Check that no exception is raised by the Arctan function when - -- provided combinations of large and small positive or negative - -- parameter values for both Y and X input parameters. - - begin - Float_Result := EF.Arctan(Y => FXA5A00.Large, X => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 6); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided large positive X and Y parameter values"); - end; - - begin - New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Large), - X => New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a large negative Y parameter value " & - "and a small positive X parameter value"); - end; - - - begin - Float_Result := EF.Arctan(Y => FXA5A00.Small, X => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 8); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a small positive Y parameter value " & - "and a large positive X parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Small), - New_Float(-FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 9); - exception - when others => - Report.Failed("Exception raised when the Arctan function is " & - "provided a small negative Y parameter value " & - "and a large negative parameter value"); - end; - - - -- Check that when the Arctan function is provided a Y parameter value - -- of 0.0 and a positive X parameter input value, the prescribed result - -- of zero is returned. - - if GEF.Arctan(Y => 0.0) /= 0.0 or -- Default X value - EF.Arctan(Y => 0.0, X => FXA5A00.Large) /= 0.0 or ---pwb-math: Next line: changed 2.0*Pi to 360.0 - GEF.Arctan(0.0, 360.0) /= 0.0 or - EF.Arctan(0.0, FXA5A00.Small) /= 0.0 - then - Report.Failed("Incorrect results from the Arctan function when " & - "provided a Y parameter value of 0.0 and various " & - "positive X parameter values"); - end if; - - - -- Check that the Arctan function provides correct results when provided - -- a variety of Y parameter values. - - if not FXA5A00.Result_Within_Range(EF.Arctan(Pi), 1.26, 0.01) or - not FXA5A00.Result_Within_Range(EF.Arctan(-Pi), -1.26, 0.01) or - not FXA5A00.Result_Within_Range(GEF.Arctan(1.0), 0.785, 0.001) or - not FXA5A00.Result_Within_Range(EF.Arctan(-1.0), -0.785, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Arctan(0.25), 0.245, 0.001) or - not FXA5A00.Result_Within_Range(EF.Arctan(0.92), 0.744, 0.001) - then - Report.Failed("Incorrect results from the Arctan function when " & - "provided a variety of Y parameter values"); - end if; - - - - -- Check the results of the Arctan function with specified cycle - -- parameter. - - -- Check that the Arctan function with specified Cycle parameter - -- raises Argument_Error when the value of the Cycle parameter is zero - -- or negative. - - begin - Float_Result := EF.Arctan(Y => Pi, Cycle => 0.0); -- Default X value - Report.Failed("Argument_Error not raised by the Arctan function " & - "with default X parameter value, when the Cycle " & - "parameter is 0.0"); - Dont_Optimize_Float(Float_Result, 10); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arctan " & - "function with default X parameter value, when " & - "provided a 0.0 cycle parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by the Arctan function " & - "when the Cycle parameter is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 11); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arctan " & - "function when provided a 0.0 cycle parameter " & - "value"); - end; - - begin - Float_Result := EF.Arctan(Y => Pi, Cycle => -360.0); - Report.Failed("Argument_Error not raised by the Arctan function " & - "with a default X parameter value, when the Cycle " & - "parameter is -360.0"); - Dont_Optimize_Float(Float_Result, 12); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arctan " & - "function with a default X parameter value, when " & - "provided a -360.0 cycle parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => -Pi); - Report.Failed("Argument_Error not raised by the Arctan function " & - "when the Cycle parameter is -Pi"); - Dont_Optimize_New_Float(New_Float_Result, 13); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arctan " & - "function when provided a -Pi cycle parameter " & - "value"); - end; - - - -- Check that no exception is raised by the Arctan function with - -- specified Cycle parameter, when provided large and small positive - -- or negative parameter values for both Y and X input parameters. - - begin - Float_Result := EF.Arctan(Y => -FXA5A00.Large, - X => -FXA5A00.Large, ---pwb-math: Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_Float(Float_Result, 14); - exception - when others => - Report.Failed("Exception raised when the Arctan function with " & - "specified Cycle parameter, when provided large " & - "negative X and Y parameter values"); - end; - - - begin - New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Large), - X => New_Float(-FXA5A00.Small), ---pwb-math: Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_New_Float(New_Float_Result, 15); - exception - when others => - Report.Failed("Exception raised when the Arctan function with " & - "specified Cycle parameter, when provided large " & - "positive Y parameter value and a small negative " & - "X parameter value"); - end; - - - begin - Float_Result := EF.Arctan(Y => -FXA5A00.Small, - X => -FXA5A00.Large, ---pwb-math: Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_Float(Float_Result, 16); - exception - when others => - Report.Failed("Exception raised when the Arctan function with " & - "specified Cycle parameter, when provided large " & - "negative Y parameter value and a large negative " & - "X parameter value"); - end; - - begin - New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Small), - New_Float(FXA5A00.Large), ---pwb-math: Next line: changed 2.0*Pi to 360.0 - 360.0); - Dont_Optimize_New_Float(New_Float_Result, 17); - exception - when others => - Report.Failed("Exception raised when the Arctan function with " & - "specified Cycle parameter, when provided a " & - "small negative Y parameter value and a large " & - "positive X parameter value"); - end; - - - -- Check that the Arctan function with specified Cycle parameter - -- provides correct results when provided a variety of Y parameter - -- input values. - ---pwb-math if not FXA5A00.Result_Within_Range(EF.Arctan(Pi, Cycle => 2.0*Pi), ---pwb-math 1.26, ---pwb-math 0.01) or ---pwb-math not FXA5A00.Result_Within_Range(EF.Arctan(-Pi, Cycle => 2.0*Pi), ---pwb-math -1.26, ---pwb-math 0.01) or ---pwb-math not FXA5A00.Result_Within_Range(GEF.Arctan(1.0, Cycle => 2.0*Pi), ---pwb-math 0.785, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range(EF.Arctan(-1.0, Cycle => 2.0*Pi), ---pwb-math -0.785, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range(GEF.Arctan(0.16, Cycle => 2.0*Pi), ---pwb-math 0.159, ---pwb-math 0.001) or ---pwb-math not FXA5A00.Result_Within_Range(EF.Arctan(1.0, Cycle => 360.0), ---pwb-math 45.0, ---pwb-math 0.1) or ---pwb-math not FXA5A00.Result_Within_Range(GEF.Arctan(1.0, Cycle => 100.0), ---pwb-math 12.5, ---pwb-math 0.1) - ---pwb-math Next 12 lines are replacements for 21 commented lines above - if not FXA5A00.Result_Within_Range(GEF.Arctan(1.0, Cycle => 2.0*180.0), - 45.0, - 0.001) or - not FXA5A00.Result_Within_Range(EF.Arctan(-1.0, Cycle => 2.0*180.0), - -45.0, - 0.001) or - not FXA5A00.Result_Within_Range(EF.Arctan(1.0, Cycle => 360.0), - 45.0, - 0.1) or - not FXA5A00.Result_Within_Range(GEF.Arctan(1.0, Cycle => 100.0), - 12.5, - 0.1) - then - Report.Failed("Incorrect results from the Arctan function with " & - "specified Cycle parameter when provided a variety " & - "of Y parameter values"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A07; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a deleted file mode 100644 index ae2b85a6d43..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a +++ /dev/null @@ -1,474 +0,0 @@ --- CXA5A08.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 Arccot provides correct results. --- --- TEST DESCRIPTION: --- This test examines both the version of Arccot resulting from the --- instantiation of the Ada.Numerics.Generic_Elementary_Functions --- with a type derived from type Float, as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A08.A --- --- --- CHANGE HISTORY: --- 06 Apr 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 28 Feb 97 CTA.PWB Removed checks with explicit Cycle => 2.0*Pi --- --- CHANGE NOTE: --- According to Ken Dritz, author of the Numerics Annex of the RM, --- one should never specify the cycle 2.0*Pi for the trigonometric --- functions. In particular, if the machine number for the first --- argument is not an exact multiple of the machine number for the --- explicit cycle, then the specified exact results cannot be --- reasonably expected. The affected checks in this test have been --- marked as comments, with the additional notation "pwb-math". --- Phil Brashear ---! - -with Ada.Exceptions; -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A08 is -begin - - Report.Test ("CXA5A08", "Check that the Arccot function provides " & - "correct results"); - - Test_Block: - declare - - use Ada.Exceptions; - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - Float_Result : Float; - Angle : Float; - New_Float_Result : New_Float; - New_Float_Angle : New_Float; - Incorrect_Inverse : Boolean := False; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Arccot Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the Arccot function when - -- provided parameter values of 0.0, 0.0. - - begin - New_Float_Result := GEF.Arccot(X => 0.0, Y => 0.0); - Report.Failed("Argument_Error not raised when the Arccot " & - "function is provided input of 0.0, 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arccot " & - "function when provided 0.0, 0.0 input parameters"); - end; - - - -- Check that no exception is raised by the Arccot function when - -- provided a large positive or negative X parameter value, when - -- using the default value for parameter Y. - - begin - Float_Result := EF.Arccot(X => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 2); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a large positive X parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a large negative X parameter value"); - end; - - - -- Check that no exception is raised by the Arccot function when - -- provided a small positive or negative X parameter value, when - -- using the default value for parameter Y. - - begin - Float_Result := EF.Arccot(X => FXA5A00.Small); - Dont_Optimize_Float(Float_Result, 4); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a small positive X parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a small negative X parameter value"); - end; - - - -- Check that no exception is raised by the Arccot function when - -- provided combinations of large and small positive or negative - -- parameter values for both X and Y input parameters. - - begin - Float_Result := EF.Arccot(X => FXA5A00.Large, Y => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 6); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided large positive X and Y parameter values"); - end; - - begin - New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Large), - Y => New_Float(FXA5A00.Small)); - Dont_Optimize_New_Float(New_Float_Result, 7); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a large negative X parameter value " & - "and a small positive Y parameter value"); - end; - - - begin - Float_Result := EF.Arccot(X => FXA5A00.Small, Y => FXA5A00.Large); - Dont_Optimize_Float(Float_Result, 8); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a small positive X parameter value " & - "and a large positive Y parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Small), - New_Float(-FXA5A00.Large)); - Dont_Optimize_New_Float(New_Float_Result, 9); - exception - when others => - Report.Failed("Exception raised when the Arccot function is " & - "provided a small negative X parameter value " & - "and a large negative Y parameter value"); - end; - - - -- Check that when the Arccot function is provided a Y parameter value - -- of 0.0 and a positive X parameter input value, the prescribed result - -- of zero is returned. - - if EF.Arccot(X => FXA5A00.Large, Y => 0.0) /= 0.0 or - GEF.Arccot(2.0*Pi, Y => 0.0) /= 0.0 or - EF.Arccot(FXA5A00.Small, 0.0) /= 0.0 or - EF.Arccot(X => FXA5A00.Large, Y => 0.0, Cycle => 360.0) /= 0.0 or - GEF.Arccot(2.0*Pi, Y => 0.0, Cycle => 360.0) /= 0.0 or - EF.Arccot(FXA5A00.Small, 0.0, Cycle => 360.0) /= 0.0 - then - Report.Failed("Incorrect results from the Arccot function when " & - "provided a Y parameter value of 0.0 and various " & - "positive X parameter values"); - end if; - - - -- Check that the Arccot function provides correct results when - -- provided a variety of X parameter values. - - if not Result_Within_Range( EF.Arccot( 1.0), Pi/4.0, 0.001) or - not Result_Within_Range(GEF.Arccot( 0.0), Pi/2.0, 0.001) or - not Result_Within_Range( EF.Arccot(-1.0), 3.0*Pi/4.0, 0.001) - then - Report.Failed("Incorrect results from the Arccot function when " & - "provided a variety of Y parameter values"); - end if; - - - -- Check the results of the Arccot function with specified cycle - -- parameter. - - -- Check that the Arccot function with specified Cycle parameter - -- raises Argument_Error when the value of the Cycle parameter is zero - -- or negative. - - begin - Float_Result := EF.Arccot(X => Pi, Cycle => 0.0); -- Default Y value - Report.Failed("Argument_Error not raised by the Arccot function " & - "with default Y parameter value, when the Cycle " & - "parameter is 0.0"); - Dont_Optimize_Float(Float_Result, 10); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arccot " & - "function with default Y parameter value, when " & - "provided a 0.0 cycle parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => 0.0); - Report.Failed("Argument_Error not raised by the Arccot function " & - "when the Cycle parameter is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 11); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arccot " & - "function when provided a 0.0 cycle parameter " & - "value"); - end; - - begin - Float_Result := EF.Arccot(X => Pi, Cycle => -360.0); - Report.Failed("Argument_Error not raised by the Arccot function " & - "with a default Y parameter value, when the Cycle " & - "parameter is -360.0"); - Dont_Optimize_Float(Float_Result, 12); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arccot " & - "function with a default Y parameter value, when " & - "provided a -360.0 cycle parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => -Pi); - Report.Failed("Argument_Error not raised by the Arccot function " & - "when the Cycle parameter is -Pi"); - Dont_Optimize_New_Float(New_Float_Result, 13); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Incorrect exception raised by the Arccot " & - "function when provided a -Pi cycle parameter " & - "value"); - end; - - - -- Check that no exception is raised by the Arccot function with - -- specified Cycle parameter, when provided large and small positive - -- or negative parameter values for both X and Y input parameters. - - begin - Float_Result := EF.Arccot(X => -FXA5A00.Large, - Y => -FXA5A00.Large, ---pwb-math Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_Float(Float_Result, 14); - exception - when others => - Report.Failed("Exception raised when the Arccot function with " & - "specified Cycle parameter, when provided large " & - "negative X and Y parameter values"); - end; - - - begin - New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Large), - Y => New_Float(-FXA5A00.Small), ---pwb-math Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_New_Float(New_Float_Result, 15); - exception - when others => - Report.Failed("Exception raised when the Arccot function with " & - "specified Cycle parameter, when provided large " & - "positive X parameter value and a small negative " & - "Y parameter value"); - end; - - - begin - Float_Result := EF.Arccot(X => -FXA5A00.Small, - Y => -FXA5A00.Large, ---pwb-math Next line: changed 2.0*Pi to 360.0 - Cycle => 360.0); - Dont_Optimize_Float(Float_Result, 16); - exception - when others => - Report.Failed("Exception raised when the Arccot function with " & - "specified Cycle parameter, when provided small " & - "negative X parameter value and a large negative " & - "Y parameter value"); - end; - - begin - New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Small), - New_Float(FXA5A00.Large), ---pwb-math Next line: changed 2.0*Pi to 360.0 - 360.0); - Dont_Optimize_New_Float(New_Float_Result, 17); - exception - when others => - Report.Failed("Exception raised when the Arccot function with " & - "specified Cycle parameter, when provided a " & - "small positive X parameter value and a large " & - "positive Y parameter value"); - end; - - - -- Check that the Arccot function with specified Cycle parameter - -- provides correct results when provided a variety of X parameter - -- input values. - - if not FXA5A00.Result_Within_Range(GEF.Arccot( 0.0, Cycle => 360.0), - 90.0, - 0.001) or - not FXA5A00.Result_Within_Range(EF.Arccot( 0.0, Cycle => 100.0), - 25.0, - 0.001) or - not FXA5A00.Result_Within_Range(GEF.Arccot( 1.0, Cycle => 360.0), - 45.0, - 0.001) or - not FXA5A00.Result_Within_Range(EF.Arccot( 1.0, Cycle => 100.0), - 12.5, - 0.001) or - not FXA5A00.Result_Within_Range(GEF.Arccot(-1.0, Cycle => 360.0), - 135.0, - 0.001) or - not FXA5A00.Result_Within_Range(EF.Arccot(-1.0, Cycle => 100.0), - 37.5, - 0.001) - then - Report.Failed("Incorrect results from the Arccot function with " & - "specified Cycle parameter when provided a variety " & - "of X parameter values"); - end if; - - - if not FXA5A00.Result_Within_Range(EF.Arccot(0.2425355, 0.9701420), - EF.Arccot(0.25), - 0.01) or - not FXA5A00.Result_Within_Range(EF.Arccot(0.3162277, 0.9486831), - Ef.Arccot(0.33), - 0.01) - then - Report.Failed("Incorrect results from the Arccot function with " & - "comparison to other Arccot function results"); - end if; - - - if not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.4472135, - 0.8944270)), - 0.5, - 0.01) or - not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.9987380, - 0.0499369)), - 20.0, - 0.1) - then - Report.Failed("Incorrect results from the Arccot function when " & - "used as argument to Cot function"); - end if; - - - -- Check that inverse function results are correct. - -- Default Cycle test. - - Angle := 0.001; - while Angle < Pi and not Incorrect_Inverse loop - if not Result_Within_Range(EF.Arccot(EF.Cot(Angle)), Angle, 0.001) - then - Incorrect_Inverse := True; - end if; - Angle := Angle + 0.001; - end loop; - - if Incorrect_Inverse then - Report.Failed("Incorrect results returned from the Inverse " & - "comparison of Cot and Arccot using the default " & - "cycle value"); - Incorrect_Inverse := False; - end if; - - -- Non-Default Cycle test. - - New_Float_Angle := 0.01; - while New_Float_Angle < 180.0 and not Incorrect_Inverse loop - if not Result_Within_Range(EF.Arccot(EF.Cot(Float(New_Float_Angle), - Cycle => 360.0), - Cycle => 360.0), - Float(New_Float_Angle), - 0.01) or - not Result_Within_Range(GEF.Arccot( - New_Float(GEF.Cot(New_Float_Angle, - Cycle => 360.0)), - Cycle => 360.0), - Float(New_Float_Angle), - 0.01) - then - Incorrect_Inverse := True; - end if; - New_Float_Angle := New_Float_Angle + 0.01; - end loop; - - if Incorrect_Inverse then - Report.Failed("Incorrect results returned from the Inverse " & - "comparison of Cot and Arccot using non-default " & - "cycle value"); - 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 CXA5A08; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a deleted file mode 100644 index 22bd2f8909c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a +++ /dev/null @@ -1,400 +0,0 @@ --- CXA5A09.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 Log provides correct results. --- --- TEST DESCRIPTION: --- This test examines both the version of Log resulting from the --- instantiation of the Ada.Numerics.Generic_Elementary_Functions with --- with a type derived from type Float,as well as the preinstantiated --- version of this package for type Float. --- Prescribed results, including instances prescribed to raise --- exceptions, are examined in the test cases. In addition, --- certain evaluations are performed where the actual function result --- is compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A09.A --- --- --- CHANGE HISTORY: --- 11 Apr 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 29 Jun 98 EDS Protected exception tests by first testing --- for 'Machine_Overflows --- ---! - -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A09 is -begin - - Report.Test ("CXA5A09", "Check that the Log function provides " & - "correct results"); - - Test_Block: - declare - - use Ada.Numerics; - use FXA5A00; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - Arg, - Float_Result : Float := 0.0; - New_Float_Result : New_Float := 0.0; - - Incorrect_Inverse, - Incorrect_Inverse_Base_2, - Incorrect_Inverse_Base_8, - Incorrect_Inverse_Base_10, - Incorrect_Inverse_Base_16 : Boolean := False; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of Log Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised when the parameter X is negative. - - begin - New_Float_Result := GEF.Log(X => -1.0); - Report.Failed("Argument_Error not raised by the Log function " & - "when the input parameter is negative"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "when the input parameter is negative"); - end; - - begin - Float_Result := EF.Log(X => -FXA5A00.Large); - Report.Failed("Argument_Error not raised by the Log function " & - "when the input parameter is negative"); - Dont_Optimize_Float(Float_Result, 2); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "when the input parameter is negative"); - end; - - - -- Check that Constraint_Error is raised when the Log function is - -- provided an input parameter of zero. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Log(X => 0.0); - Report.Failed("Constraint_Error not raised by the Log function " & - "when the input parameter is zero"); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " - & "when the input parameter is zero"); - end; - end if; - - - -- Check for the reference manual prescribed results of the Log function. - - if GEF.Log(X => 1.0) /= 0.0 or - EF.Log(X => 1.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Log when provided " & - "an input parameter value of 1.0"); - end if; - - - -- Check that the Log function provides correct results when provided - -- a variety of input parameters. - - if not FXA5A00.Result_Within_Range(GEF.Log(0.015), -4.20, 0.01) or - not FXA5A00.Result_Within_Range(GEF.Log(0.592), -0.524, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Log(0.997), -0.003, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Log(1.341), 0.293, 0.001) or - not FXA5A00.Result_Within_Range( EF.Log(2.826), 1.04, 0.01) or - not FXA5A00.Result_Within_Range( EF.Log(10.052), 2.31, 0.01) or - not FXA5A00.Result_Within_Range( EF.Log(2569.143), 7.85, 0.01) - then - Report.Failed("Incorrect results from Function Log when provided " & - "a variety of input parameter values"); - end if; - - Arg := 0.001; - while Arg < 1.0 and not Incorrect_Inverse loop - if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.001) then - Incorrect_Inverse := True; - end if; - Arg := Arg + 0.001; - end loop; - - if Incorrect_Inverse then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function over argument range 0.001..1.0"); - Incorrect_Inverse := False; - end if; - - Arg := 1.0; - while Arg < 10.0 and not Incorrect_Inverse loop - if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.01) then - Incorrect_Inverse := True; - end if; - Arg := Arg + 0.01; - end loop; - - if Incorrect_Inverse then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function over argument range 1.0..10.0"); - Incorrect_Inverse := False; - end if; - - Arg := 1.0; - while Arg < 1000.0 and not Incorrect_Inverse loop - if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.1) then - Incorrect_Inverse := True; - end if; - Arg := Arg + 1.0; - end loop; - - if Incorrect_Inverse then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function over argument range 1.0..1000.0"); - end if; - - - -- Testing of Log Function, with specified Base parameter, both - -- instantiated and pre-instantiated versions. - - -- Check that Argument_Error is raised by the Log function with - -- specified Base parameter, when the X parameter value is negative. - - begin - New_Float_Result := GEF.Log(X => -1.0, Base => 16.0); - Report.Failed("Argument_Error not raised by the Log function " & - "with Base parameter, when the input parameter " & - "value is -1.0"); - Dont_Optimize_New_Float(New_Float_Result, 4); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "with Base parameter, when the X parameter value " & - "is -1.0"); - end; - - begin - Float_Result := EF.Log(X => -FXA5A00.Large, Base => 8.0); - Report.Failed("Argument_Error not raised by the Log function " & - "with Base parameter, when the X parameter " & - "value is a large negative value"); - Dont_Optimize_Float(Float_Result, 5); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "with Base parameter, when the X parameter " & - "value is a large negative value"); - end; - - - -- Check that Argument_Error is raised by the Log function when - -- the specified Base parameter is zero. - - begin - New_Float_Result := GEF.Log(X => 10.0, Base => 0.0); - Report.Failed("Argument_Error not raised by the Log function " & - "with Base parameter of 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 6); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "with Base parameter of 0.0"); - end; - - - -- Check that Argument_Error is raised by the Log function when - -- the specified Base parameter is one. - - begin - Float_Result := EF.Log(X => 12.3, Base => 1.0); - Report.Failed("Argument_Error not raised by the Log function " & - "with Base parameter of 1.0"); - Dont_Optimize_Float(Float_Result, 7); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "with Base parameter of 1.0"); - end; - - - -- Check that Argument_Error is raised by the Log function when - -- the specified Base parameter is negative. - - begin - New_Float_Result := GEF.Log(X => 12.3, Base => -10.0); - Report.Failed("Argument_Error not raised by the Log function " & - "with negative Base parameter"); - Dont_Optimize_New_Float(New_Float_Result, 8); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the Log function " & - "with negative Base parameter"); - end; - - - -- Check that Constraint_Error is raised by the Log function when the - -- input X parameter value is 0.0. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF.Log(X => 0.0, Base => 16.0); - Report.Failed("Constraint_Error not raised by the Log function " & - "with specified Base parameter, when the value of " & - "the parameter X is 0.0"); - Dont_Optimize_New_Float(New_Float_Result, 9); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Log" & - "with specified Base parameter, when the value " & - "of the parameter X is 0.0"); - end; - end if; - - -- Check for the prescribed results of the Log function with specified - -- Base parameter. - - if GEF.Log(X => 1.0, Base => 16.0) /= 0.0 or - EF.Log(X => 1.0, Base => 10.0) /= 0.0 or - GEF.Log(1.0, Base => 8.0) /= 0.0 or - EF.Log(1.0, 2.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Log with specified " & - "Base parameter when provided an parameter X input " & - "value of 1.0"); - end if; - - - -- Check that the Log function with specified Base parameter provides - -- correct results when provided a variety of input parameters. - - if not Result_Within_Range(GEF.Log( 10.0, e), 2.30, 0.01) or - not Result_Within_Range( EF.Log( 8.0, 2.0), 3.0, 0.01) or - not Result_Within_Range(GEF.Log(256.0, 2.0), 8.0, 0.01) or - not Result_Within_Range( EF.Log(512.0, 8.0), 3.0, 0.01) or - not Result_Within_Range(GEF.Log(0.5649, e), -0.57, 0.01) or - not Result_Within_Range( EF.Log(1.7714, e), 0.57, 0.01) or - not Result_Within_Range(GEF.Log(0.5718, 10.0), -0.243, 0.001) or - not Result_Within_Range( EF.Log(466.25, 10.0), 2.67, 0.01) - then - Report.Failed("Incorrect results from Function Log with specified " & - "Base parameter, when provided a variety of input " & - "parameter values"); - end if; - - - Arg := 1.0; - while Arg < 1000.0 and - not (Incorrect_Inverse_Base_2 and Incorrect_Inverse_Base_8 and - Incorrect_Inverse_Base_10 and Incorrect_Inverse_Base_16) - loop - if not FXA5A00.Result_Within_Range(EF."**"(2.0,EF.Log(Arg,2.0)), - Arg, - 0.001) - then - Incorrect_Inverse_Base_2 := True; - end if; - if not FXA5A00.Result_Within_Range(EF."**"(8.0,EF.Log(Arg,8.0)), - Arg, - 0.001) - then - Incorrect_Inverse_Base_8 := True; - end if; - if not FXA5A00.Result_Within_Range(EF."**"(10.0,EF.Log(Arg,10.0)), - Arg, - 0.001) - then - Incorrect_Inverse_Base_10 := True; - end if; - if not FXA5A00.Result_Within_Range(EF."**"(16.0,EF.Log(Arg,16.0)), - Arg, - 0.001) - then - Incorrect_Inverse_Base_16 := True; - end if; - Arg := Arg + 1.0; - end loop; - - if Incorrect_Inverse_Base_2 then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function for Base 2"); - end if; - - if Incorrect_Inverse_Base_8 then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function for Base 8"); - end if; - - if Incorrect_Inverse_Base_10 then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function for Base 10"); - end if; - - if Incorrect_Inverse_Base_16 then - Report.Failed("Incorrect inverse result comparing ""**"" and " & - "Log function for Base 16"); - end if; - - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -end CXA5A09; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a b/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a deleted file mode 100644 index 4804d6729fc..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a +++ /dev/null @@ -1,551 +0,0 @@ --- CXA5A10.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 functions Exp and Sqrt, and the exponentiation --- operator "**" provide correct results. --- --- TEST DESCRIPTION: --- This test examines both the versions of Exp, Sqrt, and "**" --- resulting from the instantiation of the --- Ada.Numerics.Generic_Elementary_Functions with a type derived from --- type Float, as well as the preinstantiated version of this package --- for type Float. --- Prescribed results (stated as such in the reference manual), --- including instances prescribed to raise exceptions, are examined --- in the test cases. In addition, certain evaluations are performed --- for the preinstantiated package where the actual function result is --- compared with the expected result (within an epsilon range of --- accuracy). --- --- TEST FILES: --- The following files comprise this test: --- --- FXA5A00.A (foundation code) --- CXA5A10.A --- --- --- CHANGE HISTORY: --- 17 Apr 95 SAIC Initial prerelease version. --- 13 Jun 95 SAIC Incorporated use of Dont_Optimize procedure, and --- use of Result_Within_Range function overloaded for --- FXA5A00.New_Float_Type. --- 18 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 01 Oct 01 RLB Protected Constraint_Error exception tests by --- first testing for 'Machine_Overflows. --- ---! - -with Ada.Exceptions; -with Ada.Numerics.Elementary_Functions; -with Ada.Numerics.Generic_Elementary_Functions; -with FXA5A00; -with Report; - -procedure CXA5A10 is -begin - - Report.Test ("CXA5A10", "Check that Exp, Sqrt, and the ""**"" operator " & - "provide correct results"); - - Test_Block: - declare - - use FXA5A00, Ada.Numerics; - use Ada.Exceptions; - - package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float); - package EF renames Ada.Numerics.Elementary_Functions; - - use GEF, EF; - - Arg, - Float_Result : Float; - New_Float_Result : New_Float; - - Flag_1, Flag_2, Flag_3, Flag_4, - Incorrect_Inverse_Base_e, - Incorrect_Inverse_Base_2, - Incorrect_Inverse_Base_8, - Incorrect_Inverse_Base_10, - Incorrect_Inverse_Base_16 : Boolean := False; - - procedure Dont_Optimize_Float is new Dont_Optimize(Float); - procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float); - - begin - - -- Testing of the "**" operator, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the exponentiation operator - -- when the value of the Left parameter (operand) is negative. - - begin - New_Float_Result := GEF."**"(Left => -10.0, - Right => 2.0); - Report.Failed("Argument_Error not raised by the instantiated " & - "version of the exponentiation operator when the " & - "value of the Left parameter is negative"); - Dont_Optimize_New_Float(New_Float_Result, 1); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "instantiated version of the exponentiation " & - "operator when the value of the Left parameter " & - "is negative"); - end; - - begin - Float_Result := (-FXA5A00.Small) ** 4.0; - Report.Failed("Argument_Error not raised by the preinstantiated " & - "version of the exponentiation operator when the " & - "value of the Left parameter is negative"); - Dont_Optimize_Float(Float_Result, 2); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "preinstantiated version of the exponentiation " & - "operator when the value of the Left parameter " & - "is negative"); - end; - - - -- Check that Argument_Error is raised by the exponentiation operator - -- when both parameters (operands) have the value 0.0. - - begin - New_Float_Result := GEF."**"(0.0, Right => 0.0); - Report.Failed("Argument_Error not raised by the instantiated " & - "version of the exponentiation operator when " & - "both operands are zero"); - Dont_Optimize_New_Float(New_Float_Result, 3); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "instantiated version of the exponentiation " & - "operator when both operands are zero"); - end; - - begin - Float_Result := 0.0**0.0; - Report.Failed("Argument_Error not raised by the preinstantiated " & - "version of the exponentiation operator when both " & - "operands are zero"); - Dont_Optimize_Float(Float_Result, 4); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "preinstantiated version of the exponentiation " & - "operator when both operands are zero"); - end; - - - -- Check that Constraint_Error is raised by the exponentiation - -- operator when the value of the left parameter (operand) is zero, - -- and the value of the right parameter (exponent) is negative. - -- This check applies only if Machine_Overflows is true [A.5.1(28, 30)]. - - if New_Float'Machine_Overflows = True then - begin - New_Float_Result := GEF."**"(0.0, Right => -2.0); - Report.Failed("Constraint_Error not raised by the instantiated " & - "version of the exponentiation operator when " & - "the left parameter is 0.0, and the right " & - "parameter is negative"); - Dont_Optimize_New_Float(New_Float_Result, 5); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "instantiated version of the exponentiation " & - "operator when the left parameter is 0.0, " & - "and the right parameter is negative"); - end; - end if; - - if Float'Machine_Overflows = True then - begin - Float_Result := 0.0 ** (-FXA5A00.Small); - Report.Failed("Constraint_Error not raised by the " & - "preinstantiated version of the exponentiation " & - "operator when the left parameter is 0.0, and the " & - "right parameter is negative"); - Dont_Optimize_Float(Float_Result, 6); - exception - when Constraint_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by the " & - "preinstantiated version of the exponentiation " & - "operator when the left parameter is 0.0, and " & - "the right parameter is negative"); - end; - end if; - - -- Prescribed results. - -- Check that exponentiation by a 0.0 exponent yields the value one. - - if GEF."**"(Left => 10.0, Right => 0.0) /= 1.0 or - EF."**"(FXA5A00.Large, Right => 0.0) /= 1.0 or - GEF."**"(3.0, 0.0) /= 1.0 or - FXA5A00.Small ** 0.0 /= 1.0 - then - Report.Failed("Incorrect results returned from the ""**"" " & - "operator when the value of the exponent is 0.0"); - end if; - - - -- Check that exponentiation by a unit exponent yields the value - -- of the left operand. - - if GEF."**"(Left => 50.0, Right => 1.0) /= 50.0 or - EF."**"(FXA5A00.Large, Right => 1.0) /= FXA5A00.Large or - GEF."**"(6.0, 1.0) /= 6.0 or - FXA5A00.Small ** 1.0 /= FXA5A00.Small - then - Report.Failed("Incorrect results returned from the ""**"" " & - "operator when the value of the exponent is 1.0"); - end if; - - - -- Check that exponentiation of the value 1.0 yields the value 1.0. - - if GEF."**"(Left => 1.0, Right => 16.0) /= 1.0 or - EF."**"(1.0, Right => FXA5A00.Large) /= 1.0 or - GEF."**"(1.0, 3.0) /= 1.0 or - 1.0 ** FXA5A00.Small /= 1.0 - then - Report.Failed("Incorrect results returned from the ""**"" " & - "operator when the value of the operand is 1.0"); - end if; - - - -- Check that exponentiation of the value 0.0 yields the value 0.0. - - if GEF."**"(Left => 0.0, Right => 10.0) /= 0.0 or - EF."**"(0.0, Right => FXA5A00.Large) /= 0.0 or - GEF."**"(0.0, 4.0) /= 0.0 or - 0.0 ** FXA5A00.Small /= 0.0 - then - Report.Failed("Incorrect results returned from the ""**"" " & - "operator when the value of the operand is 0.0"); - end if; - - - -- Check that exponentiation of various operands with a variety of - -- of exponent values yield correct results. - - if not Result_Within_Range(GEF."**"(5.0, 2.0), 25.0, 0.01) or - not Result_Within_Range(GEF."**"(1.225, 1.5), 1.36, 0.01) or - not Result_Within_Range(GEF."**"(0.26, 2.0), 0.068, 0.001) or - not Result_Within_Range( EF."**"(e, 5.0), 148.4, 0.1) or - not Result_Within_Range( EF."**"(10.0, e), 522.7, 0.1) or - not Result_Within_Range( EF."**"(e, (-3.0)), 0.050, 0.001) or - not Result_Within_Range(GEF."**"(10.0,(-2.0)), 0.010, 0.001) - then - Report.Failed("Incorrect results returned from the ""**"" " & - "operator with a variety of operand and exponent " & - "values"); - end if; - - - -- Use the following loops to check for internal consistency between - -- inverse functions. - - declare - -- Use the relative error value to account for non-exact - -- computations. - TC_Relative_Error: Float := 0.005; - begin - for i in 1..5 loop - for j in 0..5 loop - if not Incorrect_Inverse_Base_e and - not FXA5A00.Result_Within_Range - (Float(i)**Float(j), - e**(Float(j)*EF.Log(Float(i))), - TC_Relative_Error) - then - Incorrect_Inverse_Base_e := True; - Report.Failed("Incorrect Log-** Inverse calc for Base e " & - "with i= " & Integer'Image(i) & " and j= " & - Integer'Image(j)); - end if; - if not Incorrect_Inverse_Base_2 and - not FXA5A00.Result_Within_Range - (Float(i)**Float(j), - 2.0**(Float(j)*EF.Log(Float(i),2.0)), - TC_Relative_Error) - then - Incorrect_Inverse_Base_2 := True; - Report.Failed("Incorrect Log-** Inverse calc for Base 2 " & - "with i= " & Integer'Image(i) & " and j= " & - Integer'Image(j)); - end if; - if not Incorrect_Inverse_Base_8 and - not FXA5A00.Result_Within_Range - (Float(i)**Float(j), - 8.0**(Float(j)*EF.Log(Float(i),8.0)), - TC_Relative_Error) - then - Incorrect_Inverse_Base_8 := True; - Report.Failed("Incorrect Log-** Inverse calc for Base 8 " & - "with i= " & Integer'Image(i) & " and j= " & - Integer'Image(j)); - end if; - if not Incorrect_Inverse_Base_10 and - not FXA5A00.Result_Within_Range - (Float(i)**Float(j), - 10.0**(Float(j)*EF.Log(Float(i),10.0)), - TC_Relative_Error) - then - Incorrect_Inverse_Base_10 := True; - Report.Failed("Incorrect Log-** Inverse calc for Base 10 " & - "with i= " & Integer'Image(i) & " and j= " & - Integer'Image(j)); - end if; - if not Incorrect_Inverse_Base_16 and - not FXA5A00.Result_Within_Range - (Float(i)**Float(j), - 16.0**(Float(j)*EF.Log(Float(i),16.0)), - TC_Relative_Error) - then - Incorrect_Inverse_Base_16 := True; - Report.Failed("Incorrect Log-** Inverse calc for Base 16 " & - "with i= " & Integer'Image(i) & " and j= " & - Integer'Image(j)); - end if; - end loop; - end loop; - end; - - -- Reset Flags. - Incorrect_Inverse_Base_e := False; - Incorrect_Inverse_Base_2 := False; - Incorrect_Inverse_Base_8 := False; - Incorrect_Inverse_Base_10 := False; - Incorrect_Inverse_Base_16 := False; - - - -- Testing of Exp Function, both instantiated and pre-instantiated - -- version. - - -- Check that the result of the Exp Function, when provided an X - -- parameter value of 0.0, is 1.0. - - if GEF.Exp(X => 0.0) /= 1.0 or - EF.Exp(0.0) /= 1.0 - then - Report.Failed("Incorrect result returned by Function Exp when " & - "given a parameter value of 0.0"); - end if; - - - -- Check that the Exp Function provides correct results when provided - -- a variety of input parameter values. - - if not Result_Within_Range(GEF.Exp(0.001), 1.01, 0.01) or - not Result_Within_Range( EF.Exp(0.1), 1.11, 0.01) or - not Result_Within_Range(GEF.Exp(1.2697), 3.56, 0.01) or - not Result_Within_Range( EF.Exp(3.2525), 25.9, 0.1) or - not Result_Within_Range(GEF.Exp(-0.2198), 0.803, 0.001) or - not Result_Within_Range( EF.Exp(-1.6621), 0.190, 0.001) or - not Result_Within_Range(GEF.Exp(-2.3888), 0.092, 0.001) or - not Result_Within_Range( EF.Exp(-5.4415), 0.004, 0.001) - then - Report.Failed("Incorrect result from Function Exp when provided " & - "a variety of input parameter values"); - end if; - - -- Use the following loops to check for internal consistency between - -- inverse functions. - - Arg := 0.01; - while Arg < 10.0 loop - if not Incorrect_Inverse_Base_e and - FXA5A00.Result_Within_Range(EF.Exp(Arg), - e**(Arg*EF.Log(Arg)), - 0.001) - then - Incorrect_Inverse_Base_e := True; - Report.Failed("Incorrect Exp-** Inverse calc for Base e"); - end if; - if not Incorrect_Inverse_Base_2 and - FXA5A00.Result_Within_Range(EF.Exp(Arg), - 2.0**(Arg*EF.Log(Arg,2.0)), - 0.001) - then - Incorrect_Inverse_Base_2 := True; - Report.Failed("Incorrect Exp-** Inverse calc for Base 2"); - end if; - if not Incorrect_Inverse_Base_8 and - FXA5A00.Result_Within_Range(EF.Exp(Arg), - 8.0**(Arg*EF.Log(Arg,8.0)), - 0.001) - then - Incorrect_Inverse_Base_8 := True; - Report.Failed("Incorrect Exp-** Inverse calc for Base 8"); - end if; - if not Incorrect_Inverse_Base_10 and - FXA5A00.Result_Within_Range(EF.Exp(Arg), - 10.0**(Arg*EF.Log(Arg,10.0)), - 0.001) - then - Incorrect_Inverse_Base_10 := True; - Report.Failed("Incorrect Exp-** Inverse calc for Base 10"); - end if; - if not Incorrect_Inverse_Base_16 and - FXA5A00.Result_Within_Range(EF.Exp(Arg), - 16.0**(Arg*EF.Log(Arg,16.0)), - 0.001) - then - Incorrect_Inverse_Base_16 := True; - Report.Failed("Incorrect Exp-** Inverse calc for Base 16"); - end if; - Arg := Arg + 0.01; - end loop; - - - -- Testing of Sqrt Function, both instantiated and pre-instantiated - -- version. - - -- Check that Argument_Error is raised by the Sqrt Function when - -- the value of the input parameter X is negative. - - begin - Float_Result := EF.Sqrt(X => -FXA5A00.Small); - Report.Failed("Argument_Error not raised by Function Sqrt " & - "when provided a small negative input parameter " & - "value"); - Dont_Optimize_Float(Float_Result, 7); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Sqrt " & - "when provided a small negative input parameter " & - "value"); - end; - - begin - New_Float_Result := GEF.Sqrt(X => -64.0); - Report.Failed("Argument_Error not raised by Function Sqrt " & - "when provided a large negative input parameter " & - "value"); - Dont_Optimize_New_Float(New_Float_Result, 8); - exception - when Argument_Error => null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised by Function Sqrt " & - "when provided a large negative input parameter " & - "value"); - end; - - - -- Check that the Sqrt Function, when given an X parameter value of 0.0, - -- returns a result of 0.0. - - if GEF.Sqrt(X => 0.0) /= 0.0 or - EF.Sqrt(0.0) /= 0.0 - then - Report.Failed("Incorrect result from Function Sqrt when provided " & - "an input parameter value of 0.0"); - end if; - - - -- Check that the Sqrt Function, when given an X parameter input value - -- of 1.0, returns a result of 1.0. - - if GEF.Sqrt(X => 1.0) /= 1.0 or - EF.Sqrt(1.0) /= 1.0 - then - Report.Failed("Incorrect result from Function Sqrt when provided " & - "an input parameter value of 1.0"); - end if; - - - -- Check that the Sqrt Function provides correct results when provided - -- a variety of input parameter values. - - if not FXA5A00.Result_Within_Range(GEF.Sqrt(0.0327), 0.181, 0.001) or - not FXA5A00.Result_Within_Range( EF.Sqrt(0.1808), 0.425, 0.001) or - not FXA5A00.Result_Within_Range(GEF.Sqrt(1.0556), 1.03, 0.01) or - not FXA5A00.Result_Within_Range( EF.Sqrt(32.8208), 5.73, 0.01) or - not FXA5A00.Result_Within_Range( EF.Sqrt(27851.0), 166.9, 0.1) or - not FXA5A00.Result_Within_Range( EF.Sqrt(61203.4), 247.4, 0.1) or - not FXA5A00.Result_Within_Range( EF.Sqrt(655891.0), 809.9, 0.1) - then - Report.Failed("Incorrect result from Function Sqrt when provided " & - "a variety of input parameter values"); - end if; - - -- Check internal consistency between functions. - - Arg := 0.01; - while Arg < 10.0 loop - if not Flag_1 and - not FXA5A00.Result_Within_Range(Arg, - EF.Sqrt(Arg)*EF.Sqrt(Arg), - 0.01) - then - Report.Failed("Inconsistency found in Case 1"); - Flag_1 := True; - end if; - if not Flag_2 and - not FXA5A00.Result_Within_Range(Arg, EF.Sqrt(Arg)**2.0, 0.01) - then - Report.Failed("Inconsistency found in Case 2"); - Flag_2 := True; - end if; - if not Flag_3 and - not FXA5A00.Result_Within_Range(EF.Log(Arg), - EF.Log(Sqrt(Arg)**2.0), 0.01) - then - Report.Failed("Inconsistency found in Case 3"); - Flag_3 := True; - end if; - if not Flag_4 and - not FXA5A00.Result_Within_Range(EF.Log(Arg), - 2.00*EF.Log(EF.Sqrt(Arg)), - 0.01) - then - Report.Failed("Inconsistency found in Case 4"); - Flag_4 := True; - end if; - Arg := Arg + 1.0; - end loop; - - - 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 CXA5A10; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a b/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a deleted file mode 100644 index 16f30752db1..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a +++ /dev/null @@ -1,243 +0,0 @@ --- CXA8001.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 all elements to be transferred to a sequential file of --- mode Append_File will be placed following the last element currently --- in the file. --- Check that it is possible to append data to a file that has been --- previously appended to. --- Check that the predefined procedure Write will place an element after --- the last element in the file in mode Append_File. --- --- TEST DESCRIPTION: --- This test implements a sequential file system that has the capability --- to store data records at the end of a file. Initially, the file is --- opened with mode Out_File, and data is written to the file. The file --- is closed, then reopened with mode Append_File. An additional record --- is written, and again the file is closed. The file is then reopened, --- again with mode Append_File, and another record is written to the --- file. --- The file is closed again, the reopened with mode In_File, and the data --- in the file is read and checked for proper ordering within the file. --- --- An expected common usage of Append_File mode would be in the opening --- of a file that currently contains data. Likewise, the reopening of --- files in Append_Mode that have been previously appended to for the --- addition of more data would be frequently encountered. This test --- attempts to simulate both situations. (Of course, in an actual user --- environment, the open/write/close processing would be performed using --- looping structures, rather than the straight-line processing displayed --- here.) --- --- APPLICABILITY CRITERIA: --- Applicable to all systems capable of supporting IO operations on --- external Sequential_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Sequential_IO; -with Report; - -procedure CXA8001 is - - -- Declare data types and objects to be stored in the file. - subtype Name_Type is String (1 .. 10); - type Tickets is range 0 .. 1000; - - type Order_Type is record - Name : Name_Type; - No_of_Tickets : Tickets; - end record; - - package Order_IO is new Sequential_IO (Order_Type); -- Declare Seq_IO - -- package, - Order_File : Order_IO.File_Type; -- and file object. - Order_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXA8001" ); - Incomplete : exception; - -begin - - Report.Test ("CXA8001", "Check that all elements to be transferred to a " & - "sequential file of mode Append_File will be " & - "placed following the last element currently " & - "in the file"); - - Test_for_Sequential_IO_Support: - begin - - -- An implementation that does not support Sequential_IO in a particular - -- environment will raise Use_Error or Name_Error on calls to various - -- Sequential_IO operations. This block statement encloses a call to - -- Create, which should produce an exception in a non-supportive - -- environment. These exceptions will be handled to produce a - -- Not_Applicable result. - - Order_IO.Create (File => Order_File, -- Create Sequential_IO file - Mode => Order_IO.Out_File, -- with mode Out_File. - Name => Order_Filename); - - exception - - when Order_IO.Use_Error | Order_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Sequential_IO" ); - raise Incomplete; - - end Test_for_Sequential_IO_Support; - - Operational_Test_Block: - declare - -- Assign values into the component fields of the data objects. - Buyer_1 : constant Order_Type := ("John Smith", 3); - Buyer_2 : constant Order_Type := - (Name => "Jane Jones", No_of_Tickets => 2); - Buyer_3 : Order_Type := ("Mike Brown", 5); - - begin - Order_IO.Write (File => Order_File, -- Write initial data item - Item => Buyer_1); -- to file. - - Order_IO.Close (File => Order_File); -- Close file. - - -- - -- Enter additional data records into the file. (Append to a file of - -- previous mode Out_File). - -- - Order_IO.Open (Order_File, -- Open Sequential_IO file - Order_IO.Append_File, -- with mode Append_File. - Order_Filename); - - Order_IO.Write (Order_File, Buyer_2); -- Write second data item - -- to file. - Order_IO.Close (File => Order_File); -- Close file. - - -- Check to determine whether file is actually closed. - begin - Order_IO.Write (Order_File, Buyer_2); - Report.Failed("Exception not raised on Write to Closed file"); - exception - when Order_IO.Status_Error => null; -- Expected exception. - when others => - Report.Failed("Incorrect exception on Write to Closed file"); - end; - - -- - -- The following code segment demonstrates appending data to a file - -- that has been previously appended to. - -- - - Order_IO.Open (Order_File, -- Open Sequential_IO file - Order_IO.Append_File, -- with mode Append_File. - Order_Filename ); - - Order_IO.Write (Order_File, Buyer_3); -- Write third data item - -- to file. - Order_IO.Close (File => Order_File); -- Close file. - - - Test_Verification_Block: - declare - TC_Order1, TC_Order2, TC_Order3 : Order_Type; - begin - - Order_IO.Open (Order_File, -- Open Sequential_IO file - Order_IO.In_File, -- with mode In_File. - Order_Filename ); - - Order_IO.Read (File => Order_File, -- Read records from file. - Item => TC_Order1); - Order_IO.Read (Order_File, TC_Order2); - Order_IO.Read (Order_File, TC_Order3); - - -- Compare the contents of each with the individual data items. - -- If items read from file do not match the items placed into - -- the file, in the appropriate order, then fail. - - if ((TC_Order1 /= Buyer_1) or - (TC_Order2.Name /= Buyer_2.Name) or - (TC_Order2.No_of_Tickets /= Buyer_2.No_of_Tickets) or - not ((TC_Order3.Name = "Mike Brown") and - (TC_Order3.No_of_Tickets = 5))) then - Report.Failed ("Incorrect appending of record data in file"); - end if; - - -- Check to determine that no more than three data records were - -- actually written to the file. - if not Order_IO.End_Of_File (Order_File) then - Report.Failed("File not empty after three reads"); - end if; - - exception - - when Order_IO.End_Error => -- If three items not in - -- file (data overwritten), - -- then fail. - Report.Failed ("Incorrect number of record elements in file"); - - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when others => - Report.Failed("Exception raised during Sequential_IO processing"); - - end Operational_Test_Block; - - Deletion: - begin - -- Check that file is open prior to deleting it. - if Order_IO.Is_Open(Order_File) then - Order_IO.Delete (Order_File); - else - Order_IO.Open(Order_File, Order_IO.In_File, Order_Filename); - Order_IO.Delete (Order_File); - end if; - - exception - when others => - Report.Failed - ( "Delete not properly implemented for Sequential_IO" ); - - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXA8001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a b/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a deleted file mode 100644 index 8670e98bac9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a +++ /dev/null @@ -1,285 +0,0 @@ --- CXA8002.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 resetting a file using mode Append_File allows for the --- writing of elements to the file starting after the last element in --- the file. --- Check that the result of function Name can be used on a subsequent --- reopen of the file. --- Check that a mode change occurs on reset of a file to/from mode --- Append_File. --- --- TEST DESCRIPTION: --- This test simulates the read/write of data from/to an individual --- sequential file. New data can be appended to the end of the existing --- file, and the same file can be reset to allow reading of data from --- the file. This process can occur multiple times. --- When the mode of the file is changed with a Reset, the current mode --- value assigned to the file is checked using the result of function --- Mode. This, in conjunction with the read/write operations, verifies --- that a mode change has taken place on Reset. --- --- An expected common usage of the scenarios found in this test would --- be a case where a single data file is kept open continuously, being --- reset for read/append of data. For systems that do not support a --- direct form of I/O, this would allow for efficient use of a sequential --- I/O file. --- --- APPLICABILITY CRITERIA: --- Applicable to all systems capable of supporting IO operations on --- external Sequential_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 19 Feb 97 PWB.CTA Fixed handling for file non-support and Reset --- non-support. ---! - -with Sequential_IO; -with Report; - -procedure CXA8002 is - subtype Employee_Data is String (1 .. 11); - package Data_IO is new Sequential_IO (Employee_Data); - - Employee_Data_File : Data_IO.File_Type; - Employee_Filename : constant String := - Report.Legal_File_Name (Nam => "CXA8002"); - - Incomplete : exception; - -begin - - Report.Test ("CXA8002", "Check that resetting a file using mode " & - "Append_File allows for the writing of " & - "elements to the file starting after the " & - "last element in the file"); - - Test_for_Sequential_IO_Support: - begin - - -- An implementation that does not support Sequential_IO in a particular - -- environment will raise Use_Error or Name_Error on calls to various - -- Sequential_IO operations. This block statement encloses a call to - -- Create, which should produce an exception in a non-supportive - -- environment. These exceptions will be handled to produce a - -- Not_Applicable result. - - Data_IO.Create (File => Employee_Data_File, -- Create file in - Mode => Data_IO.Append_File, -- mode Append_File. - Name => Employee_Filename); - - -- - -- The following portion of code demonstrates the fact that a sequential - -- file can be created in Append_File mode, and that data can be written - -- to the file. - -- - - exception - when Data_IO.Use_Error | Data_IO.Name_Error => - Report.Not_Applicable - ( "Sequential files not supported - Create as Append_File"); - raise Incomplete; - end Test_for_Sequential_IO_Support; - Operational_Test_Block: - declare - Blank_Data : constant Employee_Data := " "; - Employee_1 : constant Employee_Data := "123-45-6789"; - Employee_2 : Employee_Data := "987-65-4321"; - - -- Note: Artificial numerical data chosen above to prevent any - -- unintended similarity with persons alive or dead. - - TC_Employee_Data : Employee_Data := Blank_Data; - - - function TC_Mode_Selection (Selector : Integer) - return Data_IO.File_Mode is - begin - case Report.Ident_Int(Selector) is - when 1 => return Data_IO.In_File; - when 2 => return Data_IO.Out_File; - when others => return Data_IO.Append_File; - end case; - end TC_Mode_Selection; - - Employee_Filename : constant String := -- Use function Name to - Data_IO.Name (File => Employee_Data_File); -- store filename in - -- string variable. - begin - - Data_IO.Write (File => Employee_Data_File, -- Write initial data - Item => Employee_1); -- entry to file. - - -- - -- The following portion of code demonstrates that a sequential file - -- can be reset to various file modes, including Append_File mode, - -- allowing data to be added to the end of the file. - -- - begin - Data_IO.Reset (File => Employee_Data_File, -- Reset file with - Mode => Data_IO.In_File); -- mode In_File. - exception - when Data_IO.Use_Error => - Report.Not_Applicable - ("Reset to In_File not supported for Sequential_IO"); - raise Incomplete; - when others => - Report.Failed - ("Unexpected exception on Reset to In_File (Sequential_IO)"); - raise Incomplete; - end; - if Data_IO."="(Data_IO.Mode (Employee_Data_File), - TC_Mode_Selection (1)) then -- Compare In_File mode - -- Reset successful, - Data_IO.Read (File => Employee_Data_File, -- now verify file data. - Item => TC_Employee_Data); - - if ((TC_Employee_Data (1 .. 7) /= "123-45-") or - (TC_Employee_Data (5 .. 11) /= "45-6789")) then - Report.Failed ("Data read error"); - end if; - - else - Report.Failed ("File mode not changed by Reset"); - end if; - - -- - -- Simulate appending data to a file that has previously been written - -- to and read from. - -- - begin - Data_IO.Reset (File => Employee_Data_File, -- Reset file with - Mode => Data_IO.Append_File); -- mode Append_File. - exception - when Data_IO.Use_Error => - Report.Not_Applicable - ("Reset to Append_File not supported for Sequential_IO"); - raise Incomplete; - when others => - Report.Failed - ("Unexpected exception on Reset to Append_File (Sequential_IO)"); - raise Incomplete; - end; - - if Data_IO.Is_Open (Employee_Data_File) then -- File remains open - -- following Reset to - -- Append_File mode? - - if Data_IO."=" (Data_IO.Mode (Employee_Data_File), - TC_Mode_Selection (3)) then -- Compare to - -- Append_File mode. - Data_IO.Write (File => Employee_Data_File, -- Write additional - Item => Employee_2); -- data to file. - else - Report.Failed ("File mode not changed by Reset"); - end if; - - else - Report.Failed - ("File status not Open following Reset to Append mode"); - end if; - - Data_IO.Close (Employee_Data_File); - - - Test_Verification_Block: - begin - - Data_IO.Open (File => Employee_Data_File, -- Reopen file, using - Mode => Data_IO.In_File, -- previous result of - Name => Employee_Filename); -- function Name. - - TC_Employee_Data := Blank_Data; -- Clear record field. - Data_IO.Read (Employee_Data_File, -- Read first record, - TC_Employee_Data); -- check ordering of - -- records. - - if not ((TC_Employee_Data (1 .. 3) = "123") and then - (TC_Employee_Data (4 .. 11) = "-45-6789")) then - Report.Failed ("Data read error - first record"); - end if; - - TC_Employee_Data := Blank_Data; -- Clear record field. - Data_IO.Read (Employee_Data_File, -- Read second record, - TC_Employee_Data); -- check for ordering of - -- records. - - if ((TC_Employee_Data (1 .. 6) /= "987-65") or else - not (TC_Employee_Data (3 .. 11) = "7-65-4321")) then - Report.Failed ("Data read error - second record"); - end if; - - -- Check that only two items were written to the file. - if not Data_IO.End_Of_File(Employee_Data_File) then - Report.Failed("Incorrect number of records in file"); - end if; - - exception - - when Data_IO.End_Error => -- If two items not in - -- file (data overwritten), - -- then fail. - Report.Failed ("Incorrect number of record elements in file"); - - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when others => - Report.Failed("Exception raised during Sequential_IO processing"); - - end Operational_Test_Block; - - Final_Block: - begin - -- Check that file is open prior to deleting it. - if Data_IO.Is_Open(Employee_Data_File) then - Data_IO.Delete (Employee_Data_File); - else - Data_IO.Open(Employee_Data_File, - Data_IO.In_File, - Employee_Filename); - Data_IO.Delete (Employee_Data_File); - end if; - exception - when others => - Report.Failed ("Sequential_IO Delete not properly supported"); - end Final_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ("Unexpected exception"); - Report.Result; -end CXA8002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a b/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a deleted file mode 100644 index cf9b5e07598..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a +++ /dev/null @@ -1,214 +0,0 @@ --- CXA8003.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 Append_File mode has not been added to package Direct_IO. --- --- TEST DESCRIPTION: --- This test uses a procedure to change the mode of an existing Direct_IO --- file. The file descriptor is passed as a parameter, along with a --- numeric indicator for the new mode. Based on the numeric parameter, --- a Direct_IO.Reset is performed using a File_Mode'Value transformation --- of a string constant into a File_Mode value. An attempt to reset a --- Direct_IO file to mode Append_File should cause an Constraint_Error --- to be raised, as Append_File mode has not been added to Direct_IO in --- Ada 9X. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations supporting Direct_IO --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 19 Feb 97 PWB.CTA Allowed for non-support of Reset for certain --- modes. ---! - -with Direct_IO; -with Report; - -procedure CXA8003 is - Incomplete : exception; - begin - - Report.Test ("CXA8003", "Check that Append_File mode has not " & - "been added to package Direct_IO"); - - Test_for_Direct_IO_Support: - declare - - subtype String_Data_Type is String (1 .. 20); - type Numeric_Data_Type is range 1 .. 512; - type Composite_Data_Type is array (1 .. 3) of String_Data_Type; - - type File_Data_Type is record - Data_Field_1 : String_Data_Type; - Data_Field_2 : Numeric_Data_Type; - Data_Field_3 : Composite_Data_Type; - end record; - - package Dir_IO is new Direct_IO (File_Data_Type); - - Data_File : Dir_IO.File_Type; - Dir_Filename : constant String := Report.Legal_File_Name; - - begin - - -- An application creates a text file with mode Out_File. - -- Use_Error will be raised if Direct_IO operations or external - -- files are not supported. - - Dir_IO.Create (Data_File, - Dir_IO.Out_File, - Dir_Filename); - - Change_File_Mode: - declare - - TC_Append_Test_Executed : Boolean := False; - - type Mode_Selection_Type is ( A, I, IO, O ); - - - procedure Change_Mode (File : in out Dir_IO.File_Type; - To : in Mode_Selection_Type) is - begin - case To is - when A => - TC_Append_Test_Executed := True; - Dir_IO.Reset - (File, Dir_IO.File_Mode'Value("Append_File")); - when I => - begin - Dir_IO.Reset - (File, Dir_IO.File_Mode'Value("In_File")); - exception - when Dir_IO.Use_Error => - Report.Not_Applicable - ("Reset to In_File not supported: Direct_IO"); - raise Incomplete; - end; - when IO => - begin - Dir_IO.Reset - (File, Dir_IO.File_Mode'Value("Inout_File")); - exception - when Dir_IO.Use_Error => - Report.Not_Applicable - ("Reset to InOut_File not supported: Direct_IO"); - raise Incomplete; - end; - when O => - begin - Dir_IO.Reset - (File, Dir_IO.File_Mode'Value("Out_File")); - exception - when Dir_IO.Use_Error => - Report.Not_Applicable - ("Reset to Out_File not supported: Direct_IO"); - raise Incomplete; - end; - end case; - end Change_Mode; - - - begin - - -- At some point in the processing, the application may call a - -- procedure to change the mode of the file (perhaps for - -- additional data entry, data verification, etc.). It is at - -- this point that a use of Append_File mode for a Direct_IO - -- file would cause an exception. - - for I in reverse Mode_Selection_Type loop - Change_Mode (Data_File, I); - Report.Comment - ("Mode changed to " & - Dir_IO.File_Mode'Image (Dir_IO.Mode (Data_File))); - end loop; - - Report.Failed("No error raised on change to Append_File mode"); - - exception - - -- A handler has been provided in the application, which - -- handles the constraint error, allowing processing to - -- continue. - - when Constraint_Error => - - if TC_Append_Test_Executed then - Report.Comment ("Constraint_Error correctly raised on " & - "attempted Append_File mode selection " & - "for a Direct_IO file"); - else - Report.Failed ("Append test was not executed"); - end if; - - when Incomplete => raise; - - when others => Report.Failed ("Unexpected exception raised"); - - end Change_File_Mode; - - Final_Block: - begin - if Dir_IO.Is_Open (Data_File) then - Dir_IO.Delete (Data_File); - else - Dir_IO.Open (Data_File, Dir_IO.In_File, Dir_Filename); - Dir_IO.Delete (Data_File); - end if; - exception - when others => - Report.Failed ("Delete not properly supported: Direct_IO"); - end Final_Block; - - exception - - -- Since Use_Error or Name_Error can be raised if, for the - -- specified mode, the environment does not support Direct_IO - -- operations, the following handlers are included: - - when Dir_IO.Name_Error => - Report.Not_Applicable("Name_Error raised on Direct IO Create"); - - when Dir_IO.Use_Error => - Report.Not_Applicable("Use_Error raised on Direct IO Create"); - - when others => - Report.Failed - ("Unexpected exception raised on Direct IO Create"); - - end Test_for_Direct_IO_Support; - - Report.Result; - -exception - when Incomplete => - Report.Result; - -end CXA8003; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a b/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a deleted file mode 100644 index 4fe9c357614..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a +++ /dev/null @@ -1,287 +0,0 @@ --- CXA9001.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 operations defined in the generic package --- Ada.Storage_IO provide the ability to store and retrieve objects --- which may include implicit levels of indirection in their --- implementation, from an in-memory buffer. --- --- TEST DESCRIPTION: --- The following scenario demonstrates how an object of a type with --- (potential) levels of indirection (based on the implementation) --- can be "flattened" and written/read to/from a Direct_IO file. --- In this small example, we have attempted to simulate the situation --- where two independent programs are using a particular Direct_IO file, --- one writing data to the file, and the second program reading that file. --- The Storage_IO Read and Write procedures are used to "flatten" --- and reconstruct objects of the record type. --- --- APPLICABILITY CRITERIA: --- Applicable to implementations capable of supporting external --- Direct_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 07 Jun 95 SAIC Modified to constrain type used with Storage_IO. --- 20 Nov 95 SAIC Corrected and enhanced for ACVC 2.0.1. --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Report; -with Ada.Storage_IO; -with Ada.Direct_IO; - -procedure CXA9001 is - package Dir_IO is new Ada.Direct_IO (Integer); - Test_File : Dir_IO.File_Type; - Incomplete : exception; -begin - - Report.Test ("CXA9001", "Check that the operations defined in the " & - "generic package Ada.Storage_IO provide the " & - "ability to store and retrieve objects which " & - "may include implicit levels of indirection in " & - "their implementation, from an in-memory buffer"); - - - Test_For_Direct_IO_Support: - begin - - -- The following Create does not have any bearing on the test scenario, - -- but is included to check that the implementation supports Direct_IO - -- files. An exception on this Create statement will raise a Name_Error - -- or Use_Error, which will be handled to produce a Not_Applicable - -- result. If created, the file is immediately deleted, as it is not - -- needed for the program scenario. - - Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1)); - - exception - - when Dir_IO.Use_Error | Dir_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Direct_IO" ); - raise Incomplete; - - end Test_for_Direct_IO_Support; - - Deletion1: - begin - Dir_IO.Delete (Test_File); - exception - when others => - Report.Failed - ( "Delete not properly implemented for Direct_IO - 1" ); - end Deletion1; - - - Test_Block: - declare - - The_Filename : constant String := Report.Legal_File_Name(2); - - -- The following type is the basic unit used in this test. It is - -- incorporated into the definition of the Unit_Array_Type. - - type Unit_Type is - record - Position : Natural := 19; - String_Value : String (1..9) := (others => 'X'); - end record; - - TC_Size : Natural := Natural'First; - - procedure Data_Storage (Number_Of_Units : in Natural; - Result : out Natural) is - - -- Type based on input parameter. Uses type Unit_Type - -- as the array element. - type Unit_Array_Type is array (1..Number_Of_Units) - of Unit_Type; - - -- This type definition is the ultimate storage type used - -- in this test; uses type Unit_Array_Type as a record - -- component field. - -- This record type contains a component that is an array of - -- records, with each of these records containing a Natural - -- and a String value (i.e., a record containing an array of - -- records). - - type Data_Storage_Type is - record - Data_Value : Natural := Number_Of_Units; - Unit_Array : Unit_Array_Type; - end record; - - -- The instantiation of the following generic package is a - -- central point in this test. Storage_IO is instantiated for - -- a specific data type, and will be used to "flatten" objects - -- of that type into buffers. Direct_IO is instantiated for - -- these Storage_IO buffers. - - package Flat_Storage_IO is - new Ada.Storage_IO (Data_Storage_Type); - package Buffer_IO is - new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type); - - Buffer_File : Buffer_IO.File_Type; - Outbound_Buffer : Flat_Storage_IO.Buffer_Type; - Storage_Item : Data_Storage_Type; - - begin -- procedure Data_Storage - - Buffer_IO.Create (Buffer_File, - Buffer_IO.Out_File, - The_Filename); - - Flat_Storage_IO.Write (Buffer => Outbound_Buffer, - Item => Storage_Item); - - -- At this point, any levels of indirection have been removed - -- by the Storage_IO procedure, and the buffered data can be - -- written to a file. - - Buffer_IO.Write (Buffer_File, Outbound_Buffer); - Buffer_IO.Close (Buffer_File); - Result := Storage_Item.Unit_Array'Last + -- 5 + - Storage_Item.Unit_Array -- 9 - (Storage_Item.Unit_Array'First).String_Value'Length; - - exception - when others => - Report.Failed ("Data storage error"); - if Buffer_IO.Is_Open (Buffer_File) then - Buffer_IO.Close (Buffer_File); - end if; - end Data_Storage; - - procedure Data_Retrieval (Number_Of_Units : in Natural; - Result : out Natural) is - type Unit_Array_Type is array (1..Number_Of_Units) - of Unit_Type; - - type Data_Storage_Type is - record - Data_Value : Natural := Number_Of_Units; - Unit_Array : Unit_Array_Type; - end record; - - package Flat_Storage_IO is - new Ada.Storage_IO (Data_Storage_Type); - package Reader_IO is - new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type); - - Reader_File : Reader_IO.File_Type; - Inbound_Buffer : Flat_Storage_IO.Buffer_Type; - Storage_Item : Data_Storage_Type; - TC_Item : Data_Storage_Type; - - begin -- procedure Data_Retrieval - - Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename); - Reader_IO.Read (Reader_File, Inbound_Buffer); - - Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item); - - -- Validate the reconstructed value against an "unflattened" - -- value. - - if Storage_Item.Data_Value /= TC_Item.Data_Value - then - Report.Failed ("Data_Retrieval Error - 1"); - end if; - - for i in 1..Number_Of_Units loop - if Storage_Item.Unit_Array(i).String_Value'Length /= - TC_Item.Unit_Array(i).String_Value'Length or - Storage_Item.Unit_Array(i).Position /= - TC_Item.Unit_Array(i).Position or - Storage_Item.Unit_Array(i).String_Value /= - TC_Item.Unit_Array(i).String_Value - then - Report.Failed ("Data_Retrieval Error - 2"); - end if; - end loop; - - Result := Storage_Item.Unit_Array'Last + -- 5 + - Storage_Item.Unit_Array -- 9 - (Storage_Item.Unit_Array'First).String_Value'Length; - - if Reader_IO.Is_Open (Reader_File) then - Reader_IO.Delete (Reader_File); - else - Reader_IO.Open (Reader_File, - Reader_IO.In_File, - The_Filename); - Reader_IO.Delete (Reader_File); - end if; - - exception - when others => - Report.Failed ("Exception raised in Data_Retrieval"); - if Reader_IO.Is_Open (Reader_File) then - Reader_IO.Delete (Reader_File); - else - Reader_IO.Open (Reader_File, - Reader_IO.In_File, - The_Filename); - Reader_IO.Delete (Reader_File); - end if; - end Data_Retrieval; - - - begin -- Test_Block - - -- The number of Units is provided in this call to Data_Storage. - Data_Storage (Number_Of_Units => Natural(Report.Ident_Int(5)), - Result => TC_Size); - - if TC_Size /= 14 then - Report.Failed ("Data_Storage error in Data_Storage"); - end if; - - Data_Retrieval (Number_Of_Units => Natural(Report.Ident_Int(5)), - Result => TC_Size); - - if TC_Size /= 14 then - Report.Failed ("Data retrieval error in Data_Retrieval"); - end if; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXA9001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a b/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a deleted file mode 100644 index 415a56630ad..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a +++ /dev/null @@ -1,482 +0,0 @@ --- CXA9002.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 operations defined in the generic package --- Ada.Storage_IO provide the ability to store and retrieve objects --- of tagged types from in-memory buffers. --- --- TEST DESCRIPTION: --- The following scenario demonstrates how objects of a tagged type, --- extended types, and twice extended types can be written/read --- to/from Direct_IO files. The Storage_IO subprograms, Read and Write, --- demonstrated in this scenario, perform tag "fixing" prior to/following --- transfer to the Direct_IO files. --- This method is especially important for those implementations that --- represent tags as pointers, or for cases where the tagged objects --- are read in by a program other than the one that wrote them. --- --- In this small example, we have attempted to simulate the situation --- where two independent programs are using a series of Direct_IO files, --- one writing data to the files, and the second program reading the --- data from those files. Two procedures are defined, the first --- simulating the program responsible for writing, the second simulating --- a separate program opening and reading the data from the files. --- --- The hierarchy of types used in this test can be displayed as follows: --- --- Account_Type --- / \ --- / \ --- / \ --- Cash_Account_Type Investment_Account_Type --- / \ --- / \ --- / \ --- Checking_Account_Type Savings_Account_Type --- --- APPLICABILITY CRITERIA: --- Applicable to implementations capable of supporting external --- Direct_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 08 Nov 95 SAIC Corrected incorrect prefix of 'Tag for ACVC 2.0.1, --- and mode of files in Procedure Read_Data. --- Added verification of objects reconstructed from --- files. --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -package CXA9002_0 is - - type Investment_Type is (Stocks, Bonds, Mutual_Funds); - type Savings_Type is (Standard, Business, Impound); - - type Account_Type is tagged - record - Num : String (1..3); - end record; - - type Cash_Account_Type is new Account_Type with - record - Years_As_Customer : Natural := 1; - end record; - - type Investment_Account_Type is new Account_Type with - record - Investment_Vehicle : Investment_Type := Stocks; - end record; - - type Checking_Account_Type is new Cash_Account_Type with - record - Checks_Per_Year : Positive := 200; - Interest_Bearing : Boolean := False; - end record; - - type Savings_Account_Type is new Cash_Account_Type with - record - Kind : Savings_Type := Standard; - end record; - -end CXA9002_0; - ---- - -with Report; -with Ada.Storage_IO; -with Ada.Direct_IO; -with Ada.Tags; -with CXA9002_0; - -procedure CXA9002 is - package Dir_IO is new Ada.Direct_IO (Integer); - Test_File : Dir_IO.File_Type; - Incomplete : exception; -begin - - Report.Test ("CXA9002", "Check that the operations defined in the " & - "generic package Ada.Storage_IO provide the " & - "ability to store and retrieve objects of " & - "tagged types from in-memory buffers"); - - - Test_For_Direct_IO_Support: - begin - - -- The following Create does not have any bearing on the test scenario, - -- but is included to check that the implementation supports Direct_IO - -- files. An exception on this Create statement will raise a Name_Error - -- or Use_Error, which will be handled to produce a Not_Applicable - -- result. If created, the file is immediately deleted, as it is not - -- needed for the program scenario. - - Dir_IO.Create (Test_File, - Dir_IO.Out_File, - Report.Legal_File_Name(1)); - exception - - when Dir_IO.Use_Error | Dir_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Direct_IO" ); - raise Incomplete; - - end Test_for_Direct_IO_Support; - - Deletion: - begin - Dir_IO.Delete (Test_File); - exception - when others => - Report.Failed - ( "Delete not properly implemented for Direct_IO" ); - end Deletion; - - Test_Block: - declare - - use CXA9002_0; - - Acct_Filename : constant String := Report.Legal_File_Name(1); - Cash_Filename : constant String := Report.Legal_File_Name(2); - Inv_Filename : constant String := Report.Legal_File_Name(3); - Chk_Filename : constant String := Report.Legal_File_Name(4); - Sav_Filename : constant String := Report.Legal_File_Name(5); - - type Tag_Pointer_Type is access String; - - TC_Account_Type_Tag, - TC_Cash_Account_Type_Tag, - TC_Investment_Account_Type_Tag, - TC_Checking_Account_Type_Tag, - TC_Savings_Account_Type_Tag : Tag_Pointer_Type; - - TC_Account : Account_Type := - (Num => "123"); - - TC_Cash_Account : Cash_Account_Type := - (Num => "234", - Years_As_Customer => 3); - - TC_Investment_Account : Investment_Account_Type := - (Num => "456", - Investment_Vehicle => Bonds); - - TC_Checking_Account : Checking_Account_Type := - (Num => "567", - Years_As_Customer => 2, - Checks_Per_Year => 300, - Interest_Bearing => True); - - TC_Savings_Account : Savings_Account_Type := - (Num => "789", - Years_As_Customer => 14, - Kind => Business); - - procedure Buffer_Data is - - Account : Account_Type := - TC_Account; - Cash_Account : Cash_Account_Type := - TC_Cash_Account; - Investment_Account : Investment_Account_Type := - TC_Investment_Account; - Checking_Account : Checking_Account_Type := - TC_Checking_Account; - Savings_Account : Savings_Account_Type := - TC_Savings_Account; - - -- The instantiations below are a central point in this test. - -- Storage_IO is instantiated for each of the specific tagged - -- type. These instantiated packages will be used to compress - -- tagged objects of these various types into buffers that will - -- be written to the Direct_IO files declared below. - - package Acct_SIO is new Ada.Storage_IO (Account_Type); - package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type); - package Inv_SIO is new Ada.Storage_IO (Investment_Account_Type); - package Chk_SIO is new Ada.Storage_IO (Checking_Account_Type); - package Sav_SIO is new Ada.Storage_IO (Savings_Account_Type); - - -- Direct_IO is instantiated for the buffer types defined in the - -- instantiated Storage_IO packages. - - package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type); - package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type); - package Inv_DIO is new Ada.Direct_IO (Inv_SIO.Buffer_Type); - package Chk_DIO is new Ada.Direct_IO (Chk_SIO.Buffer_Type); - package Sav_DIO is new Ada.Direct_IO (Sav_SIO.Buffer_Type); - - Acct_Buffer : Acct_SIO.Buffer_Type; - Cash_Buffer : Cash_SIO.Buffer_Type; - Inv_Buffer : Inv_SIO.Buffer_Type; - Chk_Buffer : Chk_SIO.Buffer_Type; - Sav_Buffer : Sav_SIO.Buffer_Type; - - Acct_File : Acct_DIO.File_Type; - Cash_File : Cash_DIO.File_Type; - Inv_File : Inv_DIO.File_Type; - Chk_File : Chk_DIO.File_Type; - Sav_File : Sav_DIO.File_Type; - - begin - - Acct_DIO.Create (Acct_File, Acct_DIO.Out_File, Acct_Filename); - Cash_DIO.Create (Cash_File, Cash_DIO.Out_File, Cash_Filename); - Inv_DIO.Create (Inv_File, Inv_DIO.Out_File, Inv_Filename); - Chk_DIO.Create (Chk_File, Chk_DIO.Out_File, Chk_Filename); - Sav_DIO.Create (Sav_File, Sav_DIO.Out_File, Sav_Filename); - - -- Store the tag values of the objects declared above for - -- comparison with tag values of objects following processing. - - TC_Account_Type_Tag := - new String'(Ada.Tags.External_Tag(Account_Type'Tag)); - - TC_Cash_Account_Type_Tag := - new String'(Ada.Tags.External_Tag(Cash_Account_Type'Tag)); - - TC_Investment_Account_Type_Tag := - new String'(Ada.Tags.External_Tag(Investment_Account_Type'Tag)); - - TC_Checking_Account_Type_Tag := - new String'(Ada.Tags.External_Tag(Checking_Account_Type'Tag)); - - TC_Savings_Account_Type_Tag := - new String'(Ada.Tags.External_Tag(Savings_Account_Type'Tag)); - - -- Prepare tagged data for writing to the Direct_IO files using - -- Storage_IO procedure to place data in buffers. - - Acct_SIO.Write (Buffer => Acct_Buffer, Item => Account); - Cash_SIO.Write (Cash_Buffer, Cash_Account); - Inv_SIO.Write (Inv_Buffer, Item => Investment_Account); - Chk_SIO.Write (Buffer => Chk_Buffer, Item => Checking_Account); - Sav_SIO.Write (Sav_Buffer, Savings_Account); - - -- At this point, the data and associated tag values have been - -- buffered by the Storage_IO procedure, and the buffered data - -- can be written to the appropriate Direct_IO file. - - Acct_DIO.Write (File => Acct_File, Item => Acct_Buffer); - Cash_DIO.Write (Cash_File, Cash_Buffer); - Inv_DIO.Write (Inv_File, Item => Inv_Buffer); - Chk_DIO.Write (File => Chk_File, Item =>Chk_Buffer); - Sav_DIO.Write (Sav_File, Sav_Buffer); - - -- Close all Direct_IO files. - - Acct_DIO.Close (Acct_File); - Cash_DIO.Close (Cash_File); - Inv_DIO.Close (Inv_File); - Chk_DIO.Close (Chk_File); - Sav_DIO.Close (Sav_File); - - exception - when others => Report.Failed("Exception raised in Buffer_Data"); - end Buffer_Data; - - procedure Read_Data is - - Account : Account_Type; - Cash_Account : Cash_Account_Type; - Investment_Account : Investment_Account_Type; - Checking_Account : Checking_Account_Type; - Savings_Account : Savings_Account_Type; - - -- Storage_IO is instantiated for each of the specific tagged - -- type. - - package Acct_SIO is new Ada.Storage_IO (Account_Type); - package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type); - package Inv_SIO is new Ada.Storage_IO (Investment_Account_Type); - package Chk_SIO is new Ada.Storage_IO (Checking_Account_Type); - package Sav_SIO is new Ada.Storage_IO (Savings_Account_Type); - - -- Direct_IO is instantiated for the buffer types defined in the - -- instantiated Storage_IO packages. - - package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type); - package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type); - package Inv_DIO is new Ada.Direct_IO (Inv_SIO.Buffer_Type); - package Chk_DIO is new Ada.Direct_IO (Chk_SIO.Buffer_Type); - package Sav_DIO is new Ada.Direct_IO (Sav_SIO.Buffer_Type); - - Acct_Buffer : Acct_SIO.Buffer_Type; - Cash_Buffer : Cash_SIO.Buffer_Type; - Inv_Buffer : Inv_SIO.Buffer_Type; - Chk_Buffer : Chk_SIO.Buffer_Type; - Sav_Buffer : Sav_SIO.Buffer_Type; - - Acct_File : Acct_DIO.File_Type; - Cash_File : Cash_DIO.File_Type; - Inv_File : Inv_DIO.File_Type; - Chk_File : Chk_DIO.File_Type; - Sav_File : Sav_DIO.File_Type; - - begin - - -- Open the Direct_IO files. - - Acct_DIO.Open (Acct_File, Acct_DIO.In_File, Acct_Filename); - Cash_DIO.Open (Cash_File, Cash_DIO.In_File, Cash_Filename); - Inv_DIO.Open (Inv_File, Inv_DIO.In_File, Inv_Filename); - Chk_DIO.Open (Chk_File, Chk_DIO.In_File, Chk_Filename); - Sav_DIO.Open (Sav_File, Sav_DIO.In_File, Sav_Filename); - - -- Read the buffer data from the files using Direct_IO. - - Acct_DIO.Read (File => Acct_File, Item => Acct_Buffer); - Cash_DIO.Read (Cash_File, Cash_Buffer); - Inv_DIO.Read (Inv_File, Item => Inv_Buffer); - Chk_DIO.Read (File => Chk_File, Item =>Chk_Buffer); - Sav_DIO.Read (Sav_File, Sav_Buffer); - - -- At this point, the data and associated tag values are stored - -- in buffers. Use the Storage_IO procedure Read to recreate the - -- tagged objects from the buffers. - - Acct_SIO.Read (Buffer => Acct_Buffer, Item => Account); - Cash_SIO.Read (Cash_Buffer, Cash_Account); - Inv_SIO.Read (Inv_Buffer, Item => Investment_Account); - Chk_SIO.Read (Buffer => Chk_Buffer, Item => Checking_Account); - Sav_SIO.Read (Sav_Buffer, Savings_Account); - - -- Delete all Direct_IO files. - - Acct_DIO.Delete (Acct_File); - Cash_DIO.Delete (Cash_File); - Inv_DIO.Delete (Inv_File); - Chk_DIO.Delete (Chk_File); - Sav_DIO.Delete (Sav_File); - - Data_Verification_Block: - begin - - if Account /= TC_Account then - Report.Failed("Incorrect Account object reconstructed"); - end if; - - if Cash_Account /= TC_Cash_Account then - Report.Failed - ("Incorrect Cash_Account object reconstructed"); - end if; - - if Investment_Account /= TC_Investment_Account then - Report.Failed - ("Incorrect Investment_Account object reconstructed"); - end if; - - if Checking_Account /= TC_Checking_Account then - Report.Failed - ("Incorrect Checking_Account object reconstructed"); - end if; - - if Savings_Account /= TC_Savings_Account then - Report.Failed - ("Incorrect Savings_Account object reconstructed"); - end if; - - exception - when others => - Report.Failed - ("Exception raised during Data_Verification Block"); - end Data_Verification_Block; - - - -- To ensure that the tags of the values reconstructed by - -- Storage_IO were properly preserved, object tag values following - -- object reconstruction are compared with tag values of objects - -- stored prior to processing. - - Tag_Verification_Block: - begin - - if TC_Account_Type_Tag.all /= - Ada.Tags.External_Tag(Account_Type'Class(Account)'Tag) - then - Report.Failed("Incorrect Account tag"); - end if; - - if TC_Cash_Account_Type_Tag.all /= - Ada.Tags.External_Tag( - Cash_Account_Type'Class(Cash_Account)'Tag) - then - Report.Failed("Incorrect Cash_Account tag"); - end if; - - if TC_Investment_Account_Type_Tag.all /= - Ada.Tags.External_Tag( - Investment_Account_Type'Class(Investment_Account)'Tag) - then - Report.Failed("Incorrect Investment_Account tag"); - end if; - - if TC_Checking_Account_Type_Tag.all /= - Ada.Tags.External_Tag( - Checking_Account_Type'Class(Checking_Account)'Tag) - then - Report.Failed("Incorrect Checking_Account tag"); - end if; - - if TC_Savings_Account_Type_Tag.all /= - Ada.Tags.External_Tag( - Savings_Account_Type'Class(Savings_Account)'Tag) - then - Report.Failed("Incorrect Savings_Account tag"); - end if; - - exception - when others => - Report.Failed ("Exception raised during tag evaluation"); - end Tag_Verification_Block; - - exception - when others => Report.Failed ("Exception in Read_Data"); - end Read_Data; - - begin -- Test_Block - - -- Enter the data into the appropriate files. - Buffer_Data; - - -- Reconstruct the data from files, and verify the results. - Read_Data; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXA9002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a deleted file mode 100644 index 6c2af987009..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a +++ /dev/null @@ -1,279 +0,0 @@ --- CXAA001.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 Line_Length and Page_Length maximums for a Text_IO --- file of mode Append_File are initially zero (unbounded) after a --- Create, Open, or Reset, and that these values can be modified using --- the procedures Set_Line_Length and Set_Page_Length. --- Check that setting the Line_Length and Page_Length attributes to zero --- results in an unbounded Text_IO file. --- Check that setting the line length when in Append_Mode doesn't --- change the length of lines previously written to the Text_IO file. --- --- TEST DESCRIPTION: --- This test attempts to simulate a possible text processing environment. --- String values, from a number of different string types, are written to --- a Text_IO file. Prior to the writing of each, the line length is set --- to the particular length of the data being written. In addition, the --- default line and page lengths are checked, to determine whether they --- are unbounded (length = 0) following a create, reset, or open of a --- Text_IO file with mode Append_File. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA001 is - use Ada; - Data_File : Text_IO.File_Type; - Data_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA001" ); - Incomplete : exception; -begin - - Report.Test ("CXAA001","Check that the Line_Length and Page_Length " & - "maximums for a Text_IO file of mode Append_File " & - "are initially zero (unbounded) after a Create, " & - "Open, or Reset, and that these values can be " & - "modified using the procedures Set_Line_Length " & - "and Set_Page_Length"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise an exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Data_File, - Mode => Text_IO.Append_File, - Name => Data_Filename); - - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Append_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - - subtype Confidential_Data_Type is string (1 .. 10); - subtype Secret_Data_Type is string (1 .. 20); - subtype Top_Secret_Data_Type is string (1 .. 30); - - Zero : constant Text_IO.Count := 0; - Confidential_Data_Size : constant Text_IO.Count := 10; - Secret_Data_Size : constant Text_IO.Count := 20; - Top_Secret_Data_Size : constant Text_IO.Count := 30; - - -- The following generic procedure is designed to simulate a text - -- processing environment where line and page sizes are set and - -- verified prior to the writing of data to a file. - - generic - Data_Size : Text_IO.Count; - procedure Write_Data_To_File (Data_Item : in String); - - procedure Write_Data_To_File (Data_Item : in String) is - use Text_IO; -- Used to provide visibility to the "/=" operator. - begin - if (Text_IO.Line_Length (Data_File) /= Zero) then -- Check default - Report.Failed("Line not of unbounded length"); -- line length, - elsif (Text_IO.Page_Length (Data_File) /= Zero) then -- default - Report.Failed ("Page not of unbounded length"); -- page length. - end if; - - Text_IO.Set_Line_Length (File => Data_File, -- Set the line - To => Data_Size); -- length. - Text_IO.Set_Page_Length (File => Data_File, -- Set the page - To => Data_Size); -- length. - -- Verify the lengths set. - if (Integer(Text_IO.Line_Length (Data_File)) /= - Report.Ident_Int(Integer(Data_Size))) then - Report.Failed ("Line length not set to appropriate length"); - elsif (Integer(Text_IO.Page_Length (Data_File)) /= - Report.Ident_Int(Integer(Data_Size))) then - Report.Failed ("Page length not set to appropriate length"); - end if; - - Text_IO.Put_Line (File => Data_File, -- Write data to - Item => Data_Item); -- file. - - end Write_Data_To_File; - - -- Instantiation for the three data types/sizes. - - procedure Write_Confidential_Data is - new Write_Data_To_File (Data_Size => Confidential_Data_Size); - - procedure Write_Secret_Data is - new Write_Data_To_File (Data_Size => Secret_Data_Size); - - procedure Write_Top_Secret_Data is - new Write_Data_To_File (Data_Size => Top_Secret_Data_Size); - - Confidential_Item : Confidential_Data_Type := "Confidenti"; - Secret_Item : Secret_Data_Type := "Secret Data Values "; - Top_Secret_Item : Top_Secret_Data_Type := - "Extremely Top Secret Data "; - - begin - - -- The following call simulates processing occurring after the create - -- of a Text_IO file with mode Append_File. - - Write_Confidential_Data (Confidential_Item); - - -- The following call simulates processing occurring after the reset - -- of a Text_IO file with mode Append_File. - - Reset1: - begin - Text_IO.Reset (Data_File, Text_IO.Append_File); -- Reset to - -- Append_File mode. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Write_Secret_Data (Data_Item => Secret_Item); - - Text_IO.Close (Data_File); -- Close file. - - -- The following processing simulates processing occurring after the - -- opening of an existing file with mode Append_File. - - Text_IO.Open (Data_File, -- Open file in - Text_IO.Append_File, -- Append_File mode. - Data_Filename); - - Write_Top_Secret_Data (Top_Secret_Item); - - Test_Verification_Block: - declare - TC_String1, - TC_String2, - TC_String3 : String (1..80) := (others => ' '); - TC_Length1, - TC_Length2, - TC_Length3 : Natural := 0; - begin - - Reset2: - begin - Text_IO.Reset (Data_File, Text_IO.In_File); -- Reset for reading. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset2; - - Text_IO.Get_Line (Data_File, TC_String1, TC_Length1); - Text_IO.Get_Line (Data_File, TC_String2, TC_Length2); - Text_IO.Get_Line (Data_File, TC_String3, TC_Length3); - - -- Verify that the line lengths of each line were accurate. - -- Note: Each data line was written to the file after the - -- particular line length had been set (to the data length). - - if not ((TC_Length1 = Natural(Confidential_Data_Size)) and - (TC_Length2 = Natural(Secret_Data_Size)) and - (TC_Length3 = Natural(Top_Secret_Data_Size))) then - Report.Failed ("Inaccurate line lengths read from file"); - end if; - - -- Verify that the data read from the file are accurate. - - if (TC_String1(1..TC_Length1) /= Confidential_Item) or else - (TC_String2(1..TC_Length2) /= Secret_Item) or else - (TC_String3(1..TC_Length3) /= Top_Secret_Item) then - Report.Failed ("Corrupted data items read from file"); - end if; - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Exception raised during Text_IO processing"); - - end Operational_Test_Block; - - Deletion: - begin - -- Check that the file is open prior to deleting it. - if Text_IO.Is_Open(Data_File) then - Text_IO.Delete(Data_File); - else - Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename); - Text_IO.Delete(Data_File); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a deleted file mode 100644 index 953d33f1d44..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a +++ /dev/null @@ -1,257 +0,0 @@ --- CXAA002.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 procedures New_Page, Set_Line, Set_Col, and New_Line --- subprograms perform properly on a text file created with mode --- Append_File. --- Check that the attributes Page, Line, and Column are all set to 1 --- following the creation of a text file with mode Append_File. --- Check that the functions Page, Line, and Col perform properly on a --- text file created with mode Append_File. --- Check that the procedures Put and Put_Line perform properly on text --- files created with mode Append_File. --- Check that the procedure Set_Line sets the current line number to --- the value specified by the parameter "To" for text files created with --- mode Append_File. --- Check that the procedure Set_Col sets the current column number to --- the value specified by the parameter "To" for text files created with --- mode Append_File. --- --- TEST DESCRIPTION: --- This test is designed to simulate the text processing that could --- occur with files that have been created in Append_File mode. Various --- calls to Text_IO formatting subprograms are called to properly --- position text appended to a document. The text content and position --- are subsequently verified for accuracy. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations - ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA002 is - use Ada; - Data_File : Text_IO.File_Type; - Data_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA002" ); - Incomplete : exception; -begin - - Report.Test ("CXAA002", "Check that page, line, and column formatting " & - "subprograms perform properly on text files " & - "created with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Data_File, - Mode => Text_IO.Append_File, - Name => Data_Filename); - - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Append_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - Default_Position : constant Text_IO.Positive_Count := 1; - Section_Header : constant String := "VII. "; - Appendix_Title : constant String := "Appendix A"; - Appendix_Content : constant String := "TBD"; - - -- The following procedure simulates the addition of an Appendix page - -- to an existing text file. - procedure Position_Appendix_Text is - use Text_IO; -- To provide visibility to the "/=" operator. - begin - - -- Test control code. - -- Verify initial page, line, column number. - if "/="(Text_IO.Page (Data_File), Default_Position) then - Report.Failed ("Incorrect default page number"); - end if; - if Text_IO.Line (Data_File) /= Default_Position then - Report.Failed ("Incorrect default line number"); - end if; - if "/="(Text_IO.Col (Data_File), Default_Position) then - Report.Failed ("Incorrect default column number"); - end if; - - -- Simulated usage code. - -- Set new page/line positions. - Text_IO.Put_Line - (Data_File, "Add some optional data to the file here"); - Text_IO.New_Page (Data_File); - Text_IO.New_Line (File => Data_File, Spacing => 2); - - -- Test control code. - if Integer(Text_IO.Page (Data_File)) /= Report.Ident_Int(2) or else - Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(3) then - Report.Failed ("Incorrect results from page/line positioning"); - end if; - - -- Simulated usage code. - Text_IO.Put (Data_File, Section_Header); -- Position title - Text_IO.Put_Line (Data_File, Appendix_Title); -- of Appendix. - - Text_IO.Set_Line (File => Data_File, To => 5); -- Set new - Text_IO.Set_Col (File => Data_File, To => 8); -- position. - - -- Test control code. - if (Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(5)) or - (Integer(Text_IO.Col (Data_File)) /= Report.Ident_Int(8)) then - Report.Failed ("Incorrect results from line/column positioning"); - end if; - - -- Simulated usage code. -- Position - Text_IO.Put_Line (Data_File, Appendix_Content); -- content of - -- Appendix. - end Position_Appendix_Text; - - begin - - -- This code section simulates a scenario that could occur in a - -- text processing environment: - -- A document is created/modified/edited Then... - -- Text is to be appended to the document. - -- A procedure is called to perform that operation. - -- The position on the appended page is set, verified, and text is - -- appended to the existing file. - -- - -- Note: The text file has been originally created in Append_File - -- mode, and has not been closed prior to this processing. - - Position_Appendix_Text; - - Test_Verification_Block: - declare - TC_Page, - TC_Line, - TC_Column : Text_IO.Positive_Count; - TC_Position : Natural := 0; - Blanks : constant String := " "; - TC_String : String (1 .. 17) := Blanks; - begin - - Reset1: - begin - Text_IO.Reset (Data_File, Text_IO.In_File); - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Text_IO.Skip_Page (Data_File); - -- Loop to the third line - for I in 1 .. 3 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - - if (TC_Position /= 16) or else -- Verify the title line. - (TC_String (1..4) /= "VII.") or else - (TC_String (3..16) /= ("I. " & Appendix_Title)) then - Report.Failed ("Incorrect positioning of title line"); - end if; - - TC_String := Blanks; -- Clear string. - -- Loop to the fifth line - for I in 4 .. 5 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - - if (TC_Position /= 10) or -- Verify the contents. - (TC_String (8..10) /= Appendix_Content) then - Report.Failed ("Incorrect positioning of contents line"); - end if; - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Exception raised during Text_IO processing"); - - end Operational_Test_Block; - - Deletion: - begin - -- Delete the external file. - if Text_IO.Is_Open(Data_File) then - Text_IO.Delete(Data_File); - else - Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename); - Text_IO.Delete(Data_File); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a deleted file mode 100644 index c9580dfb343..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a +++ /dev/null @@ -1,293 +0,0 @@ --- CXAA003.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 procedures New_Page, Set_Line, Set_Col, and New_Line --- subprograms perform properly on a text file reset (from Out_File) --- with mode Append_File. --- Check that the attributes Page, Line, and Column are all set to 1 --- following the reset of a text file with mode Append_File. --- Check that the functions Page, Line, and Col perform properly on a --- text file reset with mode Append_File. --- Check that the procedures Put and Put_Line perform properly on text --- files reset with mode Append_File. --- Check that the procedure Set_Line sets the current line number to --- the value specified by the parameter "To" for text files reset with --- mode Append_File. Check that Set_Line has no effect if the specified --- line equals the current line. --- Check that the procedure Set_Col sets the current column number to --- the value specified by the parameter "To" for text files reset with --- mode Append_File. --- --- TEST DESCRIPTION: --- This test is designed to simulate the text processing that could --- occur with files that have been created in Out_File mode, --- and then reset to Append_File mode. --- Various calls to Text_IO formatting subprograms are called to properly --- position text appended to a document. The text content and position --- are subsequently verified for accuracy. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 24 Feb 97 PWB.CTA Allowed for non-support of some IO operations. ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA003 is - use Ada; - Data_File : Text_IO.File_Type; - Data_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA003" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA003", "Check that page, line, and column formatting " & - "subprograms perform properly on text files " & - "reset with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Data_File, - Mode => Text_IO.Out_File, - Name => Data_Filename); - exception - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Text files not supported - Create as Out_File" ); - raise Incomplete; - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - - Default_Position : constant Text_IO.Positive_Count := 1; - - Section_Header : constant String := "IX. "; - Glossary_Title : constant String := "GLOSSARY"; - Glossary_Content : constant String := "TBD"; - - -- The following procedure simulates the addition of a Glossary page - -- to an existing text file that has been reset with mode - -- Append_File. - - procedure Position_Glossary_Text - (The_File : in out Text_IO.File_Type) is - use Text_IO; -- To provide visibility to the "/=" operator. - begin - - -- Test control code. - -- Verify initial page value. - if (Text_IO.Page (The_File) /= Default_Position) then - Report.Failed ("Incorrect default page number"); - end if; - -- Verify initial line number. - if (Text_IO.Line (The_File) /= Default_Position) then - Report.Failed ("Incorrect default line number"); - end if; - -- Verify initial column number. - if (Text_IO.Col (The_File) /= Default_Position) then - Report.Failed ("Incorrect default column number"); - end if; - -- Simulated usage code. Set new page/line positions. - Text_IO.New_Page (The_File); - Text_IO.New_Page (The_File); - Text_IO.New_Line (File => The_File, Spacing => 1); - - -- Test control code. - if (Integer(Text_IO.Page(The_File)) /= - Report.Ident_Int(3)) or else - (Integer(Text_IO.Line (The_File)) /= - Report.Ident_Int(2)) then - Report.Failed ("Incorrect results from page/line positioning"); - end if; - - -- Simulated usage code. Position title of Glossary. - Text_IO.Put (The_File, Section_Header); - Text_IO.Put_Line (The_File, Glossary_Title); - -- Set line to the current line. - Text_IO.Set_Line (File => The_File, To => 3); - - -- Test control code. - if (Integer(Text_IO.Page (The_File)) /= Report.Ident_Int(3)) or - (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(3)) or - (Integer(Text_IO.Col (The_File)) /= Report.Ident_Int(1)) then - Report.Failed ("Set_Line failed for current line"); - end if; - - -- Simulated usage code. - Text_IO.Set_Line (File => The_File, To => 4); -- Set new - Text_IO.Set_Col (File => The_File, To => 10); -- position. - - -- Test control code. - if (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(4)) or - (Integer(Text_IO.Col (The_File)) /= Report.Ident_Int(10)) then - Report.Failed - ("Incorrect results from line/column positioning"); - end if; - - -- Simulated usage code. -- Position - Text_IO.Put_Line (The_File, Glossary_Content); -- content of - -- Glossary. - end Position_Glossary_Text; - - - begin - - -- In the scenario, data is added to the file here. - Text_IO.Put_Line (File => Data_File, Item => "Some optional data"); - - -- This code section simulates a scenario that could occur in a - -- text processing environment. Text is to be appended to an - -- existing document: - -- The file is reset to append mode. - -- A procedure is called to perform the positioning and placement - -- of text. - -- The position on the appended page is set, verified, and text is - -- placed in the file. - -- - -- Note: The text file has been originally created in Out_File - -- mode, and has subsequently been reset to Append_File mode. - - Reset1: - begin - -- Reset has effect of calling New_Page. - Text_IO.Reset (Data_File, Text_IO.Append_File); - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Position_Glossary_Text (The_File => Data_File); - - Test_Verification_Block: - declare - TC_Page, TC_Line, TC_Column : Text_IO.Positive_Count; - TC_Position : Natural := 0; - Blanks : constant String := - " "; - TC_String : String (1 .. 15) := Blanks; - begin - Reset2: - begin - Text_IO.Reset (Data_File, Text_IO.In_File); - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset2; - - Text_IO.Skip_Page (Data_File); - Text_IO.Skip_Page (Data_File); - - -- If the Reset to Append_File mode actually put a page terminator - -- on the file, as allowed (but not required) by RM A.10.2(4), then - -- we are now on page 3, an empty page. We'll need to skip one more. - - if Text_IO.End_Of_Page (Data_File) then - Text_IO.Skip_Page (Data_File); - end if; - - -- Now we're on the Glossary page. - - -- Loop to the second line - for I in 1 .. 2 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - if (TC_Position /= 13) or else -- Verify the title line. - (TC_String (1..2) /= "IX") or else - (TC_String (3..13) /= (". " & Glossary_Title)) then - Report.Failed ("Incorrect positioning of title line"); - end if; - - TC_String := Blanks; -- Clear string. - -- Loop to the fourth line - for I in 3 .. 4 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - - if (TC_Position /= 12) or -- Verify the contents. - (TC_String (8..12) /= " " & Glossary_Content) then - Report.Failed ("Incorrect positioning of contents line"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception raised during Text_IO processing"); - - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open (Data_File) then - Text_IO.Delete (Data_File); - else - Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename); - Text_IO.Delete (Data_File); - end if; - exception - when others => - Report.Failed ( "Delete not properly implemented for Text_IO" ); - end Final_Block; - - Report.Result; - - exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA003; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a deleted file mode 100644 index f3ea17ebad3..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a +++ /dev/null @@ -1,260 +0,0 @@ --- CXAA004.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 procedures New_Page, Set_Line, Set_Col, and New_Line --- perform properly on a text file opened with mode Append_File. --- Check that the attributes Page, Line, and Column are all set to 1 --- following the opening of a text file with mode Append_File. --- Check that the functions Page, Line, and Col perform properly on a --- text file opened with mode Append_File. --- Check that the procedures Put and Put_Line perform properly on text --- files opened with mode Append_File. --- Check that the procedure Set_Line sets the current line number to --- the value specified by the parameter "To" for text files opened with --- mode Append_File. --- Check that the procedure Set_Col sets the current column number to --- the value specified by the parameter "To" for text files reset with --- mode Append_File. --- --- TEST DESCRIPTION: --- This test is designed to simulate the text processing that could --- occur with files that have been created in Out_File mode, --- and then reset to Append_File mode. --- Various calls to Text_IO formatting subprograms are called to properly --- position text appended to a document. The text content and position --- are subsequently verified for accuracy. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 24 Feb 97 PWB.CTA Allowed for non-support of some IO operations. ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA004 is - use Ada; - Data_File : Text_IO.File_Type; - Data_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA004" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA004", "Check that page, line, and column formatting " & - "subprograms perform properly on text files " & - "opened with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Data_File, - Mode => Text_IO.Out_File, - Name => Data_Filename); - - exception - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create for Text_IO" ); - raise Incomplete; - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - use Text_IO; -- To provide visibility to the "/=" operator. - - Default_Position : constant Text_IO.Positive_Count := 1; - - Section_Header : constant String := "X. "; - Reference_Title : constant String := "REFERENCES"; - Reference_Content : constant String := "Available Upon Request"; - - begin - - -- Some amount of text processing would occur here in the scenario - -- following file creation, prior to file closure. - Text_IO.Put_Line (File => Data_File, Item => "Some optional data"); - - -- Close has the effect of a call to New_Page (adding a page - -- terminator). - Text_IO.Close (Data_File); - - -- This code section simulates a scenario that could occur in a - -- text processing environment: - -- Certain text is to be appended to a document. - -- The file is opened in Append_File mode. - -- The position on the appended page is set, verified, and text - -- is placed in the file. - -- - -- Note: The text file has been originally created in Out_File - -- mode, has been subsequently closed and is now being reopened in - -- Append_File mode for further processing. - - Text_IO.Open (Data_File, Text_IO.Append_File, Data_Filename); - - -- Test control code. - if (Text_IO.Page(Data_File) /= Default_Position) then -- Verify init. - Report.Failed ("Incorrect default page number"); -- page value. - end if; - if (Text_IO.Line(Data_File) /= Default_Position) then -- Verify init. - Report.Failed ("Incorrect default line number"); -- line number. - end if; - if (Text_IO.Col (Data_File) /= Default_Position) then -- Verify init. - Report.Failed ("Incorrect default column number"); -- column no. - end if; - - -- Simulated usage code. - Text_IO.New_Page (Data_File); -- Set new page/ - Text_IO.New_Line (File => Data_File, Spacing => 2); -- line pos. - Text_IO.Put (Data_File, Section_Header); -- Position - Text_IO.Put_Line (Data_File, Reference_Title); -- title. - - -- Test control code. -- Verify new - if (Integer(Text_IO.Page (Data_File)) /= -- page and - Report.Ident_Int(2)) or else -- line. - (Integer(Text_IO.Line (Data_File)) /= - Report.Ident_Int(4)) then - Report.Failed ("Incorrect results from page/line positioning"); - end if; - - -- Simulated usage code. - Text_IO.Set_Line (File => Data_File, To => 8); -- Set new - Text_IO.Set_Col (File => Data_File, To => 30); -- position. - Text_IO.Put_Line (Data_File, Reference_Content); - - -- Test control code. - if (Integer(Text_IO.Line (Data_File)) /= - Report.Ident_Int(9)) or -- Verify new - (Integer(Text_IO.Col (Data_File)) /= -- position. - Report.Ident_Int(1)) then - Report.Failed ("Incorrect results from line/column positioning"); - end if; - - Test_Verification_Block: - declare - TC_Page, TC_Line, TC_Column : Text_IO.Positive_Count; - TC_Position : Natural := 0; - TC_String : String (1 .. 55) := (others => ' '); - begin - - Reset1: - begin - Text_IO.Reset (Data_File, Text_IO.In_File); - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Text_IO.Skip_Page (Data_File); - - -- If the Reset to Append_File mode actually put a page terminator - -- in the file, as allowed (but not required) by RM A.10.2(4), then - -- we are now on page 2, an empty page. Therefore, we need to skip - -- one more page. - - if Text_IO.End_Of_Page (Data_File) then - Text_IO.Skip_Page (Data_File); - end if; - - -- Now we're on the reference page. - - -- Loop to the third line - for I in 1 .. 3 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - - if (TC_Position /= 14) or else -- Verify the title line. - (TC_String (1..6) /= "X. RE") or else - (TC_String (2..14) /= (". " & Reference_Title)) then - Report.Failed ("Incorrect positioning of title line"); - end if; - -- Loop to the eighth line - for I in 4 .. 8 loop -- and read the contents. - Text_IO.Get_Line (Data_File, TC_String, TC_Position); - end loop; - - if (TC_Position /= 51) or -- Verify the contents. - (TC_String (30..51) /= "Available Upon Request") then - Report.Failed ("Incorrect positioning of contents line"); - end if; - - exception - - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when Incomplete => - raise; - when others => - Report.Failed ("Exception raised during Text_IO processing"); - - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open (Data_File) then - Text_IO.Delete (Data_File); - else - Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename); - Text_IO.Delete (Data_File); - end if; - exception - when others => - Report.Failed ( "Delete not properly implemented - Text_IO" ); - end Final_Block; - - Report.Result; - -exception - - when Incomplete => - Report.Result; - when others => - Report.Failed ("Unexpected exception"); - Report.Result; - -end CXAA004; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a deleted file mode 100644 index 7b2a0bc39d3..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a +++ /dev/null @@ -1,292 +0,0 @@ --- CXAA005.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 procedure Put, when called with string parameters, does --- not update the line number of a text file of mode Append_File, when --- the line length is unbounded (i.e., only the column number is --- updated). --- Check that a call to the procedure Put with a null string argument --- has no measurable effect on a text file of mode Append_File. --- --- TEST DESCRIPTION: --- This test is designed to ensure that when a string is appended to an --- unbounded text file, it is placed following the last element currently --- in the file. For an unbounded text file written with Put procedures --- only (not Put_Line), the line number should not be incremented by --- subsequent calls to Put in Append_File mode. Only the column number --- should be incremented based on the length of the string parameter --- placed in the file. If a call to Put with a null string argument is --- made, no change to the line or column number should occur, and no --- element(s) should be added to the file, so that there would be no --- measurable change to the file. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations that support Text_IO --- processing and external files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 24 Feb 97 CTA.PWB Allowed for non-support of some IO operations. ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA005 is - An_Unbounded_File : Ada.Text_IO.File_Type; - Unbounded_File_Name : constant String := - Report.Legal_File_Name ( Nam => "CXAA005" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA005", "Check that the procedure Put does not " & - "increment line numbers when used with " & - "unbounded text files of mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An application creates a text file in mode Out_File, with the intention - -- of entering string data packets into the file as appropriate. In the - -- event that the particular environment where the application is running - -- does not support Text_IO, Use_Error will be raised on calls to Text_IO - -- operations. - -- This exception will be handled to produce a Not_Applicable result. - - Ada.Text_IO.Create (File => An_Unbounded_File, - Mode => Ada.Text_IO.Out_File, - Name => Unbounded_File_Name); - exception - when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create for Text_IO" ); - raise Incomplete; - end Test_For_Text_IO_Support; - - Operational_Test_Block: - declare - subtype String_Sequence_Type is string (1 .. 20); - type String_Pointer_Type is access String_Sequence_Type; - --- During the course of processing, the application creates a variety of data --- pointers that refer to particular data items. The possibility of having --- null data values in this environment exists. - - Data_Packet_1 : String_Pointer_Type := - new String_Sequence_Type'("One Data Sequence 01"); - - Data_Packet_2 : String_Pointer_Type := - new String_Sequence_Type'("New Data Sequence 02"); - - Blank_Data_Packet : String_Pointer_Type := - new String_Sequence_Type'(" "); - - Null_Data_Packet : constant String := ""; - - TC_Line, TC_Col : Natural := 0; - - function TC_Mode_Selection (Selector : Integer) - return Ada.Text_IO.File_Mode is - begin - case Selector is - when 1 => return Ada.Text_IO.In_File; - when 2 => return Ada.Text_IO.Out_File; - when others => return Ada.Text_IO.Append_File; - end case; - end TC_Mode_Selection; - - begin - --- The application places some data into the file, using the Put subroutine. --- This operation can occur one-to-many times. - - Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_1.all); - - -- Test control code. - if (Integer(Ada.Text_IO.Col (An_Unbounded_File)) /= - Report.Ident_Int(21)) or - (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /= - Report.Ident_Int(1)) then - Report.Failed ("Incorrect Col position after 1st Put"); - end if; - --- The application may close the file at some point following its initial --- entry of data. - - Ada.Text_IO.Close (An_Unbounded_File); - --- At some later point in the processing, more data needs to be added to the --- file, so the application opens the file in Append_File mode. - - Ada.Text_IO.Open (File => An_Unbounded_File, - Mode => Ada.Text_IO.Append_File, - Name => Unbounded_File_Name); - - -- Test control code. - -- Store line/column number for later comparison. - TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File)); - TC_Col := Natural(Ada.Text_IO.Col(An_Unbounded_File)); - --- Additional data items can then be appended to the file. - - Ada.Text_IO.Put (An_Unbounded_File, Blank_Data_Packet.all); - - -- Test control code. - if (Natural(Ada.Text_IO.Col (An_Unbounded_File)) /= - (TC_Col + 20)) or - (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /= - TC_Line) then - Report.Failed ("Incorrect Col position after 2nd Put"); - end if; - --- In order to accommodate various scenarios, the application may have changed --- the mode of the data file to In_File in order to retrieve/verify some of --- the data contained there. However, with the need to place more data into --- the file, the file can be reset to Append_File mode. - - Reset1: - begin - Ada.Text_IO.Reset (An_Unbounded_File, - TC_Mode_Selection (Report.Ident_Int(3))); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - -- Test control code. - -- Store line/column number for later comparison. - TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File)); - TC_Col := Natural(Ada.Text_IO.Col(An_Unbounded_File)); - --- Additional data can then be appended to the file. On some occasions, an --- attempt to enter a null string value into the file may occur. This should --- have no effect on the file, leaving it unchanged. - - -- No measurable effect from Put with null string. - Ada.Text_IO.Put (An_Unbounded_File, Null_Data_Packet); - - -- Test control code. - -- There should be no change following the Put above. - if (Natural(Ada.Text_IO.Col (An_Unbounded_File)) /= - TC_Col) or - (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /= - TC_Line) then - Report.Failed ("Incorrect Col position after 3rd Put"); - end if; - --- Additional data can be appended to the file. - - Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_2.all); - - -- Test control code. - if (Natural(Ada.Text_IO.Col (An_Unbounded_File)) /= - (TC_Col + 20)) or - (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /= - TC_Line) then - Report.Failed ("Incorrect Col position after 4th Put"); - end if; - - Test_Verification_Block: - declare - File_Data : String (1 .. 80); - TC_Width : Natural; - begin - --- The application has the capability to reset the file to In_File mode to --- verify some of the data that is contained there. - - Reset2: - begin - Ada.Text_IO.Reset (An_Unbounded_File, Ada.Text_IO.In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported - Text_IO" ); - raise Incomplete; - end Reset2; - - Ada.Text_IO.Get_Line (An_Unbounded_File, - File_Data, - TC_Width); - - -- Test control code. - -- Since it is implementation defined whether a page - -- terminator separates preexisting text from new text - -- following an open in append mode (as occurred above), - -- verify only that the first data item written to the - -- file was not overwritten by any subsequent call to Put. - - if (File_Data (File_Data'First) /= 'O') or - (File_Data (20) /= '1') then - Report.Failed ("Data placed incorrectly in file"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Text_IO processing"); - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Ada.Text_IO.Is_Open(An_Unbounded_File) then - Ada.Text_IO.Delete (An_Unbounded_File); - else - Ada.Text_IO.Open(An_Unbounded_File, - Ada.Text_IO.In_File, - Unbounded_File_Name); - Ada.Text_IO.Delete (An_Unbounded_File); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented -- Text_IO" ); - end Final_Block; - - Report.Result; - -exception - - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA005; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a deleted file mode 100644 index 518d43b896e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a +++ /dev/null @@ -1,285 +0,0 @@ --- CXAA006.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 for a bounded line length text file of mode Append_File, --- when the number of characters to be output exceeds the number of --- columns remaining on the current line, a call to Put will output --- characters of the string sufficient to fill the remaining columns of --- the line (up to line length), then output a line terminator, reset the --- column number, increment the line number, then output the balance of --- the item. --- --- Check that the procedure Put does not raise Layout_Error when the --- number of characters to be output exceeds the line length of a bounded --- text file of mode Append_File. --- --- TEST DESCRIPTION: --- This test demonstrates the situation where an application intends to --- output variable length string elements to a text file in the most --- efficient manner possible. This is the case in a typesetting --- environment where text is compressed and split between lines of a --- bounded length. --- --- The procedure Put will break string parameters placed in the file at --- the point of the line length. Two examples are demonstrated in this --- test, one being the case where only one column remains on a line, and --- the other being the case where a larger portion of the line remains --- unfilled, but still not sufficient to contain the entire output --- string. --- --- During the course of the test, the file is reset to Append_File mode, --- and the bounded line length is modified for different lines of the --- file. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations that support Text_IO --- processing and external files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA006 is - - A_Bounded_File : Ada.Text_IO.File_Type; - Bounded_File_Name : constant String := - Report.Legal_File_Name ( Nam => "CXAA006" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA006", "Check that procedure Put will correctly " & - "output string items to a bounded line " & - "length text file of mode Append_File"); - - Test_for_Text_IO_Support: - begin - --- An application creates a text file in mode Append_File, with the intention --- of using the procedure Put to compress variable length string data into the --- file in the most efficient manner possible. - - Ada.Text_IO.Create (File => A_Bounded_File, - Mode => Ada.Text_IO.Append_File, - Name => Bounded_File_Name); - exception - when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create with Append_File for Text_IO" ); - raise Incomplete; - end Test_For_Text_IO_Support; - - Operational_Test_Block: - declare - Twelve_Characters : constant String := "12Characters"; - Nineteen_Characters : constant String := "Nineteen_Characters"; - TC_Line : Natural := 0; - - function TC_Mode_Selection (Selector : Integer) - return Ada.Text_IO.File_Mode is - begin - case Selector is - when 1 => return Ada.Text_IO.In_File; - when 2 => return Ada.Text_IO.Out_File; - when others => return Ada.Text_IO.Append_File; - end case; - end TC_Mode_Selection; - - begin - --- The application sets the line length of the file to be bound at 20. All --- lines in this file will be limited to that length. - - Ada.Text_IO.Set_Line_Length (A_Bounded_File, 20); - - Ada.Text_IO.Put (A_Bounded_File, Nineteen_Characters); - - -- Test control code. - if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /= - Report.Ident_Int(1)) or - (Integer(Ada.Text_IO.Col (A_Bounded_File)) /= - Report.Ident_Int(20)) then - Report.Failed ("Incorrect position after 1st Put"); - end if; - --- The application finds that there is only one column available on the --- current line, so the next string item to be output must be broken at --- the appropriate place (following the first character). - - Ada.Text_IO.Put (File => A_Bounded_File, - Item => Twelve_Characters); - - -- Test control code. - if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /= - Report.Ident_Int(2)) or - (Integer(Ada.Text_IO.Col (A_Bounded_File)) /= - Report.Ident_Int(12)) then - Report.Failed ("Incorrect position after 2nd Put"); - end if; - --- The application subsequently modifies the processing, resetting the file --- at this point to In_File mode in order to verify data that has been written --- to the file. Following this, the application resets the file to Append_File --- mode in order to continue the placement of data into the file, but modifies --- the original bounded line length for subsequent lines to be appended. - - -- Reset to Append mode; call outputs page terminator and - -- resets line length to Unbounded. - Reset1: - begin - Ada.Text_IO.Reset (A_Bounded_File, - TC_Mode_Selection (Report.Ident_Int(3))); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Ada.Text_IO.Set_Line_Length (A_Bounded_File, 15); - - -- Store line number for later comparison. - TC_Line := Natural(Ada.Text_IO.Line(A_Bounded_File)); - --- The application finds that fifteen columns are available on the current --- line but that the string item to be output exceeds this available space. --- It must be split at the end of the line, and the balance placed on the --- next file line. - - Ada.Text_IO.Put (File => A_Bounded_File, - Item => Nineteen_Characters); - - -- Test control code. - -- Positioned on new line at col 5. - if (Natural(Ada.Text_IO.Line (A_Bounded_File)) /= - (TC_Line + 1)) or - (Integer(Ada.Text_IO.Col (A_Bounded_File)) /= - Report.Ident_Int(5)) then - Report.Failed ("Incorrect position after 3rd Put"); - end if; - - - Test_Verification_Block: - declare - First_String : String (1 .. 80); - Second_String : String (1 .. 80); - Third_String : String (1 .. 80); - Fourth_String : String (1 .. 80); - TC_Width1 : Natural; - TC_Width2 : Natural; - TC_Width3 : Natural; - TC_Width4 : Natural; - begin - --- The application has the capability to reset the file to In_File mode to --- verify some or all of the data that is contained there. - - Reset2: - begin - Ada.Text_IO.Reset (A_Bounded_File, Ada.Text_IO.In_File); - exception - when others => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset2; - - Ada.Text_IO.Get_Line - (A_Bounded_File, First_String, TC_Width1); - Ada.Text_IO.Get_Line - (A_Bounded_File, Second_String, TC_Width2); - Ada.Text_IO.Get_Line - (A_Bounded_File, Third_String, TC_Width3); - Ada.Text_IO.Get_Line - (A_Bounded_File, Fourth_String, TC_Width4); - - -- Test control code. - if (First_String (1..TC_Width1) /= Nineteen_Characters & "1") or - (Second_String (1..TC_Width2) /= "2Characters") or - (Third_String (1..TC_Width3) /= - Nineteen_Characters(1..15)) or - (Fourth_String (1..TC_Width4) /= "ters") - then - Report.Failed ("Data placed incorrectly in file"); - end if; - - exception - - when Incomplete => - raise; - - when Ada.Text_IO.End_Error => - Report.Failed ("Incorrect number of lines in file"); - - when others => - Report.Failed ("Error raised during data verification"); - - end Test_Verification_Block; - - exception - - when Ada.Text_IO.Layout_Error => - Report.Failed ("Layout Error raised when positioning text"); - - when others => - Report.Failed ("Exception in Text_IO processing"); - - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Ada.Text_IO.Is_Open(A_Bounded_File) then - Ada.Text_IO.Delete (A_Bounded_File); - else - Ada.Text_IO.Open (A_Bounded_File, - Ada.Text_IO.In_File, - Bounded_File_Name); - Ada.Text_IO.Delete (A_Bounded_File); - end if; - - exception - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Final_Block; - - Report.Result; - -exception - - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA006; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a deleted file mode 100644 index fe79c2d7a86..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a +++ /dev/null @@ -1,263 +0,0 @@ --- CXAA007.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 capabilities of Text_IO.Integer_IO perform correctly --- on files of Append_File mode, for instantiations with integer and --- user-defined subtypes. --- Check that the formatting parameters available in the package can --- be used and modified successfully in the storage and retrieval of --- data. --- --- TEST DESCRIPTION: --- This test simulates a receiving department inventory system. Data on --- items received is entered into an inventory database. This information --- consists of integer entry number, item number, and bar code. --- One item is placed into the inventory file immediately following file --- creation, subsequent items are entered following file opening in --- Append_File mode. Data items are validated by reading all data from --- the file and comparing against known values (those used to enter the --- data originally). --- --- This test verifies issues of create in Append_File mode, appending to --- a file previously appended to, opening in Append_File mode, resetting --- from Append_File mode to In_File mode, as well as a variety of Text_IO --- and Integer_IO predefined subprograms. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA007 is - use Ada; - - Inventory_File : Text_IO.File_Type; - Inventory_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA007" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA007", "Check that the capabilities of " & - "Text_IO.Integer_IO operate correctly for files " & - "with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Inventory_File, - Mode => Text_IO.Append_File, - Name => Inventory_Filename); - exception - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create with Append_File for Text_IO" ); - raise Incomplete; - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - - Max_Entries_Per_Order : constant Natural := 4; - - type Bar_Code_Type is range 0 .. 127; -- Values to be stored as base - -- two numbers in file. - type Item_Type is record - Entry_Number : Natural := 0; - Item_Number : Integer := 0; - Bar_Code : Bar_Code_Type := 0; - end record; - - type Inventory_Type is - array (1 .. Max_Entries_Per_Order) of Item_Type; - - Inventory_List : Inventory_Type := ((1, 119, 87), -- Items received - (2, 206, 44), -- this order. - (3, -25, 126), - (4, -18, 31)); - - Daily_Order : constant := 1; - Entry_Field_Width : constant Natural := 1; - Item_Base : constant Natural := 16; - Items_Inventoried : Natural := 1; - Items_To_Inventory : Natural := 4; - - package Entry_IO is new Text_IO.Integer_IO (Natural); - package Item_IO is new Text_IO.Integer_IO (Integer); - package Bar_Code_IO is new Text_IO.Integer_IO (Bar_Code_Type); - - - -- The following procedure simulates the addition of inventory item - -- information into a data file. - - procedure Update_Inventory (The_Item : in Item_Type) is - Spacer : constant String := " "; - begin - -- Enter all the incoming data into the inventory file. - Entry_IO.Put (Inventory_File, The_Item.Entry_Number); - Text_IO.Put (Inventory_File, Spacer); - Item_IO.Put (Inventory_File, The_Item.Item_Number); - Text_IO.Put (Inventory_File, Spacer); - Bar_Code_IO.Put(File => Inventory_File, - Item => The_Item.Bar_Code, - Width => 13, - Base => 2); - Text_IO.New_Line(Inventory_File); - end Update_Inventory; - - - begin - - -- This code section simulates a receiving department maintaining a - -- data file containing information on items that have been ordered - -- and received. - -- - -- As new orders are received, the file is opened in Append_File - -- mode. - -- Data is taken from the inventory list and entered into the file, - -- in specific format. - -- Enter the order into the inventory file. This is item 1 in - -- the inventory list. - -- The data entry process can be repeated numerous times as required. - - Entry_IO.Put (Inventory_File, - Inventory_List(Daily_Order).Entry_Number); - Item_IO.Put (Inventory_File, - Inventory_List(Daily_Order).Item_Number); - Bar_Code_IO.Put (File => Inventory_File, - Item => Inventory_List(Daily_Order).Bar_Code); - Text_IO.New_Line (Inventory_File); - - Text_IO.Close (Inventory_File); - - - Entry_IO.Default_Width := Entry_Field_Width; -- Modify the default - -- width of Entry_IO. - Item_IO.Default_Base := Item_Base; -- Modify the default - -- number base of - -- Item_IO - Text_IO.Open (Inventory_File, - Text_IO.Append_File, -- Open in Append mode. - Inventory_Filename); - -- Enter items - while (Items_Inventoried < Items_To_Inventory) loop -- 2-4 into the - Items_Inventoried := Items_Inventoried + 1; -- inventory file. - Update_Inventory (The_Item => Inventory_List (Items_Inventoried)); - end loop; - - Test_Verification_Block: -- Read and check - declare -- all the data - TC_Entry : Natural; -- values that - TC_Item : Integer; -- have been - TC_Bar_Code : Bar_Code_Type; -- entered in the - TC_Item_Count : Natural := 0; -- data file. - begin - - Reset1: - begin - Text_IO.Reset (Inventory_File, Text_IO.In_File); -- Reset for - -- reading. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to mode In_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - while not Text_IO.End_Of_File (Inventory_File) loop - Entry_IO.Get (Inventory_File, TC_Entry); - Item_IO.Get (Inventory_File, TC_Item); - Bar_Code_IO.Get (Inventory_File, TC_Bar_Code); - Text_IO.Skip_Line (Inventory_File); - TC_Item_Count := TC_Item_Count + 1; - - if (TC_Item /= Inventory_List(TC_Entry).Item_Number) or - (TC_Bar_Code /= Inventory_List(TC_Entry).Bar_Code) then - Report.Failed ("Error in integer data read from file"); - end if; - end loop; - - if (TC_Item_Count /= Max_Entries_Per_Order) then - Report.Failed ("Incorrect number of records read from file"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Text_IO.Integer_IO processing"); - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open(Inventory_File) then - Text_IO.Delete (Inventory_File); - else - Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename); - Text_IO.Delete (Inventory_File); - end if; - - exception - - when others => - Report.Failed ( "Delete not properly implemented for Text_IO" ); - - end Final_Block; - - Report.Result; - -exception - - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA007; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a deleted file mode 100644 index c21d07ea9ac..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a +++ /dev/null @@ -1,271 +0,0 @@ --- CXAA008.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 capabilities provided in instantiations of the --- Ada.Text_IO.Fixed_IO package operate correctly when the mode of --- the file is Append_File. Check that Fixed_IO procedures Put and Get --- properly transfer fixed point data to/from data files that are in --- Append_File mode. Check that the formatting parameters available in --- the package can be used and modified successfully in the appending and --- retrieval of data. --- --- TEST DESCRIPTION: --- This test simulates order processing, with data values being written --- to a file, in a specific format, using Fixed_IO. Validation is done --- on this process by reading the data values from the file, and --- comparing them for equality with the values originally written to --- the file. --- --- This test verifies issues of create in Append_File mode, appending to --- a file previously appended to, resetting to Append_File mode, --- resetting from Append_File mode to In_File mode, as well as a --- variety of Text_IO and Fixed_IO predefined subprograms. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA008 is - use Ada; - - Inventory_File : Text_IO.File_Type; - Inventory_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA008" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA008", "Check that the capabilities of " & - "Text_IO.Fixed_IO operate correctly for files " & - "with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Inventory_File, - Mode => Text_IO.Append_File, - Name => Inventory_Filename); - - exception - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create with Append_File for Text_IO" ); - raise Incomplete; - end Test_For_Text_IO_Support; - - Operational_Test_Block: - declare - - Daily_Orders_Received : constant Natural := 4; - - type Item_Type is delta 0.1 range 0.0 .. 5000.0; - type Cost_Type is delta 0.01 range 0.0 .. 10_000.0; - type Profit_Type is delta 0.01 range -100.0 .. 1000.0; - - type Product_Type is record - Item_Number : Item_Type := 0.0; - Unit_Cost : Cost_Type := 0.00; - Percent_Markup : Profit_Type := 0.00; - end record; - - type Inventory_Type is - array (1 .. Daily_Orders_Received) of Product_Type; - - Daily_Inventory : Inventory_Type := (( 1.0, 1.75, 50.00), - ( 155.0, 20.00, -5.50), - (3343.5, 2.50, 126.50), - (4986.0, 180.00, 31.75)); - - package Item_IO is new Text_IO.Fixed_IO (Item_Type); - package Cost_IO is new Text_IO.Fixed_IO (Cost_Type); - package Markup_IO is new Text_IO.Fixed_IO (Profit_Type); - - - function TC_Mode_Selection (Selector : Integer) - return Text_IO.File_Mode is - begin - case Selector is - when 1 => return Text_IO.In_File; - when 2 => return Text_IO.Out_File; - when others => return Text_IO.Append_File; - end case; - end TC_Mode_Selection; - - - -- The following function simulates the addition of inventory item - -- information into a data file. Boolean status of True is returned - -- if all of the data entry was successful, False otherwise. - - function Update_Inventory (The_List : Inventory_Type) - return Boolean is - begin - for I in 1 .. Daily_Orders_Received loop - Item_IO.Put (Inventory_File, The_List(I).Item_Number); - Cost_IO.Put (Inventory_File, The_List(I).Unit_Cost, 10, 4, 0); - Markup_IO.Put(File => Inventory_File, - Item => The_List(I).Percent_Markup, - Fore => 6, - Aft => 3, - Exp => 2); - Text_IO.New_Line (Inventory_File); - end loop; - return (True); -- Return a Status value. - exception - when others => return False; - end Update_Inventory; - - - begin - - -- This code section simulates a receiving department maintaining a - -- data file containing information on items that have been ordered - -- and received. - - -- Whenever items are received, the file is reset to Append_File - -- mode. Data is taken from an inventory list and entered into the - -- file, in specific format. - - Reset1: - begin -- Reset to - Text_IO.Reset (Inventory_File, -- Append mode. - TC_Mode_Selection (Report.Ident_Int(3))); - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - end Reset1; - - -- Enter data. - if not Update_Inventory (The_List => Daily_Inventory) then - Report.Failed ("Exception occurred during inventory update"); - raise Incomplete; - end if; - - Test_Verification_Block: - declare - TC_Item : Item_Type; - TC_Cost : Cost_Type; - TC_Markup : Profit_Type; - TC_Item_Count : Natural := 0; - begin - - Reset2: - begin - Text_IO.Reset (Inventory_File, Text_IO.In_File); -- Reset for - -- reading. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset2; - - while not Text_IO.End_Of_File (Inventory_File) loop - Item_IO.Get (Inventory_File, TC_Item); - Cost_IO.Get (Inventory_File, TC_Cost); - Markup_IO.Get (File => Inventory_File, - Item => TC_Markup, - Width => 0); - Text_IO.Skip_Line (Inventory_File); - TC_Item_Count := TC_Item_Count + 1; - - -- Verify all of the data fields read from the file. Compare - -- with the values that were originally entered into the file. - - if (TC_Item /= Daily_Inventory(TC_Item_Count).Item_Number) then - Report.Failed ("Error in Item_Number read from file"); - end if; - if (TC_Cost /= Daily_Inventory(TC_Item_Count).Unit_Cost) then - Report.Failed ("Error in Unit_Cost read from file"); - end if; - if not (TC_Markup = - Daily_Inventory(TC_Item_Count).Percent_Markup) then - Report.Failed ("Error in Percent_Markup read from file"); - end if; - - end loop; - - if (TC_Item_Count /= Daily_Orders_Received) then - Report.Failed ("Incorrect number of records read from file"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Text_IO.Fixed_IO processing"); - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open (Inventory_File) then - Text_IO.Delete (Inventory_File); - else - Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename); - Text_IO.Delete (Inventory_File); - end if; - - exception - - when others => - Report.Failed ( "Delete not properly implemented for Text_IO" ); - - end Final_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA008; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a deleted file mode 100644 index d478060808a..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a +++ /dev/null @@ -1,290 +0,0 @@ --- CXAA009.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 capabilities provided in instantiations of the --- Ada.Text_IO.Float_IO package operate correctly when the mode of --- the file is Append_File. Check that Float_IO procedures Put and Get --- properly transfer floating point data to/from data files that are in --- Append_File mode. Check that the formatting parameters available in --- the package can be used and modified successfully in the appending and --- retrieval of data. --- --- TEST DESCRIPTION: --- This test is designed to simulate an environment where a data file --- that holds floating point information is created, written to, and --- closed. In the future, the file can be reopened in Append_File mode, --- additional data can be appended to it, and then closed. This process --- of Open/Append/Close can be repeated as necessary. All data written --- to the file is verified for accuracy when retrieved from the file. --- --- This test verifies issues of create in Append_File mode, appending to --- a file previously appended to, opening in Append_File mode, resetting --- from Append_File mode to In_File mode, as well as a variety of Text_IO --- and Float_IO predefined subprograms. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA009 is - - use Ada; - Loan_File : Text_IO.File_Type; - Loan_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA009" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA009", "Check that the capabilities of " & - "Text_IO.Float_IO operate correctly for files " & - "with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Loan_File, -- Create in - Mode => Text_IO.Out_File, -- Out_File mode. - Name => Loan_Filename); - - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - Operational_Test_Block: - declare - Total_Loans_Outstanding : constant Natural := 3; - Transaction_Status : Boolean := False; - - type Account_Balance_Type is digits 6 range 0.0 .. 1.0E6; - type Loan_Balance_Type is digits 6; - type Interest_Rate_Type is digits 4 range 0.0 .. 30.00; - - type Loan_Info_Type is record - Account_Balance : Account_Balance_Type := 0.00; - Loan_Balance : Loan_Balance_Type := 0.00; - Loan_Interest_Rate : Interest_Rate_Type := 0.00; - end record; - - Home_Refinance_Loan : Loan_Info_Type := - (14_500.00, 135_000.00, 6.875); - Line_Of_Credit_Loan : Loan_Info_Type := - ( 5490.00, -3000.00, 13.75); - Small_Business_Loan : Loan_Info_Type := - (Account_Balance => 45_000.00, - Loan_Balance => 10_500.00, - Loan_Interest_Rate => 5.875); - - package Acct_IO is new Text_IO.Float_IO (Account_Balance_Type); - package Loan_IO is new Text_IO.Float_IO (Loan_Balance_Type); - package Rate_IO is new Text_IO.Float_IO (Interest_Rate_Type); - - - -- The following procedure performs the addition of loan information - -- into a data file. Boolean status of True is returned if all of - -- the data entry was successful, False otherwise. - -- This demonstrates use of Float_IO using a variety of data formats. - - procedure Update_Loan_Info (The_File : in out Text_IO.File_Type; - The_Loan : in Loan_Info_Type; - Status : out Boolean ) is - begin - Acct_IO.Put (The_File, The_Loan.Account_Balance); - Loan_IO.Put (The_File, The_Loan.Loan_Balance, 15, 2, 0); - Rate_IO.Put (File => The_File, - Item => The_Loan.Loan_Interest_Rate, - Fore => 6, - Aft => 3, - Exp => 0); - Text_IO.New_Line (The_File); - Status := True; - exception - when others => Status := False; - end Update_Loan_Info; - - - begin - - -- This code section simulates a bank maintaining a data file - -- containing information on loans that have been made. - -- The scenario: - -- The loan file was created in Out_File mode. - -- Some number of data records are added. - -- The file is closed. - -- The file is subsequently reopened in Append_File mode. - -- Data is appended to the file. - -- The file is closed. - -- Repeat the Open/Append/Close process as required. - -- Verify data in the file. - -- etc. - - Update_Loan_Info(Loan_File, Home_Refinance_Loan, Transaction_Status); - - if not Transaction_Status then - Report.Failed ("Failure in update of first loan data"); - end if; - - Text_IO.Close (Loan_File); - - -- When subsequent data items are to be added to the file, the file - -- is opened in Append_File mode. - - Text_IO.Open (Loan_File, -- Open with - Text_IO.Append_File, -- Append mode. - Loan_Filename); - - Update_Loan_Info(Loan_File, Line_Of_Credit_Loan, Transaction_Status); - - if not Transaction_Status then - Report.Failed("Failure in update of first loan data"); - end if; - - Text_IO.Close(Loan_File); - - -- To add additional data to the file, the file - -- is again opened in Append_File mode (appending to a file - -- previously appended to). - - Text_IO.Open (Loan_File, -- Open with - Text_IO.Append_File, -- Append mode. - Loan_Filename); - - Update_Loan_Info(Loan_File, Small_Business_Loan, Transaction_Status); - - if not Transaction_Status then - Report.Failed("Failure in update of first loan data"); - end if; - - Test_Verification_Block: - declare - type Ledger_Type is - array (1 .. Total_Loans_Outstanding) of Loan_Info_Type; - TC_Bank_Ledger : Ledger_Type; - TC_Item_Count : Natural := 0; - begin - - Reset1: - begin - Text_IO.Reset (Loan_File, Text_IO.In_File); -- Reset for - -- reading. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - while not Text_IO.End_Of_File (Loan_File) loop - TC_Item_Count := TC_Item_Count + 1; - Acct_IO.Get (Loan_File, - TC_Bank_Ledger(TC_Item_Count).Account_Balance); - Loan_IO.Get (Loan_File, - TC_Bank_Ledger(TC_Item_Count).Loan_Balance, - 0); - Rate_IO.Get(File => Loan_File, - Item => - TC_Bank_Ledger(TC_Item_Count).Loan_Interest_Rate, - Width => 0); - Text_IO.Skip_Line(Loan_File); - - end loop; - - -- Verify all of the data fields read from the file. Compare - -- with the values that were originally entered into the file. - - if (TC_Bank_Ledger(1) /= Home_Refinance_Loan) or - (TC_Bank_Ledger(2) /= Line_Of_Credit_Loan) or - (TC_Bank_Ledger(3) /= Small_Business_Loan) then - Report.Failed("Error in data read from file"); - end if; - - if (TC_Item_Count /= Total_Loans_Outstanding) then - Report.Failed ("Incorrect number of records read from file"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Text_IO.Float_IO processing"); - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open(Loan_File) then - Text_IO.Delete(Loan_File); - else - Text_IO.Open(Loan_File, Text_IO.In_File, Loan_Filename); - Text_IO.Delete(Loan_File); - end if; - - exception - - when Text_IO.Use_Error => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - - end Final_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA009; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a deleted file mode 100644 index 5678aee6bcf..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a +++ /dev/null @@ -1,335 +0,0 @@ --- CXAA010.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 operations defined in package Ada.Text_IO.Decimal_IO --- are available, and that they function correctly when used for the --- input/output of Decimal types. --- --- TEST DESCRIPTION: --- This test demonstrates the Put and Get procedures found in the --- generic package Ada.Text_IO.Decimal_IO. Both Put and Get are --- overloaded to allow placement or extraction of decimal values --- to/from a text file or a string. This test demonstrates both forms --- of each subprogram. --- The test defines an array of records containing decimal value --- and string component fields. All component values are placed in a --- Text_IO file, with the decimal values being placed there using the --- version of Put defined for files, and using user-specified formatting --- parameters. The data is later extracted from the file, with the --- decimal values being removed using the version of Get defined for --- files. Decimal values are then written to strings, using the --- appropriate Put procedure. Finally, extraction of the decimal data --- from the strings completes the evaluation of the Decimal_IO package --- subprograms. --- The reconstructed data is verified at the end of the test against the --- data originally written to the file. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations capable of supporting external --- Text_IO files and Decimal Fixed Point Types --- --- All implementations must attempt to compile this test. --- --- For implementations validating against Information Systems Annex (F): --- this test must execute and report PASSED. --- --- For implementations not validating against Annex F: --- this test may report compile time errors at one or more points --- indicated by "-- ANX-F RQMT", in which case it may be graded as inapplicable. --- Otherwise, the test must execute and report PASSED. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 20 Feb 95 SAIC Modified test to allow for Use_Error/Name_Error --- generation by an implementation not supporting --- Text_IO operations. --- 14 Nov 95 SAIC Corrected string indexing for ACVC 2.0.1. --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations --- 16 FEB 98 EDS Modified documentation. ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA010 is - use Ada.Text_IO; - Tax_Roll : Ada.Text_IO.File_Type; - Tax_Roll_Name : constant String := - Report.Legal_File_Name ( Nam => "CXAA010" ); - Incomplete : exception; -begin - - Report.Test ("CXAA010", "Check that the operations defined in package " & - "Ada.Text_IO.Decimal_IO are available, and " & - "that they function correctly when used for " & - "the input/output of Decimal types"); - - Test_for_Decimal_IO_Support: - begin - - -- An implementation that does not support Text_IO creation or naming - -- of external files in a particular environment will raise Use_Error - -- or Name_Error on a call to Text_IO Create. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. Either of these exceptions will be - -- handled to produce a Not_Applicable result. - - Ada.Text_IO.Create (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name); - - exception - - when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - - end Test_for_Decimal_IO_Support; - - Taxation: - declare - - ID_Length : constant := 5; - Price_String_Length : constant := 5; - Value_String_Length : constant := 6; - Total_String_Length : constant := 20; - Spacer : constant String := " "; -- Two blanks. - - type Price_Type is delta 0.1 digits 4; -- ANX-F RQMT - type Value_Type is delta 0.01 digits 5; -- ANX-F RQMT - - type Property_Type is - record - Parcel_ID : String (1..ID_Length); - Purchase_Price : Price_Type; - Assessed_Value : Value_Type; - end record; - - type City_Block_Type is array (1..4) of Property_Type; - - subtype Tax_Bill_Type is string (1..Total_String_Length); - type Tax_Bill_Array_Type is array (1..4) of Tax_Bill_Type; - - Neighborhood : City_Block_Type := - (("X9254", 123.0, 135.00), ("X3569", 345.0, 140.50), - ("X3434", 234.0, 179.50), ("X8838", 456.0, 158.00)); - - Neighborhood_Taxes : Tax_Bill_Array_Type; - - package Price_IO is new Ada.Text_IO.Decimal_IO (Price_Type); - package Value_IO is new Ada.Text_IO.Decimal_IO (Value_Type); - - begin -- Taxation - - Assessors_Office: - begin - - for Parcel in City_Block_Type'Range loop - -- Note: All data in the file will be separated with a - -- two-character blank spacer. - Ada.Text_IO.Put(Tax_Roll, Neighborhood(Parcel).Parcel_ID); - Ada.Text_IO.Put(Tax_Roll, Spacer); - - -- Use Decimal_IO.Put with non-default format parameters to - -- place decimal data into file. - Price_IO.Put (Tax_Roll, Neighborhood(Parcel).Purchase_Price, - Fore => 3, Aft =>1, Exp => 0); - Ada.Text_IO.Put(Tax_Roll, Spacer); - - Value_IO.Put (Tax_Roll, Neighborhood(Parcel).Assessed_Value, - Fore => 3, Aft =>2, Exp => 0); - Ada.Text_IO.New_Line(Tax_Roll); - end loop; - - Ada.Text_IO.Close (Tax_Roll); - - exception - when others => - Report.Failed ("Exception raised in Assessor's Office"); - end Assessors_Office; - - - Twice_A_Year: - declare - - procedure Collect_Tax(Index : in Integer; - Tax_Array : in out Tax_Bill_Array_Type) is - ID : String (1..ID_Length); - Price : Price_Type := 0.0; - Value : Value_Type := 0.00; - Price_String : String (1..Price_String_Length); - Value_String : String (1..Value_String_Length); - begin - - -- Extract information from the Text_IO file; one string, two - -- decimal values. - -- Note that the Spacers that were put in the file above are - -- not individually read here, due to the fact that each call - -- to Decimal_IO.Get below uses a zero in the Width field, - -- which allows each Get procedure to skip these leading blanks - -- prior to extracting the numeric value. - - Ada.Text_IO.Get (Tax_Roll, ID); - - -- A zero value of Width is provided, so the following - -- two calls to Decimal_IO.Get will skip the leading blanks, - -- (from the Spacer variable above), then read the numeric - -- literals. - - Price_IO.Get (Tax_Roll, Price, 0); - Value_IO.Get (Tax_Roll, Value, 0); - Ada.Text_IO.Skip_Line (Tax_Roll); - - -- Convert the values read from the file into string format, - -- using user-specified format parameters. - -- Format of the Price_String should be "nnn.n" - -- Format of the Value_String should be "nnn.nn" - - Price_IO.Put (To => Price_String, - Item => Price, - Aft => 1); - Value_IO.Put (Value_String, Value, 2); - - -- Construct a string of length 20 that contains the Parcel_ID, - -- the Purchase_Price, and the Assessed_Value, separated by - -- two-character blank data spacers. Store this string - -- into the string array out parameter. - -- Format of each Tax_Array element should be - -- "Xnnnn nnn.n nnn.nn" (with an 'n' signifying a digit). - - Tax_Array(Index) := ID & Spacer & - Price_String & Spacer & - Value_String; - exception - when Data_Error => - Report.Failed("Data Error raised during the extraction " & - "of decimal data from the file"); - when others => - Report.Failed("Exception in Collect_Tax procedure"); - end Collect_Tax; - - - begin -- Twice_A_Year - - Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.In_File, Tax_Roll_Name); - - -- Determine property tax bills for the entire neighborhood from - -- the information that is stored in the file. Store information - -- in the Neighborhood_Taxes string array. - - for Parcel in City_Block_Type'Range loop - Collect_Tax (Parcel, Neighborhood_Taxes); - end loop; - - exception - when others => - Report.Failed ("Exception in Twice_A_Year Block"); - end Twice_A_Year; - - -- Use Decimal_IO Get procedure to extract information from a string. - -- Verify data against original values. - Validation_Block: - declare - TC_ID : String (1..ID_Length); -- 1..5 - TC_Price : Price_Type; - TC_Value : Value_Type; - Length : Positive; - Front, - Rear : Integer := 0; - begin - - for Parcel in City_Block_Type'Range loop - -- Extract values from the strings of the string array. - -- Each element of the string array is 20 characters long; the - -- first five characters are the Parcel_ID, two blank characters - -- separate data, the next five characters contain the Price - -- decimal value, two blank characters separate data, the last - -- six characters contain the Value decimal value. - -- Extract each of these components in turn. - - Front := 1; -- 1 - Rear := ID_Length; -- 5 - TC_ID := Neighborhood_Taxes(Parcel)(Front..Rear); - - -- Extract the decimal value from the next slice of the string. - Front := Rear + 3; -- 8 - Rear := Front + Price_String_Length - 1; -- 12 - Price_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear), - Item => TC_Price, - Last => Length); - - -- Extract next decimal value from slice of string, based on - -- length of preceding strings read from string array element. - Front := Rear + 3; -- 15 - Rear := Total_String_Length; -- 20 - Value_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear), - Item => TC_Value, - Last => Length); - - if TC_ID /= Neighborhood(Parcel).Parcel_ID or - TC_Price /= Neighborhood(Parcel).Purchase_Price or - TC_Value /= Neighborhood(Parcel).Assessed_Value - then - Report.Failed ("Incorrect data validation"); - end if; - - end loop; - - exception - when others => Report.Failed ("Exception in Validation Block"); - end Validation_Block; - - -- Check that the Text_IO file is open, then delete. - - if not Ada.Text_IO.Is_Open (Tax_Roll) then - Report.Failed ("File not left open after processing"); - Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name); - end if; - - Ada.Text_IO.Delete (Tax_Roll); - - exception - when others => - Report.Failed ("Exception in Taxation block"); - -- Check that the Text_IO file is open, then delete. - if not Ada.Text_IO.Is_Open (Tax_Roll) then - Ada.Text_IO.Open (Tax_Roll, - Ada.Text_IO.Out_File, - Tax_Roll_Name); - end if; - Ada.Text_IO.Delete (Tax_Roll); - end Taxation; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA010; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a deleted file mode 100644 index 8cc136d35ab..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a +++ /dev/null @@ -1,266 +0,0 @@ --- CXAA011.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 operations of Text_IO.Enumeration_IO perform correctly --- on files of Append_File mode, for instantiations using --- enumeration types. Check that Enumeration_IO procedures Put and Get --- properly transfer enumeration data to/from data files. --- Check that the formatting parameters available in the package can --- be used and modified successfully in the storage and retrieval of data. --- --- TEST DESCRIPTION: --- This test is designed to simulate an environment where a data file --- that holds enumeration type information is reset from it current mode --- to allow the appending of data to the end of the This process --- of Reset/Write can be repeated as necessary. All data written --- to the file is verified for accuracy when retrieved from the file. --- --- This test verifies issues of resetting a file created in Out_File mode --- to Append_File mode, resetting from Append_File mode to In_File mode, --- as well as a variety of Text_IO and Enumeration_IO predefined --- subprograms. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA011 is - use Ada; - - Status_Log : Text_IO.File_Type; - Status_Log_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA011" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA011", "Check that the operations of " & - "Text_IO.Enumeration_IO operate correctly for " & - "files with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- An implementation that does not support Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Text_IO operations. This block statement encloses a call to - -- Create, which should raise the exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Text_IO.Create (File => Status_Log, - Mode => Text_IO.Out_File, - Name => Status_Log_Filename); - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - - Operational_Test_Block: - declare - - type Days_In_Week is (Monday, Tuesday, Wednesday, Thursday, Friday, - Saturday, Sunday); - type Hours_In_Day is (A0000, A0600, P1200, P0600); -- Six hour - -- blocks. - type Status_Type is (Operational, Off_Line); - - type Status_Record_Type is record - Day : Days_In_Week; - Hour : Hours_In_Day; - Status : Status_Type; - end record; - - Morning_Reading : Status_Record_Type := - (Wednesday, A0600, Operational); - Evening_Reading : Status_Record_Type := - (Saturday, P0600, Off_Line); - - package Day_IO is new Text_IO.Enumeration_IO (Days_In_Week); - package Hours_IO is new Text_IO.Enumeration_IO (Hours_In_Day); - package Status_IO is new Text_IO.Enumeration_IO (Status_Type); - - - -- The following function simulates the hourly recording of equipment - -- status. - - function Record_Status (Reading : Status_Record_Type) - return Boolean is - use Text_IO; -- To provide visibility to type Type_Set and - -- enumeration literal Upper_Case. - begin - Day_IO.Put (File => Status_Log, - Item => Reading.Day, - Set => Type_Set'(Upper_Case)); - Hours_IO.Put (Status_Log, Reading.Hour, 7); - Status_IO.Put (Status_Log, Reading.Status, - Width => 8, Set => Lower_Case); - Text_IO.New_Line (Status_Log); - return (True); - exception - when others => return False; - end Record_Status; - - begin - - -- The usage scenario intended is as follows: - -- File is created. - -- Unrelated/unknown file processing occurs. - -- On six hour intervals, file is reset to Append_File mode. - -- Data is appended to file. - -- Unrelated/unknown file processing resumes. - -- Reset/Append process is repeated. - - Reset1: - begin - Text_IO.Reset (Status_Log, -- Reset to - Text_IO.Append_File); -- Append mode. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - Day_IO.Default_Width := Days_In_Week'Width + 5; -- Default values - -- are modifiable. - - if not Record_Status (Morning_Reading) then -- Enter data. - Report.Failed ("Exception occurred during data file update"); - end if; - - Reset2: - begin - Text_IO.Reset (Status_Log, -- Reset to - Text_IO.Append_File); -- Append mode. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO" ); - raise Incomplete; - end Reset2; - - if not Record_Status (Evening_Reading) then -- Enter data. - Report.Failed ("Exception occurred during data file update"); - end if; - - Test_Verification_Block: - declare - TC_Reading1 : Status_Record_Type; - TC_Reading2 : Status_Record_Type; - begin - - Reset3: - begin - Text_IO.Reset (Status_Log, Text_IO.In_File); -- Reset for - -- reading. - exception - when Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset3; - - Day_IO.Get (Status_Log, TC_Reading1.Day); -- Read data from - Hours_IO.Get (Status_Log, TC_Reading1.Hour); -- first record. - Status_IO.Get (Status_Log, TC_Reading1.Status); - Text_IO.Skip_Line (Status_Log); - - -- Verify the data read from the file. Compare with the - -- record that was originally entered into the file. - - if (TC_Reading1 /= Morning_Reading) then - Report.Failed ("Data error on reading first record"); - end if; - - Day_IO.Get (Status_Log, TC_Reading2.Day); -- Read data from - Hours_IO.Get (Status_Log, TC_Reading2.Hour); -- second record. - Status_IO.Get (Status_Log, TC_Reading2.Status); - Text_IO.Skip_Line (Status_Log); - - -- Verify all of the data fields read from the file. Compare - -- with the values that were originally entered into the file. - - if (TC_Reading2.Day /= Evening_Reading.Day) or - (TC_Reading2.Hour /= Evening_Reading.Hour) or - (TC_Reading2.Status /= Evening_Reading.Status) then - Report.Failed ("Data error on reading second record"); - end if; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Error raised during data verification"); - end Test_Verification_Block; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Text_IO.Enumeration_IO processing"); - end Operational_Test_Block; - - Final_Block: - begin - -- Delete the external file. - if Text_IO.Is_Open (Status_Log) then - Text_IO.Delete (Status_Log); - else - Text_IO.Open (Status_Log, Text_IO.Out_File, Status_Log_Filename); - Text_IO.Delete (Status_Log); - end if; - exception - when Text_IO.Use_Error => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - - end Final_Block; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA011; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a deleted file mode 100644 index 07523b44170..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a +++ /dev/null @@ -1,167 +0,0 @@ --- CXAA012.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 exception Mode_Error is raised when an attempt is made --- to read from (perform a Get_Line) or use the predefined End_Of_File --- function on a text file with mode Append_File. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential for the --- incorrect usage of predefined text processing subprograms, resulting --- from their use with files of the wrong Mode. This results in the --- raising of Mode_Error exceptions, which is handled within blocks --- embedded in the test. --- A count is kept to ensure that each anticipated exception is in fact --- raised and handled properly. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 27 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA012 is - use Ada; - Text_File : Text_IO.File_Type; - Text_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA012" ); - Incomplete : exception; -begin - - Report.Test ("CXAA012", "Check that the exception Mode_Error is " & - "raised when an attempt is made to read " & - "from (perform a Get_Line) or use the " & - "predefined End_Of_File function on a " & - "text file with mode Append_File"); - - Test_for_Text_IO_Support: - begin - - -- Use_Error or Name_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); - - exception - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - end Test_for_Text_IO_Support; - - -- The application writes some amount of data to the file. - - Text_IO.Put_Line (Text_File, "Data entered into the file"); - - Text_IO.Close (Text_File); - - Operational_Test_Block: - declare - TC_Number_Of_Forced_Mode_Errors : constant Natural := 2; - TC_Mode_Errors : Natural := 0; - begin - - Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename); - - Test_for_Reading: - declare - TC_Data : String (1..80); - TC_Length : Natural := 0; - begin - --- During the course of its processing, the application may become confused --- and erroneously attempt to read data from the file that is currently in --- Append_File mode (instead of the anticipated In_File mode). --- This would result in the raising of Mode_Error. - - Text_IO.Get_Line (Text_File, TC_Data, TC_Length); - Report.Failed ("Exception not raised by Get_Line"); - --- An exception handler present within the application handles the exception --- and processing can continue. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed ("Exception in Get_Line processing"); - end Test_for_Reading; - - - Test_for_End_Of_File: - declare - TC_End_Of_File : Boolean; - begin - --- Again, during the course of its processing, the application attempts to --- call the End_Of_File function for the file that is currently in --- Append_File mode (instead of the anticipated In_File mode). - - TC_End_Of_File := Text_IO.End_Of_File (Text_File); - Report.Failed ("Exception not raised by End_Of_File"); - --- Once again, an exception handler present within the application handles --- the exception and processing continues. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed("Exception in End_Of_File processing"); - end Test_for_End_Of_File; - - - if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then - Report.Failed ("Incorrect number of exceptions handled"); - end if; - - end Operational_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; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA012; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a deleted file mode 100644 index be658ca13e0..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a +++ /dev/null @@ -1,167 +0,0 @@ --- CXAA013.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 exception Mode_Error is raised when an attempt is made --- to skip a line or page using the predefined Skip_Line and Skip_Page --- procedures on a text file with mode Append_File. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential for the --- incorrect usage of predefined text processing subprograms, which --- results in the raising of a Mode_Error exception. --- A count is kept to ensure that each anticipated exception is in fact --- raised and handled properly. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 28 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA013 is - use Ada; - Text_File : Text_IO.File_Type; - Text_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA013" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA013", "Check that the exception Mode_Error is " & - "raised when an attempt is made to skip " & - "a line or page using the predefined " & - "Skip_Line and Skip_Page procedures on " & - "a text file with mode Append_File"); - - Test_for_Text_IO_Support: - begin - --- An application creates a text file with mode Append_File. --- Use_Error will be raised if Text_IO operations or external files are not --- supported. - - Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename); - - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Append_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - --- The application writes some amount of data to the file. - - Text_IO.Put_Line (Text_File, "Data entered into the file"); - - Operational_Test_Block: - declare - TC_Number_Of_Forced_Mode_Errors : constant Natural := 2; - TC_Mode_Errors : Natural := 0; - begin - - Test_for_Skip_Line: - declare - TC_Spacing : constant Text_IO.Count := 3; - begin - --- During the course of its processing, the application may attempt to --- invoke the Skip_Line procedure on a file that is currently in Append_File --- mode (instead of the anticipated In_File mode). This results in the --- raising of Mode_Error. - - Text_IO.Skip_Line (Text_File, TC_Spacing); - Report.Failed ("Exception not raised by Skip_Line"); - --- An exception handler present within the application handles the exception --- and processing can continue. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed("Exception in Skip_Line processing"); - end Test_for_Skip_Line; - - Test_for_Skip_Page: - begin - --- Again, during the course of its processing, the application incorrectly --- assumes that the file mode is In_File, this time attempting to call the --- Skip_Page procedure for the file (that is currently in Append_File mode). - - Text_IO.Skip_Page (Text_File); - Report.Failed ("Exception not raised by Skip_Page"); - --- Once again, an exception handler present within the application handles --- the exception and processing continues. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed("Exception in Skip_Page processing"); - end Test_for_Skip_Page; - - if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then - Report.Failed ("Incorrect number of exceptions handled"); - end if; - - end Operational_Test_Block; - - Deletion: - begin - -- 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 - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA013; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a deleted file mode 100644 index 0b74c616959..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a +++ /dev/null @@ -1,178 +0,0 @@ --- CXAA014.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 exception Mode_Error is raised when an attempt is made --- to check for the end of a line or page using the predefined functions --- End_Of_Line or End_Of_Page on a text file with mode Append_File. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential for the --- incorrect usage of predefined text processing subprograms, which --- results in the raising of a Mode_Error exception. --- A count is kept to ensure that each anticipated exception is in fact --- raised and handled properly. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 28 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA014 is - use Ada; - Text_File : Text_IO.File_Type; - Text_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA014" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA014", "Check that the exception Mode_Error is " & - "raised when an attempt is made to check " & - "for the end of a line or page using the " & - "predefined functions End_Of_Line or " & - "End_Of_Page on a text file with mode " & - "Append_File"); - - Test_for_Text_IO_Support: - 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); - - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - --- The application writes some amount of data to the file. - - for I in 1 .. 10 loop - Text_IO.Put_Line (Text_File, "Data entered into the file"); - end loop; - - Text_IO.Close (Text_File); - - Operational_Test_Block: - declare - TC_Number_Of_Forced_Mode_Errors : constant Natural := 2; - TC_Mode_Errors : Natural := 0; - begin - - Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename); - - Test_for_End_Of_Line: - declare - TC_End_Of_Line : Boolean; - begin - --- During the course of its processing, the application may attempt to --- invoke the End_Of_Line function on a file that is currently in Append_File --- mode (instead of the anticipated In_File mode). This results in the --- raising of Mode_Error. - - TC_End_Of_Line := Text_IO.End_Of_Line (Text_File); - Report.Failed ("Exception not raised by End_Of_Line"); - --- An exception handler present within the application handles the exception --- and processing can continue. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed("Exception in End_Of_Line processing"); - end Test_for_End_Of_Line; - - - Test_for_End_Of_Page: - declare - TC_End_Of_Page : Boolean; - begin - --- Again, during the course of its processing, the application incorrectly --- assumes that the file mode is In_File, this time attempting to call the --- End_Of_Page function for the file (that is currently in Append_File mode). - - TC_End_Of_Page := Text_IO.End_Of_Page (Text_File); - Report.Failed ("Exception not raised by End_Of_Page"); - --- Once again, an exception handler present within the application handles --- the exception and processing continues. - - exception - when Text_IO.Mode_Error => - TC_Mode_Errors := TC_Mode_Errors + 1; - when others => - Report.Failed("Exception in End_Of_Page processing"); - end Test_for_End_Of_Page; - - - if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then - Report.Failed ("Incorrect number of exceptions handled"); - end if; - - end Operational_Test_Block; - - Deletion: - begin - -- 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 - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA014; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a deleted file mode 100644 index 919ef05ca7e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a +++ /dev/null @@ -1,227 +0,0 @@ --- CXAA015.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 exception Status_Error is raised when an attempt is --- made to create or open a file in Append_File mode when the file is --- already open. --- Check that the exception Name_Error is raised by procedure Open when --- attempting to open a file in Append_File mode when the name supplied --- as the filename does not correspond to an existing external file. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential for the --- inappropriate usage of text processing subprograms Create and Open, --- resulting in the raising of Status_Error and Name_Error exceptions. --- A count is kept to ensure that each anticipated exception is in fact --- raised and handled properly. --- --- APPLICABILITY CRITERIA: --- This test is applicable only to implementations that support text --- files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 28 Feb 97 PWB.CTA Allowed for non-support of some IO operations ---! - -with Ada.Text_IO; -with Report; - -procedure CXAA015 is - use Ada; - Text_File : Text_IO.File_Type; - Text_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAA015" ); - Incomplete : exception; - -begin - - Report.Test ("CXAA015", "Check that the appropriate exceptions " & - "are raised when procedures Create and " & - "Open are used to inappropriately operate " & - "on files of mode Append_File"); - - Test_for_Text_IO_Support: - begin - --- An application creates a text file with mode Append_File. --- Use_Error will be raised if Text_IO operations or external files are not --- supported. - - Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename); - exception - - when Text_IO.Use_Error | Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Append_File for Text_IO" ); - raise Incomplete; - - end Test_for_Text_IO_Support; - - --- The application writes some amount of data to the file. - - for I in 1 .. 5 loop - Text_IO.Put_Line (Text_File, "Data entered into the file"); - end loop; - - Operational_Test_Block: - declare - TC_Number_Of_Forced_Errors : constant Natural := 3; - TC_Errors : Natural := 0; - begin - - - Test_for_Create: - begin - --- During the course of its processing, the application may (erroneously) --- attempt to create the same file already in existence in Append_File mode. --- This results in the raising of Status_Error. - - Text_IO.Create (Text_File, - Text_IO.Append_File, - Text_Filename); - Report.Failed ("Exception not raised by Create"); - --- An exception handler present within the application handles the exception --- and processing can continue. - - exception - when Text_IO.Status_Error => - TC_Errors := TC_Errors + 1; - when others => - Report.Failed("Exception in Create processing"); - end Test_for_Create; - - - First_Test_For_Open: - begin - --- Again, during the course of its processing, the application incorrectly --- attempts to Open a file (in Append_File mode) that is already open. - - Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename); - Report.Failed ("Exception not raised by improper Open - 1"); - --- Once again, an exception handler present within the application handles --- the exception and processing continues. - - exception - when Text_IO.Status_Error => - TC_Errors := TC_Errors + 1; - --- At some point in its processing, the application closes the file that is --- currently open. - - Text_IO.Close (Text_File); - when others => - Report.Failed("Exception in Open processing - 1"); - end First_Test_For_Open; - - - Open_With_Wrong_Filename: - declare - TC_Wrong_Filename : constant String := - Report.Legal_File_Name(2); - begin - --- At this point, the application attempts to Open (in Append_File mode) the --- file used in previous processing, but it attempts this Open using a name --- string that does not correspond to any existing external file. --- First make sure the file doesn't exist. (If it did, then the check --- for open in append mode wouldn't work.) - - Verify_No_File: - begin - Text_IO.Open (Text_File, - Text_IO.In_File, - TC_Wrong_Filename); - exception - when Text_IO.Name_Error => - null; - when others => - Report.Failed ( "Unexpected exception on Open check" ); - end Verify_No_File; - - Delete_No_File: - begin - if Text_IO.Is_Open (Text_File) then - Text_IO.Delete (Text_File); - end if; - exception - when others => - Report.Failed ( "Unexpected exception - Delete check" ); - end Delete_No_File; - - Text_IO.Open (Text_File, - Text_IO.Append_File, - TC_Wrong_Filename); - Report.Failed ("Exception not raised by improper Open - 2"); - --- An exception handler for the Name_Error, present within the application, --- catches the exception and processing continues. - - exception - when Text_IO.Name_Error => - TC_Errors := TC_Errors + 1; - when others => - Report.Failed("Exception in Open processing - 2"); - end Open_With_Wrong_Filename; - - - if (TC_Errors /= TC_Number_Of_Forced_Errors) then - Report.Failed ("Incorrect number of exceptions handled"); - end if; - - end Operational_Test_Block; - - Deletion: - begin - -- 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 - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAA015; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a deleted file mode 100644 index 8ae69a12664..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a +++ /dev/null @@ -1,462 +0,0 @@ --- CXAA016.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 type File_Access is available in Ada.Text_IO, and that --- objects of this type designate File_Type objects. --- Check that function Set_Error will set the current default error file. --- Check that versions of Ada.Text_IO functions Standard_Input, --- Standard_Output, Standard_Error return File_Access values designating --- the standard system input, output, and error files. --- Check that versions of Ada.Text_IO functions Current_Input, --- Current_Output, Current_Error return File_Access values designating --- the current system input, output, and error files. --- --- TEST DESCRIPTION: --- This test tests the use of File_Access objects in referring --- to File_Type objects, as well as several new functions that return --- File_Access objects as results. --- Four user-defined files are created. These files will be set to --- function as current system input, output, and error files. --- Data will be read from and written to these files during the --- time at which they function as the current system files. --- An array of File_Access objects will be defined. It will be --- initialized using functions that return File_Access objects --- referencing the Standard and Current Input, Output, and Error files. --- This "saves" the initial system environment, which will be modified --- to use the user-defined files as the current default Input, Output, --- and Error files. At the end of the test, the data in this array --- will be used to restore the initial system environment. --- --- APPLICABILITY CRITERIA: --- This test is applicable to implementations capable of supporting --- external Text_IO files. --- --- --- CHANGE HISTORY: --- 25 May 95 SAIC Initial prerelease version. --- 22 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations. --- 18 Jan 99 RLB Repaired to allow Not_Applicable systems to --- fail delete. ---! - -with Ada.Text_IO; -package CXAA016_0 is - New_Input_File, - New_Output_File, - New_Error_File_1, - New_Error_File_2 : aliased Ada.Text_IO.File_Type; -end CXAA016_0; - - -with Report; -with Ada.Exceptions; -with Ada.Text_IO; use Ada.Text_IO; -with CXAA016_0; use CXAA016_0; - -procedure CXAA016 is - - Non_Applicable_System : exception; - No_Reset : exception; - Not_Applicable_System : Boolean := False; - - procedure Delete_File ( A_File : in out Ada.Text_IO.File_Type; - ID_Num : in Integer ) is - begin - if not Ada.Text_IO.Is_Open ( A_File ) then - Ada.Text_IO.Open ( A_File, - Ada.Text_IO.In_File, - Report.Legal_File_Name ( ID_Num ) ); - end if; - Ada.Text_IO.Delete ( A_File ); - exception - when Ada.Text_IO.Name_Error => - if Not_Applicable_System then - null; -- File probably wasn't created. - else - Report.Failed ( "Can't open file for Text_IO" ); - end if; - when Ada.Text_IO.Use_Error => - if Not_Applicable_System then - null; -- File probably wasn't created. - else - Report.Failed ( "Delete not properly implemented for Text_IO" ); - end if; - when others => - Report.Failed ( "Unexpected exception in Delete_File" ); - end Delete_File; - -begin - - Report.Test ("CXAA016", "Check that the type File_Access is available " & - "in Ada.Text_IO, and that objects of this " & - "type designate File_Type objects"); - Test_Block: - declare - - use Ada.Exceptions; - - type System_File_Array_Type is - array (Integer range <>) of File_Access; - - -- Fill the following array with the File_Access results of six - -- functions. - - Initial_Environment : System_File_Array_Type(1..6) := - ( Standard_Input, - Standard_Output, - Standard_Error, - Current_Input, - Current_Output, - Current_Error ); - - New_Input_Ptr : File_Access := New_Input_File'Access; - New_Output_Ptr : File_Access := New_Output_File'Access; - New_Error_Ptr : File_Access := New_Error_File_1'Access; - - Line : String(1..80); - Length : Natural := 0; - - Line_1 : constant String := "This is the first line in the Output file"; - Line_2 : constant String := "This is the next line in the Output file"; - Line_3 : constant String := "This is the first line in Error file 1"; - Line_4 : constant String := "This is the next line in Error file 1"; - Line_5 : constant String := "This is the first line in Error file 2"; - Line_6 : constant String := "This is the next line in Error file 2"; - - - - procedure New_File (The_File : in out File_Type; - Mode : in File_Mode; - Next : in Integer) is - begin - Create (The_File, Mode, Report.Legal_File_Name(Next)); - exception - -- The following two exceptions may be raised if a system is not - -- capable of supporting external Text_IO files. The handler will - -- raise a user-defined exception which will result in a - -- Not_Applicable result for the test. - when Use_Error | Name_Error => raise Non_Applicable_System; - end New_File; - - - - procedure Check_Initial_Environment (Env : System_File_Array_Type) is - begin - -- Check that the system has defined the following sources/ - -- destinations for input/output/error, and that the six functions - -- returning File_Access values are available. - if not (Env(1) = Standard_Input and - Env(2) = Standard_Output and - Env(3) = Standard_Error and - Env(4) = Current_Input and - Env(5) = Current_Output and - Env(6) = Current_Error) - then - Report.Failed("At the start of the test, the Standard and " & - "Current File_Access values associated with " & - "system Input, Output, and Error files do " & - "not correspond"); - end if; - end Check_Initial_Environment; - - - - procedure Load_Input_File (Input_Ptr : in File_Access) is - begin - -- Load data into the file that will function as the user-defined - -- system input file. - Put_Line(Input_Ptr.all, Line_1); - Put_Line(Input_Ptr.all, Line_2); - Put_Line(Input_Ptr.all, Line_3); - Put_Line(Input_Ptr.all, Line_4); - Put_Line(Input_Ptr.all, Line_5); - Put_Line(Input_Ptr.all, Line_6); - end Load_Input_File; - - - - procedure Restore_Initial_Environment - (Initial_Env : System_File_Array_Type) is - begin - -- Restore the Current Input, Output, and Error files to their - -- original states. - - Set_Input (Initial_Env(4).all); - Set_Output(Initial_Env(5).all); - Set_Error (Initial_Env(6).all); - - -- At this point, the user-defined files that were functioning as - -- the Current Input, Output, and Error files have been replaced in - -- that capacity by the state of the original environment. - - declare - - -- Capture the state of the current environment. - - Current_Env : System_File_Array_Type (1..6) := - (Standard_Input, Standard_Output, Standard_Error, - Current_Input, Current_Output, Current_Error); - begin - - -- Compare the current environment with that of the saved - -- initial environment. - - if Current_Env /= Initial_Env then - Report.Failed("Restored file environment was not the same " & - "as the initial file environment"); - end if; - end; - end Restore_Initial_Environment; - - - - procedure Verify_Files (O_File, E_File_1, E_File_2 : in File_Type) is - Str_1, Str_2, Str_3, Str_4, Str_5, Str_6 : String (1..80); - Len_1, Len_2, Len_3, Len_4, Len_5, Len_6 : Natural; - begin - - -- Get the lines that are contained in all the files, and verify - -- them against the expected results. - - Get_Line(O_File, Str_1, Len_1); -- The user defined output file - Get_Line(O_File, Str_2, Len_2); -- should contain two lines of data. - - if Str_1(1..Len_1) /= Line_1 or - Str_2(1..Len_2) /= Line_2 - then - Report.Failed("Incorrect results from Current_Output file"); - end if; - - Get_Line(E_File_1, Str_3, Len_3); -- The first error file received - Get_Line(E_File_1, Str_4, Len_4); -- two lines of data originally, - Get_Line(E_File_1, Str_5, Len_5); -- then had two additional lines - Get_Line(E_File_1, Str_6, Len_6); -- appended from the second error - -- file. - if Str_3(1..Len_3) /= Line_3 or - Str_4(1..Len_4) /= Line_4 or - Str_5(1..Len_5) /= Line_5 or - Str_6(1..Len_6) /= Line_6 - then - Report.Failed("Incorrect results from first Error file"); - end if; - - Get_Line(E_File_2, Str_5, Len_5); -- The second error file - Get_Line(E_File_2, Str_6, Len_6); -- received two lines of data. - - if Str_5(1..Len_5) /= Line_5 or - Str_6(1..Len_6) /= Line_6 - then - Report.Failed("Incorrect results from second Error file"); - end if; - - end Verify_Files; - - - - begin - - Check_Initial_Environment (Initial_Environment); - - -- Create user-defined text files that will be set to serve as current - -- system input, output, and error files. - - New_File (New_Input_File, Out_File, 1); -- Will be reset prior to use. - New_File (New_Output_File, Out_File, 2); - New_File (New_Error_File_1, Out_File, 3); - New_File (New_Error_File_2, Out_File, 4); - - -- Enter several lines of text into the new input file. This file will - -- be reset to mode In_File to function as the current system input file. - -- Note: File_Access value used as parameter to this procedure. - - Load_Input_File (New_Input_Ptr); - - -- Reset the New_Input_File to mode In_File, to allow it to act as the - -- current system input file. - - Reset1: - begin - Reset (New_Input_File, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO - 1" ); - raise No_Reset; - end Reset1; - - -- Establish new files that will function as the current system Input, - -- Output, and Error files. - - Set_Input (New_Input_File); - Set_Output(New_Output_Ptr.all); - Set_Error (New_Error_Ptr.all); - - -- Perform various file processing tasks, exercising specific new - -- Text_IO functionality. - -- - -- Read two lines from Current_Input and write them to Current_Output. - - for i in 1..2 loop - Get_Line(Current_Input, Line, Length); - Put_Line(Current_Output, Line(1..Length)); - end loop; - - -- Read two lines from Current_Input and write them to Current_Error. - - for i in 1..2 loop - Get_Line(Current_Input, Line, Length); - Put_Line(Current_Error, Line(1..Length)); - end loop; - - -- Reset the Current system error file. - - Set_Error (New_Error_File_2); - - -- Read two lines from Current_Input and write them to Current_Error. - - for i in 1..2 loop - Get_Line(Current_Input, Line, Length); - Put_Line(Current_Error, Line(1..Length)); - end loop; - - -- At this point in the processing, the new Output file, and each of - -- the two Error files, contain two lines of data. - -- Note that New_Error_File_1 has been replaced by New_Error_File_2 - -- as the current system error file, allowing New_Error_File_1 to be - -- reset (Mode_Error raised otherwise). - -- - -- Reset the first Error file to Append_File mode, and then set it to - -- function as the current system error file. - - Reset2: - begin - Reset (New_Error_File_1, Append_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Text_IO - 2" ); - raise No_Reset; - end Reset2; - - Set_Error (New_Error_File_1); - - -- Reset the second Error file to In_File mode, then set it to become - -- the current system input file. - - Reset3: - begin - Reset (New_Error_File_2, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO - 3" ); - raise No_Reset; - end Reset3; - - New_Error_Ptr := New_Error_File_2'Access; - Set_Input (New_Error_Ptr.all); - - -- Append all of the text lines (2) in the new current system input - -- file onto the current system error file. - - while not End_Of_File(Current_Input) loop - Get_Line(Current_Input, Line, Length); - Put_Line(Current_Error, Line(1..Length)); - end loop; - - -- Restore the original system file environment, based upon the values - -- stored at the start of this test. - -- Check that the original environment has been restored. - - Restore_Initial_Environment (Initial_Environment); - - -- Reset all three files to In_File_Mode prior to verification. - -- Note: If these three files had still been the designated Current - -- Input, Output, or Error files for the system, a Reset - -- operation at this point would raise Mode_Error. - -- However, at this point, the environment has been restored to - -- its original state, and these user-defined files are no longer - -- designated as current system files, allowing a Reset. - - Reset4: - begin - Reset(New_Error_File_1, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO - 4" ); - raise No_Reset; - end Reset4; - - Reset5: - begin - Reset(New_Error_File_2, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO - 5" ); - raise No_Reset; - end Reset5; - - Reset6: - begin - Reset(New_Output_File, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO - 6" ); - raise No_Reset; - end Reset6; - - -- Check that all the files contain the appropriate data. - - Verify_Files (New_Output_File, New_Error_File_1, New_Error_File_2); - - exception - when No_Reset => - null; - when Non_Applicable_System => - Report.Not_Applicable("System not capable of supporting external " & - "text files -- Name_Error/Use_Error raised " & - "during text file creation"); - Not_Applicable_System := True; - when The_Error : others => - Report.Failed ("The following exception was raised in the " & - "Test_Block: " & Exception_Name(The_Error)); - end Test_Block; - - Delete_Block: - begin - Delete_File ( New_Input_File, 1 ); - Delete_File ( New_Output_File, 2 ); - Delete_File ( New_Error_File_1, 3 ); - Delete_File ( New_Error_File_2, 4 ); - end Delete_Block; - - Report.Result; - -end CXAA016; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a deleted file mode 100644 index 17d0922cc24..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a +++ /dev/null @@ -1,400 +0,0 @@ --- CXAA017.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 function Look_Ahead sets parameter End_Of_Line --- to True if at the end of a line; otherwise check that it returns the --- next character from a file (without consuming it), while setting --- End_Of_Line to False. --- --- Check that Ada.Text_IO function Get_Immediate will return the next --- control or graphic character in parameter Item from the specified --- file. Check that the version of Ada.Text_IO function Get_Immediate --- with the Available parameter will, if a character is available in the --- specified file, return the character in parameter Item, and set --- parameter Available to True. --- --- TEST DESCRIPTION: --- This test exercises specific capabilities of two Text_IO subprograms, --- Look_Ahead and Get_Immediate. A file is prepared that contains a --- variety of graphic and control characters on several lines. --- In processing this file, a call to Look_Ahead is performed to ensure --- that characters are available, then individual characters are --- extracted from the current line using Get_Immediate. The characters --- returned from both subprogram calls are compared with the expected --- character result. Processing on each file line continues until --- Look_Ahead indicates that the end of the line is next. Separate --- verification is performed to ensure that all characters of each line --- are processed, and that the Available and End_Of_Line parameters --- of the subprograms are properly set in the appropriate instances. --- --- APPLICABILITY CRITERIA: --- This test is applicable to implementations capable of supporting --- external Text_IO files. --- --- --- CHANGE HISTORY: --- 30 May 95 SAIC Initial prerelease version. --- 01 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations. ---! - -with Ada.Text_IO; -package CXAA017_0 is - - User_Defined_Input_File : aliased Ada.Text_IO.File_Type; - -end CXAA017_0; - - -with CXAA017_0; use CXAA017_0; -with Ada.Characters.Latin_1; -with Ada.Exceptions; -with Ada.Text_IO; -with Report; - -procedure CXAA017 is - - use Ada.Characters.Latin_1; - use Ada.Exceptions; - use Ada.Text_IO; - - Non_Applicable_System : exception; - No_Reset : exception; - -begin - - Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms " & - "Look_Ahead and Get_Immediate are available " & - "and produce correct results"); - - Test_Block: - declare - - User_Input_Ptr : File_Access := User_Defined_Input_File'Access; - - UDLA_Char, -- Acronym UDLA => "User Defined Look Ahead" - UDGI_Char, -- Acronym UDGI => "User Defined Get Immediate" - TC_Char : Character := Ada.Characters.Latin_1.NUL; - - UDLA_End_Of_Line, - UDGI_Available : Boolean := False; - - Char_Pos : Natural; - - -- This string contains five ISO 646 Control characters and six ISO 646 - -- Graphic characters: - TC_String_1 : constant String := STX & - SI & - DC2 & - CAN & - US & - Space & - Ampersand & - Solidus & - 'A' & - LC_X & - DEL; - - -- This string contains two ISO 6429 Control and six ISO 6429 Graphic - -- characters: - TC_String_2 : constant String := IS4 & - SCI & - Yen_Sign & - Masculine_Ordinal_Indicator & - UC_I_Grave & - Multiplication_Sign & - LC_C_Cedilla & - LC_Icelandic_Thorn; - - TC_Number_Of_Strings : constant := 2; - - type String_Access_Type is access constant String; - type String_Ptr_Array_Type is - array (1..TC_Number_Of_Strings) of String_Access_Type; - - TC_String_Ptr_Array : String_Ptr_Array_Type := - (new String'(TC_String_1), - new String'(TC_String_2)); - - - - procedure Create_New_File (The_File : in out File_Type; - Mode : in File_Mode; - Next : in Integer) is - begin - Create (The_File, Mode, Report.Legal_File_Name(Next)); - exception - -- The following two exceptions can be raised if a system is not - -- capable of supporting external Text_IO files. The handler will - -- raise a user-defined exception which will result in a - -- Not_Applicable result for the test. - when Use_Error | Name_Error => raise Non_Applicable_System; - end Create_New_File; - - - - procedure Load_File (The_File : in out File_Type) is - -- This procedure will load several strings into the file denoted - -- by the input parameter. A call to New_Line will add line/page - -- termination characters, which will be available for processing - -- along with the text in the file. - begin - Put_Line (The_File, TC_String_Ptr_Array(1).all); - New_Line (The_File, Spacing => 1); - Put_Line (The_File, TC_String_Ptr_Array(2).all); - end Load_File; - - - begin - - -- Create user-defined text file that will serve as the appropriate - -- sources of input to the procedures under test. - - Create_New_File (User_Defined_Input_File, Out_File, 1); - - -- Enter several lines of text into the new input file. - -- The characters that make up these text strings will be processed - -- using the procedures being exercised in this test. - - Load_File (User_Defined_Input_File); - - -- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate - -- if the mode of the file object is not In_File. - -- Currently, the file mode is Out_File. - - begin - Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); - Report.Failed("Mode_Error not raised by Look_Ahead"); - Report.Comment("This char should never be printed: " & UDLA_Char); - exception - when Mode_Error => null; -- OK, expected exception. - when The_Error : others => - Report.Failed ("The following exception was raised during the " & - "check that Look_Ahead raised Mode_Error when " & - "provided a file object that is not in In_File " & - "mode: " & Exception_Name(The_Error)); - end; - - begin - Get_Immediate(User_Defined_Input_File, UDGI_Char); - Report.Failed("Mode_Error not raised by Get_Immediate"); - Report.Comment("This char should never be printed: " & UDGI_Char); - exception - when Mode_Error => null; -- OK, expected exception. - when The_Error : others => - Report.Failed ("The following exception was raised during the " & - "check that Get_Immediate raised Mode_Error " & - "when provided a file object that is not in " & - "In_File mode: " & Exception_Name(The_Error)); - end; - - - -- The file will then be reset to In_File mode to properly function as - -- a source of input. - - Reset1: - begin - Reset (User_Defined_Input_File, In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise No_Reset; - end Reset1; - - -- Process the input file, exercising various Text_IO - -- functionality, and validating the results at each step. - -- Note: The designated File_Access object is used in processing - -- the New_Default_Input_File in the second loop below. - - -- Process characters in first line of text of each file. - - Char_Pos := 1; - - -- Check that the first line is not blank. - - Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); - - while not UDLA_End_Of_Line loop - - -- Use the Get_Immediate procedure on the file to get the next - -- available character on the current line. - - Get_Immediate(User_Defined_Input_File, UDGI_Char); - - -- Check that the characters returned by both procedures are the - -- same, and that they match the expected character from the file. - - if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or - UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos) - then - Report.Failed("Incorrect retrieval of character " & - Integer'Image(Char_Pos) & " of first string"); - end if; - - -- Increment the character position counter. - Char_Pos := Char_Pos + 1; - - -- Check the next character on the line. If at the end of line, - -- the processing flow will exit the While loop. - - Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line); - - end loop; - - -- Check to ensure that the "end of line" results returned from the - -- Look_Ahead procedure (used to exit the above While loop) corresponds - -- with the result of Function End_Of_Line. - - if not End_Of_Line(User_Defined_Input_File) - then - Report.Failed("Result of procedure Look_Ahead that indicated " & - "being at the end of the line does not correspond " & - "with the result of function End_Of_Line"); - end if; - - -- Check that all characters in the string were processed. - - if Char_Pos-1 /= TC_String_1'Length then - Report.Failed("Not all of the characters on the first line " & - "were processed"); - end if; - - - -- Call procedure Skip_Line to advance beyond the end of the first line. - - Skip_Line(User_Defined_Input_File); - - - -- Process the second line in the file (a blank line). - - Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); - - if not UDLA_End_Of_Line then - Report.Failed("Incorrect end of line determination from procedure " & - "Look_Ahead when processing a blank line"); - end if; - - -- Call procedure Skip_Line to advance beyond the end of the second line. - - Skip_Line(User_Input_Ptr.all); - - - -- Process characters in the third line of the file (second line - -- of text) - -- Note: The version of Get_Immediate used in processing this line has - -- the Boolean parameter Available. - - Char_Pos := 1; - - -- Check whether the line is blank (i.e., at end of line, page, or file). - - Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); - - while not UDLA_End_Of_Line loop - - -- Use the Get_Immediate procedure on the file to get access to the - -- next character on the current line. - - Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available); - - -- Check that the Available parameter of Get_Immediate was set - -- to indicate that a character was available in the file. - -- Check that the characters returned by both procedures are the - -- same, and they all match the expected character from the file. - - if not UDGI_Available or - UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or - UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos) - then - Report.Failed("Incorrect retrieval of character " & - Integer'Image(Char_Pos) & " of second string"); - end if; - - -- Increment the character position counter. - - Char_Pos := Char_Pos + 1; - - -- Check the next character on the line. If at the end of line, - -- the processing flow will exit the While loop. - - Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line); - - end loop; - - -- Check to ensure that the "end of line" results returned from the - -- Look_Ahead procedure (used to exit the above While loop) corresponds - -- with the result of Function End_Of_Line. - - if not End_Of_Line(User_Defined_Input_File) - then - Report.Failed("Result of procedure Look_Ahead that indicated " & - "being at the end of the line does not correspond " & - "with the result of function End_Of_Line"); - end if; - - -- Check that all characters in the second string were processed. - - if Char_Pos-1 /= TC_String_2'Length then - Report.Failed("Not all of the characters on the second line " & - "were processed"); - end if; - - - Deletion: - begin - -- Delete the user defined file. - - if Is_Open(User_Defined_Input_File) then - Delete(User_Defined_Input_File); - else - Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1)); - Delete(User_Defined_Input_File); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - end Deletion; - - - exception - - when No_Reset => - null; - - when Non_Applicable_System => - Report.Not_Applicable("System not capable of supporting external " & - "text files -- Name_Error/Use_Error raised " & - "during text file creation"); - 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 CXAA017; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a deleted file mode 100644 index 53b16fea498..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a +++ /dev/null @@ -1,277 +0,0 @@ --- CXAA018.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 subprograms defined in the package Text_IO.Modular_IO --- provide correct results. --- --- TEST DESCRIPTION: --- This test checks that the subprograms defined in the --- Ada.Text_IO.Modular_IO package provide correct results. --- A modular type is defined and used to instantiate the generic --- package Ada.Text_IO.Modular_IO. Values of the modular type are --- written to a Text_IO file, and to a series of string variables, using --- different versions of the procedure Put from the instantiated IO --- package. These modular data items are retrieved from the file and --- string variables using the appropriate instantiated version of --- procedure Get. A variety of Base and Width parameter values are --- used in the procedure calls. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations that support Text_IO --- processing and external files. --- --- --- CHANGE HISTORY: --- 03 Jul 95 SAIC Initial prerelease version. --- 01 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- ---! - -with Ada.Text_IO; -with System; -with Report; - -procedure CXAA018 is -begin - - Report.Test ("CXAA018", "Check that the subprograms defined in " & - "the package Text_IO.Modular_IO provide " & - "correct results"); - - Test_for_Text_IO_Support: - declare - Data_File : Ada.Text_IO.File_Type; - Data_Filename : constant String := Report.Legal_File_Name; - begin - - -- An application creates a text file in mode Out_File, with the - -- intention of entering modular data into the file as appropriate. - -- In the event that the particular environment where the application - -- is running does not support Text_IO, Use_Error or Name_Error will be - -- raised on calls to Text_IO operations. Either of these exceptions - -- will be handled to produce a Not_Applicable result. - - Ada.Text_IO.Create (File => Data_File, - Mode => Ada.Text_IO.Out_File, - Name => Data_Filename); - - Test_Block: - declare - - type Mod_Type is mod System.Max_Binary_Modulus; - -- Max_Binary_Modulus must be at least 2**16, which would result - -- in a base range of 0..65535 (zero to one less than the given - -- modulus) for this modular type. - - package Mod_IO is new Ada.Text_IO.Modular_IO(Mod_Type); - use Ada.Text_IO, Mod_IO; - use type Mod_Type; - - Number_Of_Modular_Items : constant := 6; - Number_Of_Error_Items : constant := 1; - - TC_Modular : Mod_Type; - TC_Last_Character_Read : Positive; - - Modular_Array : array (1..Number_Of_Modular_Items) of Mod_Type := - ( 0, 97, 255, 1025, 12097, 65535 ); - - - procedure Load_File (The_File : in out Ada.Text_IO.File_Type) is - begin - -- This procedure does not create, open, or close the data file; - -- The_File file object must be Open at this point. - -- This procedure is designed to load Modular_Type data into a - -- data file. - -- - -- Use the Modular_IO procedure Put to enter modular data items - -- into the data file. - - for i in 1..Number_Of_Modular_Items loop - -- Use default Base parameter of 10. - Mod_IO.Put(File => Data_File, - Item => Modular_Array(i), - Width => 6, - Base => Mod_IO.Default_Base); - end loop; - - -- Enter data into the file such that on the corresponding "Get" - -- of this data, Data_Error must be raised. This value is outside - -- the base range of Modular_Type. - -- Text_IO is used to enter the value in the file. - - for i in 1..Number_Of_Error_Items loop - Ada.Text_IO.Put(The_File, "-10"); - end loop; - - end Load_File; - - - - procedure Process_File(The_File : in out Ada.Text_IO.File_Type) is - begin - -- This procedure does not create, open, or close the data file; - -- The_File file object must be Open at this point. - -- Use procedure Get (for Files) to extract the modular data from - -- the Text_IO file. - - for i in 1..Number_Of_Modular_Items loop - Mod_IO.Get(The_File, TC_Modular, Width => 6); - - if TC_Modular /= Modular_Array(i) then - Report.Failed("Incorrect modular data read from file " & - "data item #" & Integer'Image(i)); - end if; - end loop; - - -- The final item in the Data_File is a modular value that is - -- outside the base range 0..Num'Last. This value should raise - -- Data_Error on an attempt to "Get" it from the file. - - for i in 1..Number_Of_Error_Items loop - begin - Mod_IO.Get(The_File, TC_Modular, Mod_IO.Default_Width); - Report.Failed - ("Exception Data_Error not raised when Get " & - "was used to read modular data outside base " & - "range of type, item # " & - Integer'Image(i)); - exception - when Ada.Text_IO.Data_Error => - null; -- OK, expected exception. - when others => - Report.Failed("Unexpected exception raised when Get " & - "was used to read modular data outside " & - "base range of type from Data_File, " & - "data item #" & Integer'Image(i)); - end; - end loop; - - exception - when others => - Report.Failed - ("Unexpected exception raised in Process_File"); - end Process_File; - - - - begin -- Test_Block. - - -- Place modular values into data file. - - Load_File(Data_File); - Ada.Text_IO.Close(Data_File); - - -- Read modular values from data file. - - Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename); - Process_File(Data_File); - - -- Verify versions of Modular_IO procedures Put and Get for Strings. - - Modular_IO_in_Strings: - declare - TC_String_Array : array (1..Number_Of_Modular_Items) - of String(1..30) := (others =>(others => ' ')); - begin - - -- Place modular values into strings using the Procedure Put, - -- Use a variety of different "Base" parameter values. - -- Note: This version of Put uses the length of the given - -- string as the value of the "Width" parameter. - - for i in 1..2 loop - Mod_IO.Put(To => TC_String_Array(i), - Item => Modular_Array(i), - Base => Mod_IO.Default_Base); - end loop; - for i in 3..4 loop - Mod_IO.Put(TC_String_Array(i), - Modular_Array(i), - Base => 2); - end loop; - for i in 5..6 loop - Mod_IO.Put(TC_String_Array(i), Modular_Array(i), 16); - end loop; - - -- Get modular values from strings using the Procedure Get. - -- Compare with expected modular values. - - for i in 1..Number_Of_Modular_Items loop - - Mod_IO.Get(From => TC_String_Array(i), - Item => TC_Modular, - Last => TC_Last_Character_Read); - - if TC_Modular /= Modular_Array(i) then - Report.Failed("Incorrect modular data value obtained " & - "from String following use of Procedures " & - "Put and Get from Strings, Modular_Array " & - "item #" & Integer'Image(i)); - end if; - end loop; - - exception - when others => - Report.Failed("Unexpected exception raised during the " & - "evaluation of Put and Get for Strings"); - end Modular_IO_in_Strings; - - exception - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - - -- Delete the external file. - if Ada.Text_IO.Is_Open(Data_File) then - Ada.Text_IO.Delete(Data_File); - else - Ada.Text_IO.Open(Data_File, - Ada.Text_IO.In_File, - Data_Filename); - Ada.Text_IO.Delete(Data_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 Ada.Text_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Text_IO Create"); - - when Ada.Text_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Text_IO Create"); - - when others => - Report.Failed ("Unexpected exception raised on text file Create"); - - end Test_for_Text_IO_Support; - - Report.Result; - -end CXAA018; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a deleted file mode 100644 index 04c257e97b6..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a +++ /dev/null @@ -1,138 +0,0 @@ --- CXAA019.A --- --- Grant of Unlimited Rights --- --- The Ada Conformity Assessment Authority (ACAA) holds unlimited --- rights in the software and documentation contained herein. Unlimited --- rights are the same as those granted by the U.S. Government for older --- parts of the Ada Conformity Assessment Test Suite, and are defined --- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA --- intends to confer upon all recipients unlimited rights equal to those --- held by the ACAA. 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 Standard_Output can be flushed. Check that 'in' parameters of --- types Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type can be --- flushed. (Defect Report 8652/0051). --- --- CHANGE HISTORY: --- 12 FEB 2001 PHL Initial version --- 16 MAR 2001 RLB Readied for release; fixed Not_Applicable check --- to terminate test gracefully. --- ---! -with Ada.Streams.Stream_Io; -use Ada.Streams; -with Ada.Text_Io; -with Ada.Wide_Text_Io; -with Report; -use Report; -procedure CXAA019 is - - procedure Check (File : in Ada.Text_Io.File_Type) is - begin - Ada.Text_Io.Put_Line - (File, " - CXAA019 About to flush a Text_IO file passed " & - "as 'in' parameter"); - Ada.Text_Io.Flush (File); - end Check; - - procedure Check (File : in Ada.Wide_Text_Io.File_Type) is - begin - Ada.Wide_Text_Io.Put_Line - (File, " - CXAA019 About to flush a Wide_Text_IO file passed " & - "as 'in' parameter"); - Ada.Wide_Text_Io.Flush (File); - end Check; - - procedure Check (File : in Stream_Io.File_Type) is - S : Stream_Element_Array (1 .. 10); - begin - for I in S'Range loop - S (I) := Stream_Element (Character'Pos ('A') + I); - end loop; - Stream_Io.Write (File, S); - Comment ("About to flush a Stream_IO file passed as 'in' parameter"); - Stream_Io.Flush (File); - end Check; - - -begin - Test ("CXAA019", - "Check that Standard_Output can be flushed; check that " & - "'in' Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type" & - "parameters can be flushed"); - - Ada.Text_Io.Put_Line (Ada.Text_Io.Standard_Output, - " - CXAA019 About to flush Standard_Output"); - Ada.Text_Io.Flush (Ada.Text_Io.Standard_Output); - - Check (Ada.Text_Io.Current_Output); - - declare - TC_OK : Boolean := False; - F : Ada.Text_Io.File_Type; - begin - begin - Ada.Text_Io.Create (F, Name => Legal_File_Name (X => 1)); - TC_OK := True; - exception - when others => - Not_Applicable ("Unable to create Out mode Text_IO file"); - end; - if TC_OK then - Check (F); - Ada.Text_Io.Delete (F); - end if; - end; - - declare - TC_OK : Boolean := False; - F : Ada.Wide_Text_Io.File_Type; - begin - begin - Ada.Wide_Text_Io.Create (F, Name => Legal_File_Name (X => 2)); - TC_OK := True; - exception - when others => - Not_Applicable ("Unable to create Out mode Wide_Text_IO file"); - end; - if TC_OK then - Check (F); - Ada.Wide_Text_Io.Delete (F); - end if; - end; - - declare - TC_OK : Boolean := False; - F : Stream_Io.File_Type; - begin - begin - Stream_Io.Create (F, Name => Legal_File_Name (X => 3)); - TC_OK := True; - exception - when others => - Not_Applicable ("Unable to create Out mode Stream_IO file"); - end; - if TC_OK then - Check (F); - Stream_Io.Delete (F); - end if; - end; - - Result; -end CXAA019; - diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxab001.a b/gcc/testsuite/ada/acats/tests/cxa/cxab001.a deleted file mode 100644 index 483acd16cb2..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxab001.a +++ /dev/null @@ -1,272 +0,0 @@ --- CXAB001.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 operations defined in package Wide_Text_IO allow for --- the input/output of Wide_Character and Wide_String data. --- --- TEST DESCRIPTION: --- This test is designed to exercise the components of the Wide_Text_IO --- package, including the Put/Get utilities for Wide_Characters and --- Wide_String objects. --- The test utilizes the Put and Get procedures defined for --- Wide_Characters, as well as the Put, Get, Put_Line, and Get_Line --- procedures defined for Wide_Strings. In addition, many of the --- additional subprograms found in package Wide_Text_IO are used in this --- test. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations capable of supporting --- external Wide_Text_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 26 Feb 97 CTA.PWB Allowed for non-support of some IO operations. ---! - -with Ada.Wide_Text_IO; -with Report; - -procedure CXAB001 is - - Filter_File : Ada.Wide_Text_IO.File_Type; - Filter_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAB001" ); - Incomplete : exception; - - -begin - - Report.Test ("CXAB001", "Check that the operations defined in package " & - "Wide_Text_IO allow for the input/output of " & - "Wide_Character and Wide_String data"); - - - Test_for_Wide_Text_IO_Support: - begin - - -- An implementation that does not support Wide_Text_IO in a particular - -- environment will raise Use_Error on calls to various - -- Wide_Text_IO operations. This block statement encloses a call to - -- Create, which should raise an exception in a non-supportive - -- environment. This exception will be handled to produce a - -- Not_Applicable result. - - Ada.Wide_Text_IO.Create (File => Filter_File, -- Create. - Mode => Ada.Wide_Text_IO.Out_File, - Name => Filter_Filename); - - exception - - when Ada.Wide_Text_IO.Use_Error | Ada.Wide_Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Wide_Text_IO" ); - raise Incomplete; - - end Test_for_Wide_Text_IO_Support; - - Operational_Test_Block: - declare - - First_String : constant Wide_String := "Somewhere "; - Second_String : constant Wide_String := "Over The "; - Third_String : constant Wide_String := "Rainbow"; - Current_Char : Wide_Character := ' '; - - begin - - Enter_Data_In_File: - declare - Pos : Natural := 1; - Bad_Character_Found : Boolean := False; - begin - -- Use the Put procedure defined for Wide_Character data to - -- write all of the wide characters of the First_String into - -- the file individually, followed by a call to New_Line. - - while Pos <= First_String'Length loop - Ada.Wide_Text_IO.Put (Filter_File, First_String (Pos)); -- Put. - Pos := Pos + 1; - end loop; - Ada.Wide_Text_IO.New_Line (Filter_File); -- New_Line. - - -- Reset to In_File mode and read file contents, using the Get - -- procedure defined for Wide_Character data. - Reset1: - begin - Ada.Wide_Text_IO.Reset (Filter_File, -- Reset. - Ada.Wide_Text_IO.In_File); - exception - when Ada.Wide_Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Wide_Text_IO" ); - raise Incomplete; - end Reset1; - - Pos := 1; - while Pos <= First_String'Length loop - Ada.Wide_Text_IO.Get (Filter_File, Current_Char); -- Get. - -- Verify the wide character against the original string. - if Current_Char /= First_String(Pos) then - Bad_Character_Found := True; - end if; - Pos := Pos + 1; - end loop; - - if Bad_Character_Found then - Report.Failed ("Incorrect Wide_Character read from file - 1"); - end if; - - -- Following user file/string processing, the Wide_String data - -- of the Second_String and Third_String Wide_String objects are - -- appended to the file. - -- The Put procedure defined for Wide_String data is used to - -- transfer the Second_String, followed by a call to New_Line. - -- The Put_Line procedure defined for Wide_String data is used - -- to transfer the Third_String. - Reset2: - begin - Ada.Wide_Text_IO.Reset (Filter_File, -- Reset. - Ada.Wide_Text_IO.Append_File); - - exception - when Ada.Wide_Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Wide_Text_IO" ); - raise Incomplete; - end Reset2; - - Ada.Wide_Text_IO.Put (Filter_File, Second_String); -- Put. - Ada.Wide_Text_IO.New_Line (Filter_File); -- New_Line. - - Ada.Wide_Text_IO.Put_Line (Filter_File, Third_String); -- Put_Line. - Ada.Wide_Text_IO.Close (Filter_File); -- Close. - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Exception in Enter_Data_In_File block"); - raise; - - end Enter_Data_In_File; - - --- - - Filter_Block: - declare - - Pos : Positive := 1; - TC_String2 : Wide_String (1..Second_String'Length); - TC_String3 : Wide_String (1..Third_String'Length); - Last : Natural := Natural'First; - - begin - - Ada.Wide_Text_IO.Open (Filter_File, -- Open. - Ada.Wide_Text_IO.In_File, - Filter_Filename); - - - -- Read the data of the First_String from the file, using the - -- Get procedure defined for Wide_Character data. - -- Verify that the character corresponds to the data originally - -- written to the file. - - while Pos <= First_String'Length loop - Ada.Wide_Text_IO.Get (Filter_File, Current_Char); -- Get. - if Current_Char /= First_String(Pos) then - Report.Failed - ("Incorrect Wide_Character read from file - 2"); - end if; - Pos := Pos + 1; - end loop; - - -- The first line of the file has been read, move to the second. - Ada.Wide_Text_IO.Skip_Line (Filter_File); -- Skip_Line. - - -- Read the Wide_String data from the second and third lines of - -- the file. - Ada.Wide_Text_IO.Get (Filter_File, TC_String2); -- Get. - Ada.Wide_Text_IO.Skip_Line (Filter_File); -- Skip_Line. - Ada.Wide_Text_IO.Get_Line (Filter_File, -- Get_Line. - TC_String3, Last); - - -- Verify data of second and third strings. - if TC_String2 /= Second_String then - Report.Failed ("Incorrect Wide_String read from file - 1"); - end if; - if TC_String3 /= Third_String then - Report.Failed ("Incorrect Wide_String read from file - 2"); - end if; - - -- The file should now be at EOF. - if not Ada.Wide_Text_IO.End_Of_File (Filter_File) then -- EOF. - Report.Failed ("File not empty following filtering"); - end if; - - exception - when others => - Report.Failed ("Exception in Filter_Block"); - raise; - end Filter_Block; - - exception - - when Incomplete => - raise; - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - Deletion: - begin - if Ada.Wide_Text_IO.Is_Open (Filter_File) then -- Is_Open. - Ada.Wide_Text_IO.Delete (Filter_File); -- Delete. - else - Ada.Wide_Text_IO.Open (Filter_File, -- Open. - Ada.Wide_Text_IO.Out_File, - Filter_Filename); - Ada.Wide_Text_IO.Delete (Filter_File); -- Delete. - end if; - exception - when others => - Report.Failed ("Delete not properly implemented for Wide_Text_IO"); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAB001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac001.a b/gcc/testsuite/ada/acats/tests/cxa/cxac001.a deleted file mode 100644 index a77d561f5d6..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac001.a +++ /dev/null @@ -1,292 +0,0 @@ --- CXAC001.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 attribute T'Write will, for any specific non-limited --- type T, write an item of the subtype to the stream. --- --- Check that the attribute T'Read will, for a specific non-limited --- type T, read a value of the subtype from the stream. --- --- TEST DESCRIPTION: --- The scenario depicted in this test is that of an environment where --- product data is stored in stream form, then reconstructed into the --- appropriate data structures. Several records of product information --- are stored in an array; the array is passed as a parameter to a --- procedure for storage in the stream. A header is created based on the --- number of data records stored in the array. The header is then written --- to the stream, followed by each record maintained in the array. --- In order to retrieve data from the stream, the header information is --- read from the stream, and the data stored in the header is used to --- perform the appropriate number of read operations of record data from --- the stream. All data read from the stream is validated against the ---- values that were written to the stream. --- --- APPLICABILITY CRITERIA: --- Applicable to all systems capable of supporting IO operations on --- external Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 08 Nov 95 SAIC Corrected call to Read in Procedure Retrieve_Data --- for ACVC 2.0.1. --- 27 Feb 08 PWB.CTA Allowed for non-support of certain IO operations. ---! - -with Ada.Streams.Stream_IO; -with Report; - -procedure CXAC001 is - - package Strm_Pack renames Ada.Streams.Stream_IO; - The_File : Strm_Pack.File_Type; - The_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAC001" ); - Incomplete : exception; - - -begin - - Report.Test ("CXAC001", "Check that the 'Read and 'Write attributes " & - "will transfer an object of a specific, " & - "non-limited type to/from a stream"); - - Test_for_Stream_IO_Support: - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Strm_Pack.Create (The_File, Strm_Pack.Out_File, The_Filename); - - exception - - when Ada.Streams.Stream_IO.Use_Error | - Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Stream_IO" ); - raise Incomplete; - - end Test_for_Stream_IO_Support; - - Operational_Test_Block: - declare - - The_Stream : Strm_Pack.Stream_Access; - Todays_Date : String (1 .. 6) := "271193"; - - type ID_Type is range 1 .. 100; - type Size_Type is (Small, Medium, Large, XLarge); - - type Header_Type is record - Number_of_Elements : Natural := 0; - Origination_Date : String (1 .. 6); - end record; - - type Data_Type is record - ID : ID_Type; - Size : Size_Type; - end record; - - type Data_Array_Type is array (Positive range <>) of Data_Type; - - Product_Information_1 : Data_Array_Type (1 .. 3) := ((20, Large), - (55, Small), - (89, XLarge)); - - Product_Information_2 : Data_Array_Type (1 .. 4) := (( 5, XLarge), - (27, Small), - (79, Medium), - (93, XLarge)); - - procedure Store_Data ( The_Stream : in Strm_Pack.Stream_Access; - The_Array : in Data_Array_Type ) is - Header : Header_Type; - begin - - -- Fill in header info. - Header.Number_of_Elements := The_Array'Length; - Header.Origination_Date := Todays_Date; - - -- Write header to stream. - Header_Type'Write (The_Stream, Header); - - -- Write each record in the array to the stream. - for I in 1 .. Header.Number_of_Elements loop - Data_Type'Write (The_Stream, The_Array (I)); - end loop; - - end Store_Data; - - procedure Retrieve_Data (The_Stream : in Strm_Pack.Stream_Access; - The_Header : out Header_Type; - The_Array : out Data_Array_Type ) is - begin - - -- Read header from the stream. - Header_Type'Read (The_Stream, The_Header); - - -- Read the records from the stream into the array. - for I in 1 .. The_Header.Number_of_Elements loop - Data_Type'Read (The_Stream, The_Array (I)); - end loop; - - end Retrieve_Data; - - begin - - -- Assign access value. - The_Stream := Strm_Pack.Stream (The_File); - - -- Product information is to be stored in the stream file. These - -- data arrays are of different sizes (actually, the records - -- are stored individually, not as a single array). Prior to the - -- record data being written, a header record is initialized with - -- information about the data to be written, then itself is written - -- to the stream. - - Store_Data (The_Stream, Product_Information_1); - Store_Data (The_Stream, Product_Information_2); - - Test_Verification_Block: - declare - Product_Header_1 : Header_Type; - Product_Header_2 : Header_Type; - Product_Array_1 : Data_Array_Type (1 .. 3); - Product_Array_2 : Data_Array_Type (1 .. 4); - begin - - Reset1: - begin - Strm_Pack.Reset (The_File, Strm_Pack.In_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Stream_IO" ); - raise Incomplete; - end Reset1; - - -- Data is read from the stream, first the appropriate header, - -- then the associated data records, which are then reconstructed - -- into a data array of product information. - - Retrieve_Data (The_Stream, Product_Header_1, Product_Array_1); - - -- Validate a field in the header. - if (Product_Header_1.Origination_Date /= Todays_Date) or - (Product_Header_1.Number_of_Elements /= 3) - then - Report.Failed ("Incorrect Header_1 info read from stream"); - end if; - - -- Validate the data records read from the file. - for I in 1 .. Product_Header_1.Number_of_Elements loop - if (Product_Array_1(I) /= Product_Information_1(I)) then - Report.Failed ("Incorrect Product 1 info read from" & - " record: " & Integer'Image (I)); - end if; - end loop; - - -- Repeat this read and verify operation for the next parcel of - -- data. Again, header and data record information are read from - -- the same stream file. - Retrieve_Data (The_Stream, Product_Header_2, Product_Array_2); - - if (Product_Header_2.Origination_Date /= Todays_Date) or - (Product_Header_2.Number_of_Elements /= 4) - then - Report.Failed ("Incorrect Header_2 info read from stream"); - end if; - - for I in 1 .. Product_Header_2.Number_of_Elements loop - if (Product_Array_2(I) /= Product_Information_2(I)) then - Report.Failed ("Incorrect Product_2 info read from" & - " record: " & Integer'Image (I)); - end if; - end loop; - - exception - - when Incomplete => - raise; - - when Strm_Pack.End_Error => -- If correct number of - -- items not in file (data - -- overwritten), then fail. - Report.Failed ("Incorrect number of record elements in file"); - if not Strm_Pack.Is_Open (The_File) then - Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); - end if; - - when others => - Report.Failed ("Exception raised in Data Verification Block"); - if not Strm_Pack.Is_Open (The_File) then - Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); - end if; - - end Test_Verification_Block; - - exception - - when Incomplete => - raise; - - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - Deletion: - begin - -- Delete the file. - if Strm_Pack.Is_Open (The_File) then - Strm_Pack.Delete (The_File); - else - Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename); - Strm_Pack.Delete (The_File); - end if; - - exception - - when others => - Report.Failed - ( "Delete not properly implemented for Stream_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAC001; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac002.a b/gcc/testsuite/ada/acats/tests/cxa/cxac002.a deleted file mode 100644 index e4b303c4bc9..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac002.a +++ /dev/null @@ -1,426 +0,0 @@ --- CXAC002.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 subprograms defined in package Ada.Streams.Stream_IO --- are accessible, and that they provide the appropriate functionality. --- --- TEST DESCRIPTION: --- This test simulates a user filter designed to capitalize the --- characters of a string. It utilizes a variety of the subprograms --- contained in the package Ada.Streams.Stream_IO. --- Its purpose is to demonstrate the use of a variety of the capabilities --- found in the Ada.Streams.Stream_IO package. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations capable of supporting --- external Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 14 Nov 95 SAIC Corrected visibility problems; corrected --- subtest validating result from function Name --- for ACVC 2.0.1. --- 05 Oct 96 SAIC Removed calls to Close/Open in test and replaced --- them with a single call to Reset (per AI95-0001) --- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations. --- 09 Feb 01 RLB Corrected non-support check to avoid unintended --- failures. ---! - -package CXAC002_0 is - - -- This function searches for the first instance of a specified substring - -- within a specified string, returning boolean result. (Case insensitive - -- analysis) - - function Find (Str : in String; Sub : in String) return Boolean; - -end CXAC002_0; - -package body CXAC002_0 is - - function Find (Str : in String; Sub : in String) return Boolean is - - New_Str : String(Str'First..Str'Last); - New_Sub : String(Sub'First..Sub'Last); - Pos : Integer := Str'First; -- Character index. - - function Upper_Case (Str : in String) return String is - subtype Upper is Character range 'A'..'Z'; - subtype Lower is Character range 'a'..'z'; - Ret : String(Str'First..Str'Last); - Pos : Integer; - begin - for I in Str'Range loop - if (Str(I) in Lower) then - Pos := Upper'Pos(Upper'First) + - (Lower'Pos(Str(I)) - Lower'Pos(Lower'First)); - Ret(I) := Upper'Val(Pos); - else - Ret(I) := Str (I); - end if; - end loop; - return Ret; - end Upper_Case; - - begin - - New_Str := Upper_Case(Str); -- Convert Str and Sub to upper - New_Sub := Upper_Case(Sub); -- case for comparison. - - while (Pos <= New_Str'Last-New_Sub'Length+1) -- Search until no more - and then -- sub-string-length - (New_Str(Pos..Pos+New_Sub'Length-1) /= New_Sub) -- slices remain. - loop - Pos := Pos + 1; - end loop; - - if (Pos > New_Str'Last-New_Sub'Length+1) then -- Substring not found. - return False; - else - return True; - end if; - - end Find; - -end CXAC002_0; - - -with Ada.Streams.Stream_IO, CXAC002_0, Report; -procedure CXAC002 is - Filter_File : Ada.Streams.Stream_IO.File_Type; - Filter_Stream : Ada.Streams.Stream_IO.Stream_Access; - Filter_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAC002" ); - Incomplete : Exception; - -begin - - Report.Test ("CXAC002", "Check that the subprograms defined in " & - "package Ada.Streams.Stream_IO are accessible, " & - "and that they provide the appropriate " & - "functionality"); - - Test_for_Stream_IO_Support: - - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Filter_File, -- Create. - Ada.Streams.Stream_IO.Out_File, - Filter_Filename); - exception - - when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Stream_IO" ); - raise Incomplete; - - end Test_for_Stream_IO_Support; - - Operational_Test_Block: - declare - - use CXAC002_0; - use type Ada.Streams.Stream_IO.File_Mode; - use type Ada.Streams.Stream_IO.Count; - - File_Size : Ada.Streams.Stream_IO.Count := -- Count. - Ada.Streams.Stream_IO.Count'First; -- (0) - File_Index : Ada.Streams.Stream_IO.Positive_Count := -- Pos. Count. - Ada.Streams.Stream_IO.Positive_Count'First; -- (1) - - First_String : constant String := "this is going to be "; - Second_String : constant String := "the best year of your life"; - Total_Length : constant Natural := First_String'Length + - Second_String'Length; - Current_Char : Character := ' '; - - Cap_String : String (1..Total_Length) := (others => ' '); - - TC_Capital_String : constant String := - "THIS IS GOING TO BE THE BEST YEAR OF YOUR LIFE"; - - begin - - if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then -- Is_Open - Report.Failed ("File not open following Create"); - end if; - - -- Call function Find to determine if the filename (Sub) is contained - -- in the result of Function Name. - - if not Find(Str => Ada.Streams.Stream_IO.Name(Filter_File), -- Name. - Sub => Filter_Filename) - then - Report.Failed ("Function Name provided incorrect filename"); - end if; - -- Stream. - Filter_Stream := Ada.Streams.Stream_IO.Stream (Filter_File); - - --- - - Enter_Data_In_Stream: - declare - Pos : Natural := 1; - Bad_Character_Found : Boolean := False; - begin - - -- Enter data from the first string into the stream. - while Pos <= Natural(First_String'Length) loop - -- Write all characters of the First_String to the stream. - Character'Write (Filter_Stream, First_String (Pos)); - Pos := Pos + 1; - -- Ensure data put in file on a regular basis. - if Pos mod 5 = 0 then - Ada.Streams.Stream_IO.Flush (Filter_File); -- Flush. - end if; - end loop; - - Ada.Streams.Stream_IO.Flush (Filter_File); -- Flush. - -- Reset to In_File mode and read stream contents. - Reset1: - begin - Ada.Streams.Stream_IO.Reset (Filter_File, -- Reset. - Ada.Streams.Stream_IO.In_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Stream_IO" ); - raise Incomplete; - end Reset1; - - Pos := 1; - while Pos <= First_String'Length loop - -- Read one character from the stream. - Character'Read (Filter_Stream, Current_Char); -- 'Read - -- Verify character against the original string. - if Current_Char /= First_String(Pos) then - Bad_Character_Found := True; - end if; - Pos := Pos + 1; - end loop; - - if Bad_Character_Found then - Report.Failed ("Incorrect character read from stream"); - end if; - - -- Following user stream/string processing, the stream file is - -- appended to as follows: - - Reset2: - begin - Ada.Streams.Stream_IO.Reset (Filter_File, -- Reset. - Ada.Streams.Stream_IO.Append_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported for Stream_IO" ); - raise Incomplete; - end Reset2; - - if Ada.Streams.Stream_IO.Mode (Filter_File) /= -- Mode. - Ada.Streams.Stream_IO.Append_File - then - Report.Failed ("Incorrect mode following Reset to Append"); - end if; - - Pos := 1; - while Pos <= Natural(Second_String'Length) loop - -- Write all characters of the Second_String to the stream. - Character'Write (Filter_Stream, Second_String (Pos)); -- 'Write - Pos := Pos + 1; - end loop; - - Ada.Streams.Stream_IO.Flush (Filter_File); -- Flush. - - -- Record file statistics. - File_Size := Ada.Streams.Stream_IO.Size (Filter_File); -- Size. - - Index_Might_Not_Be_Supported: - begin - File_Index := Ada.Streams.Stream_IO.Index (Filter_File); -- Index. - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable ( "Index not supported for Stream_IO" ); - raise Incomplete; - end Index_Might_Not_Be_Supported; - - exception - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Enter_Data_In_Stream block"); - raise; - end Enter_Data_In_Stream; - - --- - - Filter_Block: - declare - Pos : Positive := 1; - Full_String : constant String := First_String & Second_String; - - function Capitalize (Char : Character) return Character is - begin - if Char /= ' ' then - return Character'Val( Character'Pos(Char) - - (Character'Pos('a') - Character'Pos('A'))); - else - return Char; - end if; - end Capitalize; - - begin - - Reset3: - begin - Ada.Streams.Stream_IO.Reset (Filter_File, -- Reset. - Ada.Streams.Stream_IO.In_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Stream_IO" ); - raise Incomplete; - end Reset3; - - if Ada.Streams.Stream_IO.Mode (Filter_File) /= -- Mode. - Ada.Streams.Stream_IO.In_File - then - Report.Failed ("Incorrect mode following Reset to In_File"); - end if; - - if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then -- Is_Open - Report.Failed ( "Reset command did not leave file open" ); - end if; - - if Ada.Streams.Stream_IO.Size (Filter_File) /= -- Size. - File_Size - then - Report.Failed ("Reset file is not correct size"); - end if; - - if Ada.Streams.Stream_IO.Index (Filter_File) /= 1 then -- Index. - -- File position should have been reset to start of file. - Report.Failed ("Index of file not set to 1 following Reset"); - end if; - - while Pos <= Full_String'Length loop - -- Read one character from the stream. - Character'Read (Filter_Stream, Current_Char); -- 'Read - -- Verify character against the original string. - if Current_Char /= Full_String(Pos) then - Report.Failed ("Incorrect character read from stream"); - else - -- Capitalize the characters read from the stream, and - -- place them in a string variable. - Cap_String(Pos) := Capitalize (Current_Char); - end if; - Pos := Pos + 1; - end loop; - - -- File index should now be set to the position following the final - -- character in the file (the same as the index value stored at - -- the completion of the Enter_Data_In_Stream block). - if Ada.Streams.Stream_IO.Index (Filter_File) /= -- Index. - File_Index - then - Report.Failed ("Incorrect file index position"); - end if; - - -- The stream file should now be at EOF. -- EOF. - if not Ada.Streams.Stream_IO.End_Of_File (Filter_File) then - Report.Failed ("File not empty following filtering"); - end if; - - exception - - when Incomplete => - raise; - when others => - Report.Failed ("Exception in Filter_Block"); - raise; - end Filter_Block; - - --- - - Verification_Block: - begin - - -- Verify that the entire string was examined, and that the - -- process of capitalizing the character data was successful. - if Cap_String /= TC_Capital_String then - Report.Failed ("Incorrect Capitalization"); - end if; - - exception - when others => - Report.Failed ("Exception in Verification_Block"); - end Verification_Block; - - - exception - - when Incomplete => - raise; - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - Deletion: - begin - if Ada.Streams.Stream_IO.Is_Open (Filter_File) then -- Is_Open. - Ada.Streams.Stream_IO.Delete (Filter_File); -- Delete. - else - Ada.Streams.Stream_IO.Open (Filter_File, -- Open. - Ada.Streams.Stream_IO.Out_File, - Filter_Filename); - Ada.Streams.Stream_IO.Delete (Filter_File); -- Delete. - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Stream_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAC002; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac003.a b/gcc/testsuite/ada/acats/tests/cxa/cxac003.a deleted file mode 100644 index cc1e044d0a2..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac003.a +++ /dev/null @@ -1,376 +0,0 @@ --- CXAC003.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 correct exceptions are raised when improperly --- manipulating stream file objects. --- --- TEST DESCRIPTION: --- This test is designed to focus on Stream_IO file manipulation --- exceptions. Several potentially common user errors are examined in --- the test: --- --- A Status_Error should be raised whenever an attempt is made to perform --- an operation on a file that is closed. --- --- A Status_Error should be raised when an attempt is made to open a --- stream file that is currently open. --- --- A Mode_Error should be raised when attempting to read from (use the --- 'Read attribute) on an Out_File or Append_Mode file. --- --- A Mode_Error should be raised when checking for End Of File on a --- file with mode Out_File or Append_Mode. --- --- A Mode_Error should be raised when attempting to write to (use the --- 'Output attribute) on a file with mode In_File. --- --- A Name_Error should be raised when the string provided to the Name --- parameter of an Open operation does not allow association of an --- external file. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations capable of supporting --- external Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations --- 02 Mar 01 PHL Check that Ada.Streams.Stream_IO.Stream raises --- Status_Error if the file is not open. (DR 8652/ --- 0056). --- 15 Mar 01 RLB Readied for release. ---! - -with Ada.Streams.Stream_IO; -with Report; - -procedure CXAC003 is - - Stream_File_Object : Ada.Streams.Stream_IO.File_Type; - Stream_Access_Value : Ada.Streams.Stream_IO.Stream_Access; - Stream_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAC003" ); - Incomplete : exception; - -begin - - Report.Test ("CXAC003", "Check that the correct exceptions are " & - "raised when improperly manipulating stream " & - "file objects"); - - Test_for_Stream_IO_Support: - begin - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Stream_File_Object, - Ada.Streams.Stream_IO.Out_File, - Stream_Filename); - - exception - - when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Stream_IO" ); - raise Incomplete; - - end Test_for_Stream_IO_Support; - - Operational_Test_Block: - begin - -- A potentially common error in a file processing environment - -- is to attempt to perform an operation on a stream file that is - -- not currently open. Status_Error should be raised in this case. - Check_Status_Error: - begin - Ada.Streams.Stream_IO.Close (Stream_File_Object); - -- Attempt to reset a file that is closed. - Ada.Streams.Stream_IO.Reset (Stream_File_Object, - Ada.Streams.Stream_IO.Out_File); - Report.Failed ("Exception not raised on Reset of closed file"); - exception - when Ada.Streams.Stream_IO.Status_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 1"); - end Check_Status_Error; - - -- A similar error is to use Ada.Streams.Stream_IO.Stream - -- to attempt to perform an operation on a stream file that is - -- not currently open. Status_Error should be raised in this case. - -- (Defect Report 8652/0046, as reflected in Technical Corrigendum 1.) - Check_Status_Error2: - begin - -- Ensure that the file is not open. - if Ada.Streams.Stream_Io.Is_Open (Stream_File_Object) then - Ada.Streams.Stream_Io.Close (Stream_File_Object); - end if; - Stream_Access_Value := - Ada.Streams.Stream_Io.Stream (Stream_File_Object); - Report.Failed ("Exception not raised on Stream of closed file"); - exception - when Ada.Streams.Stream_Io.Status_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 2"); - end Check_Status_Error2; - - -- Another potentially common error in a file processing environment - -- is to attempt to Open a stream file that is currently open. - -- Status_Error should be raised in this case. - Check_Status_Error3: - begin - -- Ensure that the file is open. - if not Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then - Ada.Streams.Stream_IO.Open (Stream_File_Object, - Ada.Streams.Stream_IO.In_File, - Stream_Filename); - end if; - Ada.Streams.Stream_IO.Open (Stream_File_Object, - Ada.Streams.Stream_IO.In_File, - Stream_Filename); - Report.Failed ("Exception not raised on Open of open file"); - exception - when Ada.Streams.Stream_IO.Status_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 3"); - end Check_Status_Error3; - - -- Another example of a potential error occurring in a file - -- processing environment is to attempt to use the 'Read attribute - -- on a stream file that is currently in Out_File or Append_File - -- mode. Mode_Error should be raised in both of these cases. - Check_Mode_Error: - declare - Int_Var : Integer := -10; - begin - - Reset1: - begin - Ada.Streams.Stream_IO.Reset (Stream_File_Object, - Ada.Streams.Stream_IO.Out_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Out_File not supported for Stream_IO - 1" ); - raise Incomplete; - end Reset1; - - Stream_Access_Value := - Ada.Streams.Stream_IO.Stream (Stream_File_Object); - Integer'Write (Stream_Access_Value, Int_Var); - - -- File contains an integer value, but is of mode Out_File. - Integer'Read (Stream_Access_Value, Int_Var); - Report.Failed ("Exception not raised by 'Read of Out_File"); - exception - when Incomplete => - raise; - when Ada.Streams.Stream_IO.Mode_Error => - null; - Try_Read: - begin - Reset2: - begin - Ada.Streams.Stream_IO.Reset - (Stream_File_Object, Ada.Streams.Stream_IO.Append_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported " & - "for Stream_IO - 2" ); - raise Incomplete; - end Reset2; - - Integer'Write (Stream_Access_Value, Int_Var); - -- Attempt read from Append_File mode file. - Integer'Read (Stream_Access_Value, Int_Var); - Report.Failed - ("Exception not raised by 'Read of Append file"); - exception - when Incomplete => - null; - when Ada.Streams.Stream_IO.Mode_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 4b"); - end Try_Read; - - when others => Report.Failed ("Incorrect exception raised - 4a"); - end Check_Mode_Error; - - -- Another example of a this type of potential error is to attempt - -- to check for End Of File on a stream file that is currently in - -- Out_File or Append_File mode. Mode_Error should also be raised - -- in both of these cases. - Check_End_File: - declare - Test_Boolean : Boolean := False; - begin - Reset3: - begin - Ada.Streams.Stream_IO.Reset (Stream_File_Object, - Ada.Streams.Stream_IO.Out_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Out_File not supported for Stream_IO - 3" ); - raise Incomplete; - end Reset3; - - Test_Boolean := - Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object); - Report.Failed ("Exception not raised by EOF on Out_File"); - exception - when Incomplete => - null; - when Ada.Streams.Stream_IO.Mode_Error => - null; - EOF_For_Append_File: - begin - Reset4: - begin - Ada.Streams.Stream_IO.Reset - (Stream_File_Object, Ada.Streams.Stream_IO.Append_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to Append_File not supported " & - "for Stream_IO - 4" ); - raise Incomplete; - end Reset4; - - Test_Boolean := - Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object); - Report.Failed - ("Exception not raised by EOF of Append file"); - exception - when Incomplete => - raise; - when Ada.Streams.Stream_IO.Mode_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 5b"); - end EOF_For_Append_File; - - when others => Report.Failed ("Incorrect exception raised - 5a"); - end Check_End_File; - - - - -- In a similar situation to the above cases for attribute 'Read, - -- an attempt to use the 'Output attribute on a stream file that - -- is currently in In_File mode should result in Mode_Error being - -- raised. - Check_Output_Mode_Error: - begin - Reset5: - begin - Ada.Streams.Stream_IO.Reset (Stream_File_Object, - Ada.Streams.Stream_IO.In_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Stream_IO - 6" ); - raise Incomplete; - end Reset5; - - Stream_Access_Value := - Ada.Streams.Stream_IO.Stream (Stream_File_Object); - String'Output (Stream_Access_Value, "User-Oriented String"); - Report.Failed ("Exception not raised by 'Output to In_File"); - exception - when Incomplete => - null; - when Ada.Streams.Stream_IO.Mode_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 6"); - end Check_Output_Mode_Error; - - -- Any case of attempting to Open a stream file with a string for - -- the parameter Name that does not allow the identification of an - -- external file will result in the exception Name_Error being - -- raised. - Check_Illegal_File_Name: - begin - if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then - Ada.Streams.Stream_IO.Close (Stream_File_Object); - end if; - -- No external file exists with this filename, allowing no - -- association with an internal file object, resulting in the - -- raising of the exception Name_Error. - Ada.Streams.Stream_IO.Open(File => Stream_File_Object, - Mode => Ada.Streams.Stream_IO.Out_File, - Name => Report.Legal_File_Name(2)); - Report.Failed ("Exception not raised by bad filename on Open"); - exception - when Ada.Streams.Stream_IO.Name_Error => - null; - when others => - Report.Failed ("Incorrect exception raised - 7"); - end Check_Illegal_File_Name; - - exception - when Incomplete => - null; - when others => - Report.Failed ("Unexpected exception in Operational Test Block"); - - end Operational_Test_Block; - - Deletion: - begin - if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then - Ada.Streams.Stream_IO.Delete (Stream_File_Object); - else - Ada.Streams.Stream_IO.Open (Stream_File_Object, - Ada.Streams.Stream_IO.Out_File, - Stream_Filename); - Ada.Streams.Stream_IO.Delete (Stream_File_Object); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Stream_IO" ); - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAC003; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac004.a b/gcc/testsuite/ada/acats/tests/cxa/cxac004.a deleted file mode 100644 index 9cc88b93cfb..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac004.a +++ /dev/null @@ -1,310 +0,0 @@ --- CXAC004.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 Stream_Access type and Stream function found in package --- Ada.Text_IO.Text_Streams allows a text file to be processed with the --- functionality of streams. --- --- TEST DESCRIPTION: --- This test verifies that the package Ada.Text_IO.Text_Streams is --- available and that the functionality it contains allows a text file to --- be manipulated as a stream. --- The test defines data objects of a variety of types that can be stored --- in a text file. A text file and associated text stream are then --- defined, and the 'Write attribute is used to enter the individual data --- items into the text stream. Once all the individual data items have --- been written to the stream, the 'Output attribute is used to write --- arrays of these same data objects to the stream. --- The text file is reset to serve as an input file, and the 'Read --- attribute is used to extract the individual data items from the --- stream. These items are then verified against the data originally --- written to the stream. Finally, the 'Input attribute is used to --- extract the data arrays from the stream. These arrays are then --- verified against the original data written to the stream. --- --- APPLICABILITY CRITERIA: --- Applicable to implementations that support external text files. --- --- CHANGE HISTORY: --- 06 Jul 95 SAIC Initial prerelease version. --- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations; --- removed requirement for support of decimal types. ---! - -with Report; -with Ada.Text_IO; -with Ada.Text_IO.Text_Streams; -with Ada.Characters.Latin_1; -with Ada.Strings.Unbounded; - -procedure CXAC004 is - - Data_File : Ada.Text_IO.File_Type; - Data_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXAC004" ); - Incomplete : exception; - -begin - - Report.Test ("CXAC004", "Check that the Stream_Access type and Stream " & - "function found in package " & - "Ada.Text_IO.Text_Streams allows a text file to " & - "be processed with the functionality of streams"); - - Test_for_IO_Support: - begin - - -- Check for Text_IO support in creating the data file. If the - -- implementation does not support external files, Name_Error or - -- Use_Error will be raised at the point of the following call to - -- Create, resulting in a Not_Applicable test result. - - Ada.Text_IO.Create(Data_File, Ada.Text_IO.Out_File, Data_Filename); - - exception - - when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Text_IO" ); - raise Incomplete; - - end Test_for_IO_Support; - - Test_Block: - declare - use Ada.Characters.Latin_1, Ada.Strings.Unbounded; - TC_Items : constant := 3; - - -- Declare types and objects that will be used as data values to be - -- written to and read from the text file/stream. - - type Enum_Type is (Red, Yellow, Green, Blue, Indigo); - type Fixed_Type is delta 0.125 range 0.0..255.0; - type Float_Type is digits 7 range 0.0..1.0E5; - type Modular_Type is mod 256; - subtype Str_Type is String(1..4); - - type Char_Array_Type is array (1..TC_Items) of Character; - type Enum_Array_Type is array (1..TC_Items) of Enum_Type; - type Fixed_Array_Type is array (1..TC_Items) of Fixed_Type; - type Float_Array_Type is array (1..TC_Items) of Float_Type; - type Int_Array_Type is array (1..TC_Items) of Integer; - type Mod_Array_Type is array (1..TC_Items) of Modular_Type; - type Str_Array_Type is array (1..TC_Items) of Str_Type; - type Unb_Str_Array_Type is array (1..TC_Items) of Unbounded_String; - - Char_Array : Char_Array_Type := ('A', 'z', Yen_Sign); - TC_Char_Array_1, - TC_Char_Array_2 : Char_Array_Type := (others => Space); - - Enum_Array : Enum_Array_Type := (Blue, Yellow, Indigo); - TC_Enum_Array_1, - TC_Enum_Array_2 : Enum_Array_Type := (others => Red); - - Fix_Array : Fixed_Array_Type := (0.125, 123.5, 250.750); - TC_Fix_Array_1, - TC_Fix_Array_2 : Fixed_Array_Type := (others => 0.0); - - Flt_Array : Float_Array_Type := (1.0, 150.0, 1500.0); - TC_Flt_Array_1, - TC_Flt_Array_2 : Float_Array_Type := (others => 0.0); - - Int_Array : Int_Array_Type := (124, 2349, -24_001); - TC_Int_Array_1, - TC_Int_Array_2 : Int_Array_Type := (others => -99); - - Mod_Array : Mod_Array_Type := (10, 127, 255); - TC_Mod_Array_1, - TC_Mod_Array_2 : Mod_Array_Type := (others => 0); - - Str_Array : Str_Array_Type := ("abcd", "klmn", "wxyz"); - TC_Str_Array_1, - TC_Str_Array_2 : Str_Array_Type := (others => " "); - - UStr_Array : Unb_Str_Array_Type := - (To_Unbounded_String("cat"), - To_Unbounded_String("testing"), - To_Unbounded_String("ACVC")); - TC_UStr_Array_1, - TC_UStr_Array_2 : Unb_Str_Array_Type := - (others => Null_Unbounded_String); - - -- Create a stream access object pointing to the data file. - - Data_Stream : Ada.Text_IO.Text_Streams.Stream_Access := - Ada.Text_IO.Text_Streams.Stream(File => Data_File); - - begin - - -- Use the 'Write attribute to enter the three sets of data items - -- into the data stream. - -- Note that the data will be mixed within the text file. - - for i in 1..TC_Items loop - Character'Write (Data_Stream, Char_Array(i)); - Enum_Type'Write (Data_Stream, Enum_Array(i)); - Fixed_Type'Write (Data_Stream, Fix_Array(i)); - Float_Type'Write (Data_Stream, Flt_Array(i)); - Integer'Write (Data_Stream, Int_Array(i)); - Modular_Type'Write (Data_Stream, Mod_Array(i)); - Str_Type'Write (Data_Stream, Str_Array(i)); - Unbounded_String'Write(Data_Stream, UStr_Array(i)); - end loop; - - -- Use the 'Output attribute to enter the entire arrays of each - -- type of data items into the data stream. - -- Note that the array bounds will be written to the stream as part - -- of the action of the 'Output attribute. - - Char_Array_Type'Output (Data_Stream, Char_Array); - Enum_Array_Type'Output (Data_Stream, Enum_Array); - Fixed_Array_Type'Output (Data_Stream, Fix_Array); - Float_Array_Type'Output (Data_Stream, Flt_Array); - Int_Array_Type'Output (Data_Stream, Int_Array); - Mod_Array_Type'Output (Data_Stream, Mod_Array); - Str_Array_Type'Output (Data_Stream, Str_Array); - Unb_Str_Array_Type'Output (Data_Stream, UStr_Array); - - -- Reset the data file to mode In_File. The data file will now serve - -- as the source of data which will be compared to the original data - -- written to the file above. - Reset1: - begin - Ada.Text_IO.Reset (File => Data_File, Mode => Ada.Text_IO.In_File); - exception - when Ada.Text_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Text_IO" ); - raise Incomplete; - end Reset1; - - -- Extract and validate all the single data items from the stream. - - for i in 1..TC_Items loop - Character'Read (Data_Stream, TC_Char_Array_1(i)); - Enum_Type'Read (Data_Stream, TC_Enum_Array_1(i)); - Fixed_Type'Read (Data_Stream, TC_Fix_Array_1(i)); - Float_Type'Read (Data_Stream, TC_Flt_Array_1(i)); - Integer'Read (Data_Stream, TC_Int_Array_1(i)); - Modular_Type'Read (Data_Stream, TC_Mod_Array_1(i)); - Str_Type'Read (Data_Stream, TC_Str_Array_1(i)); - Unbounded_String'Read (Data_Stream, TC_UStr_Array_1(i)); - end loop; - - if TC_Char_Array_1 /= Char_Array then - Report.Failed("Character values do not match"); - end if; - if TC_Enum_Array_1 /= Enum_Array then - Report.Failed("Enumeration values do not match"); - end if; - if TC_Fix_Array_1 /= Fix_Array then - Report.Failed("Fixed point values do not match"); - end if; - if TC_Flt_Array_1 /= Flt_Array then - Report.Failed("Floating point values do not match"); - end if; - if TC_Int_Array_1 /= Int_Array then - Report.Failed("Integer values do not match"); - end if; - if TC_Mod_Array_1 /= Mod_Array then - Report.Failed("Modular values do not match"); - end if; - if TC_Str_Array_1 /= Str_Array then - Report.Failed("String values do not match"); - end if; - if TC_UStr_Array_1 /= UStr_Array then - Report.Failed("Unbounded_String values do not match"); - end if; - - -- Extract and validate all data arrays from the data stream. - -- Note that the 'Input attribute denotes a function, whereas the - -- other stream oriented attributes in this test denote procedures. - - TC_Char_Array_2 := Char_Array_Type'Input(Data_Stream); - TC_Enum_Array_2 := Enum_Array_Type'Input(Data_Stream); - TC_Fix_Array_2 := Fixed_Array_Type'Input(Data_Stream); - TC_Flt_Array_2 := Float_Array_Type'Input(Data_Stream); - TC_Int_Array_2 := Int_Array_Type'Input(Data_Stream); - TC_Mod_Array_2 := Mod_Array_Type'Input(Data_Stream); - TC_Str_Array_2 := Str_Array_Type'Input(Data_Stream); - TC_UStr_Array_2 := Unb_Str_Array_Type'Input(Data_Stream); - - if TC_Char_Array_2 /= Char_Array then - Report.Failed("Character array values do not match"); - end if; - if TC_Enum_Array_2 /= Enum_Array then - Report.Failed("Enumeration array values do not match"); - end if; - if TC_Fix_Array_2 /= Fix_Array then - Report.Failed("Fixed point array values do not match"); - end if; - if TC_Flt_Array_2 /= Flt_Array then - Report.Failed("Floating point array values do not match"); - end if; - if TC_Int_Array_2 /= Int_Array then - Report.Failed("Integer array values do not match"); - end if; - if TC_Mod_Array_2 /= Mod_Array then - Report.Failed("Modular array values do not match"); - end if; - if TC_Str_Array_2 /= Str_Array then - Report.Failed("String array values do not match"); - end if; - if TC_UStr_Array_2 /= UStr_Array then - Report.Failed("Unbounded_String array values do not match"); - end if; - - exception - when Incomplete => - raise; - when others => Report.Failed ("Exception raised in Test_Block"); - end Test_Block; - - Deletion: - begin - -- Delete the data file. - if not Ada.Text_IO.Is_Open(Data_File) then - Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename); - end if; - Ada.Text_IO.Delete(Data_File); - - exception - when others => - Report.Failed - ( "Delete not properly implemented for Text_IO" ); - - end Deletion; - - Report.Result; - -exception - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXAC004; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxac005.a b/gcc/testsuite/ada/acats/tests/cxa/cxac005.a deleted file mode 100644 index 34a971f7a51..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxac005.a +++ /dev/null @@ -1,343 +0,0 @@ --- CXAC005.A --- --- Grant of Unlimited Rights --- --- The Ada Conformity Assessment Authority (ACAA) holds unlimited --- rights in the software and documentation contained herein. Unlimited --- rights are the same as those granted by the U.S. Government for older --- parts of the Ada Conformity Assessment Test Suite, and are defined --- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA --- intends to confer upon all recipients unlimited rights equal to those --- held by the ACAA. 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 stream file positioning work as specified. (Defect Report --- 8652/0055). --- --- CHANGE HISTORY: --- 12 FEB 2001 PHL Initial version. --- 14 MAR 2001 RLB Readied for release; fixed Not_Applicable check --- to terminate test gracefully. --- ---! -with Ada.Streams.Stream_Io; -use Ada.Streams; -with Ada.Exceptions; -use Ada.Exceptions; -with Report; -use Report; -procedure CXAC005 is - - Incomplete : exception; - - procedure TC_Assert (Condition : Boolean; Message : String) is - begin - if not Condition then - Failed (Message); - end if; - end TC_Assert; - - package Checked_Stream_Io is - - type File_Type (Max_Size : Stream_Element_Count) is limited private; - function Stream_Io_File (File : File_Type) return Stream_Io.File_Type; - - procedure Create (File : in out File_Type; - Mode : in Stream_Io.File_Mode := Stream_Io.Out_File; - Name : in String := ""; - Form : in String := ""); - - procedure Open (File : in out File_Type; - Mode : in Stream_Io.File_Mode; - Name : in String; - Form : in String := ""); - - procedure Close (File : in out File_Type); - procedure Delete (File : in out File_Type); - - procedure Reset (File : in out File_Type; - Mode : in Stream_Io.File_Mode); - procedure Reset (File : in out File_Type); - - procedure Read (File : in out File_Type; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset; - From : in Stream_Io.Positive_Count); - - procedure Read (File : in out File_Type; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset); - - procedure Write (File : in out File_Type; - Item : in Stream_Element_Array; - To : in Stream_Io.Positive_Count); - - procedure Write (File : in out File_Type; - Item : in Stream_Element_Array); - - procedure Set_Index (File : in out File_Type; - To : in Stream_Io.Positive_Count); - - function Index (File : in File_Type) return Stream_Io.Positive_Count; - - procedure Set_Mode (File : in out File_Type; - Mode : in Stream_Io.File_Mode); - - private - type File_Type (Max_Size : Stream_Element_Count) is - record - File : Stream_Io.File_Type; - Index : Stream_Io.Positive_Count; - Contents : - Stream_Element_Array - (Stream_Element_Offset (Ident_Int (1)) .. Max_Size); - end record; - end Checked_Stream_Io; - - package body Checked_Stream_Io is - - use Stream_Io; - - function Stream_Io_File (File : File_Type) return Stream_Io.File_Type is - begin - return File.File; - end Stream_Io_File; - - procedure Create (File : in out File_Type; - Mode : in Stream_Io.File_Mode := Stream_Io.Out_File; - Name : in String := ""; - Form : in String := "") is - begin - Stream_Io.Create (File.File, Mode, Name, Form); - File.Index := Stream_Io.Index (File.File); - if Mode = Append_File then - TC_Assert (File.Index = Stream_Io.Size (File.File) + 1, - "Index /= Size + 1 -- Create - Append_File"); - else - TC_Assert (File.Index = 1, "Index /= 1 -- Create - " & - File_Mode'Image (Mode)); - end if; - end Create; - - procedure Open (File : in out File_Type; - Mode : in Stream_Io.File_Mode; - Name : in String; - Form : in String := "") is - begin - Stream_Io.Open (File.File, Mode, Name, Form); - File.Index := Stream_Io.Index (File.File); - if Mode = Append_File then - TC_Assert (File.Index = Stream_Io.Size (File.File) + 1, - "Index /= Size + 1 -- Open - Append_File"); - else - TC_Assert (File.Index = 1, "Index /= 1 -- Open - " & - File_Mode'Image (Mode)); - end if; - end Open; - - procedure Close (File : in out File_Type) is - begin - Stream_Io.Close (File.File); - end Close; - - procedure Delete (File : in out File_Type) is - begin - Stream_Io.Delete (File.File); - end Delete; - - procedure Reset (File : in out File_Type; - Mode : in Stream_Io.File_Mode) is - begin - Stream_Io.Reset (File.File, Mode); - File.Index := Stream_Io.Index (File.File); - if Mode = Append_File then - TC_Assert (File.Index = Stream_Io.Size (File.File) + 1, - "Index /= Size + 1 -- Reset - Append_File"); - else - TC_Assert (File.Index = 1, "Index /= 1 -- Reset - " & - File_Mode'Image (Mode)); - end if; - end Reset; - - procedure Reset (File : in out File_Type) is - begin - Reset (File, Stream_Io.Mode (File.File)); - end Reset; - - - procedure Read (File : in out File_Type; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset; - From : in Stream_Io.Positive_Count) is - begin - Set_Index (File, From); - Read (File, Item, Last); - end Read; - - procedure Read (File : in out File_Type; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset) is - Index : constant Stream_Element_Offset := - Stream_Element_Offset (File.Index); - begin - Stream_Io.Read (File.File, Item, Last); - if Last < Item'Last then - TC_Assert (Item (Item'First .. Last) = - File.Contents (Index .. Index + Last - Item'First), - "Incorrect data read from file - 1"); - TC_Assert (Count (Index + Last - Item'First) = - Stream_Io.Size (File.File), - "Read stopped before end of file"); - File.Index := Count (Index + Last - Item'First) + 1; - else - TC_Assert (Item = File.Contents (Index .. Index + Item'Length - 1), - "Incorrect data read from file - 2"); - File.Index := File.Index + Item'Length; - end if; - end Read; - - procedure Write (File : in out File_Type; - Item : in Stream_Element_Array; - To : in Stream_Io.Positive_Count) is - begin - Set_Index (File, To); - Write (File, Item); - end Write; - - procedure Write (File : in out File_Type; - Item : in Stream_Element_Array) is - Index : constant Stream_Element_Offset := - Stream_Element_Offset (File.Index); - begin - Stream_Io.Write (File.File, Item); - File.Contents (Index .. Index + Item'Length - 1) := Item; - File.Index := File.Index + Item'Length; - TC_Assert (File.Index = Stream_Io.Index (File.File), - "Write failed to move the index"); - end Write; - - procedure Set_Index (File : in out File_Type; - To : in Stream_Io.Positive_Count) is - begin - Stream_Io.Set_Index (File.File, To); - File.Index := Stream_Io.Index (File.File); - TC_Assert (File.Index = To, "Set_Index failed"); - end Set_Index; - - function Index (File : in File_Type) return Stream_Io.Positive_Count is - New_Index : constant Count := Stream_Io.Index (File.File); - begin - TC_Assert (New_Index = File.Index, "Index changed unexpectedly"); - return New_Index; - end Index; - - procedure Set_Mode (File : in out File_Type; - Mode : in Stream_Io.File_Mode) is - Old_Index : constant Count := File.Index; - begin - Stream_Io.Set_Mode (File.File, Mode); - File.Index := Stream_Io.Index (File.File); - if Mode = Append_File then - TC_Assert (File.Index = Stream_Io.Size (File.File) + 1, - "Index /= Size + 1 -- Set_Mode - Append_File"); - else - TC_Assert (File.Index = Old_Index, "Set_Mode changed the index"); - end if; - end Set_Mode; - - end Checked_Stream_Io; - - package Csio renames Checked_Stream_Io; - - F : Csio.File_Type (100); - S : Stream_Element_Array (1 .. 10); - Last : Stream_Element_Offset; - -begin - - Test ("CXAC005", "Check that stream file positioning work as specified"); - - declare - Name : constant String := Legal_File_Name; - begin - begin - Csio.Create (F, Name => Name); - exception - when others => - Not_Applicable ("Files not supported - Creation with Out_File for Stream_IO"); - raise Incomplete; - end; - - for I in Stream_Element range 1 .. 10 loop - Csio.Write (F, ((1 => I + 2))); - end loop; - Csio.Write (F, (1 .. 15 => 11)); - Csio.Write (F, (1 .. 15 => 12), To => 15); - - Csio.Reset (F); - - for I in Stream_Element range 1 .. 10 loop - Csio.Write (F, (1 => I)); - end loop; - Csio.Write (F, (1 .. 15 => 13)); - Csio.Write (F, (1 .. 15 => 14), To => 15); - Csio.Write (F, (1 => 90)); - - Csio.Set_Mode (F, Stream_Io.In_File); - - Csio.Read (F, S, Last); - Csio.Read (F, S, Last, From => 3); - Csio.Read (F, S, Last, From => 28); - - Csio.Set_Mode (F, Stream_Io.Append_File); - Csio.Write (F, (1 .. 5 => 88)); - - Csio.Close (F); - - Csio.Open (F, Name => Name, Mode => Stream_Io.Append_File); - Csio.Write (F, (1 .. 3 => 33)); - - Csio.Set_Mode (F, Stream_Io.In_File); - Csio.Read (F, S, Last, From => 20); - Csio.Read (F, S, Last); - Csio.Reset (F, Stream_Io.Out_File); - - Csio.Write (F, (1 .. 9 => 99)); - - -- Check the contents of the entire file. - declare - S : Stream_Element_Array - (1 .. Stream_Element_Offset - (Stream_Io.Size (Csio.Stream_Io_File (F)))); - begin - Csio.Reset (F, Stream_Io.In_File); - Csio.Read (F, S, Last); - end; - - Csio.Delete (F); - end; - - Result; -exception - when Incomplete => - Report.Result; - when E:others => - Report.Failed ("Unexpected exception raised - " & Exception_Name (E) & - " - " & Exception_Message (E)); - Report.Result; - -end CXAC005; - diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a b/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a deleted file mode 100644 index cda8776a53d..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a +++ /dev/null @@ -1,291 +0,0 @@ --- CXACA01.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 default attributes 'Write and 'Read work properly when --- used with objects of a variety of types, including records with --- default discriminants, records without default discriminants, but --- which have the discriminant described in a representation clause for --- the type, and arrays. --- --- TEST DESCRIPTION: --- This test simulates a basic sales record system, using Stream_IO to --- allow the storage of heterogeneous data in a single stream file. --- --- Four types of data are written to the stream file for each product. --- First, the "header" information on the product is written. --- This is an object of a discriminated (with default) record --- type. This is followed by an integer object containing a count of --- the number of sales data records to follow. The corresponding number --- of sales records follow in the stream. These are of a record type --- with a discriminant without a default, but where the discriminant is --- included in the representation clause for the type. Finally, an --- array object with statistical sales information for the product is --- written to the stream. --- --- Objects of both record types specified below (discriminated records --- with defaults, and discriminated records w/o defaults that have the --- discriminant included in a representation clause for the type) should --- have their discriminants included in the stream when using 'Write. --- Likewise, discriminants should be extracted from the stream when --- using 'Read. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations that support external --- Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with FXACA00; -with Ada.Streams.Stream_IO; -with Report; - -procedure CXACA01 is - -begin - - Report.Test ("CXACA01", "Check that 'Write and 'Read work properly " & - "when used with complex data types"); - - Test_for_Stream_IO_Support: - declare - - Info_File : Ada.Streams.Stream_IO.File_Type; - Info_Stream : Ada.Streams.Stream_IO.Stream_Access; - The_Filename : constant String := Report.Legal_File_Name; - - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Info_File, - Ada.Streams.Stream_IO.Out_File, - The_Filename); - - Operational_Test_Block: - declare - - begin - - Info_Stream := Ada.Streams.Stream_IO.Stream (Info_File); - - -- Write all of the product information (record, integer, and array - -- objects) defined in package FXACA00 into the stream. - - Store_Data_Block: - begin - - -- Write information about first product to the stream. - FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_01); - Integer'Write (Info_Stream, FXACA00.Sale_Count_01); - FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_01); - FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_02); - FXACA00.Sales_Statistics_Type'Write - (Info_Stream, FXACA00.Product_01_Stats); - - -- Write information about second product to the stream. - -- Note: No Sales_Record_Type objects. - FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_02); - Integer'Write (Info_Stream, FXACA00.Sale_Count_02); - FXACA00.Sales_Statistics_Type'Write - (Info_Stream, FXACA00.Product_02_Stats); - - -- Write information about third product to the stream. - FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_03); - Integer'Write (Info_Stream, FXACA00.Sale_Count_03); - FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_03); - FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_04); - FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_05); - FXACA00.Sales_Statistics_Type'Write - (Info_Stream, FXACA00.Product_03_Stats); - - end Store_Data_Block; - - - Verify_Data_Block: - declare - - use FXACA00; -- Used within this block only. - - type Domestic_Rec_Array_Type is - array (Positive range <>) of Sales_Record_Type (Domestic); - - type Foreign_Rec_Array_Type is - array (Positive range <>) of Sales_Record_Type (Foreign); - - TC_Rec1 : Domestic_Rec_Array_Type (1..2); - TC_Rec3 : Foreign_Rec_Array_Type (1..3); - - TC_Product1 : Product_Type; - TC_Product2, - TC_Product3 : Product_Type (Foreign); - - TC_Count1, - TC_Count2, - TC_Count3 : Integer := -10; -- Initialized to dummy value. - - TC_Stat1, - TC_Stat2, - TC_Stat3 : Sales_Statistics_Type := (others => 500); - - begin - - Ada.Streams.Stream_IO.Reset (Info_File, - Ada.Streams.Stream_IO.In_File); - - -- Read all of the data that is contained in the stream. - -- Compare all data with the original data in package FXACA00 - -- that was written to the stream. - -- The calls to the read attribute are in anticipated order, based - -- on the order of data written to the stream. Possible errors, - -- such as data placement, overwriting, etc., will be manifest as - -- exceptions raised by the attribute during an unsuccessful read - -- attempt. - - -- Extract data on first product. - Product_Type'Read (Info_Stream, TC_Product1); - Integer'Read (Info_Stream, TC_Count1); - - -- Two "domestic" variant sales records will be read from the - -- stream. - for i in 1 .. TC_Count1 loop - Sales_Record_Type'Read (Info_Stream, TC_Rec1(i) ); - end loop; - - Sales_Statistics_Type'Read (Info_Stream, TC_Stat1); - - - -- Extract data on second product. - Product_Type'Read (Info_Stream, TC_Product2); - Integer'Read (Info_Stream, TC_Count2); - Sales_Statistics_Type'Read (Info_Stream, TC_Stat2); - - - -- Extract data on third product. - Product_Type'Read (Info_Stream, TC_Product3); - Integer'Read (Info_Stream, TC_Count3); - - -- Three "foreign" variant sales records will be read from the - -- stream. - for i in 1 .. TC_Count3 loop - Sales_Record_Type'Read (Info_Stream, TC_Rec3(i) ); - end loop; - - Sales_Statistics_Type'Read (Info_Stream, TC_Stat3); - - - -- After all the data has been correctly extracted, the file - -- should be empty. - - if not Ada.Streams.Stream_IO.End_Of_File (Info_File) then - Report.Failed ("Stream file not empty"); - end if; - - -- Verify that the data values read from the stream are the same - -- as those written to the stream. - - -- Verify the information of the first product. - if ((Product_01 /= TC_Product1) or else - (Product_01.Manufacture /= TC_Product1.Manufacture) or else - (Sale_Count_01 /= TC_Count1) or else - (Sale_Rec_01 /= TC_Rec1(1)) or else - (Sale_Rec_01.Buyer /= TC_Rec1(1).Buyer) or else - (Sale_Rec_02 /= TC_Rec1(2)) or else - (Sale_Rec_02.Buyer /= TC_Rec1(2).Buyer) or else - (Product_01_Stats /= TC_Stat1)) - then - Report.Failed ("Product 1 information incorrect"); - end if; - - -- Verify the information of the second product. - if not ((Product_02 = TC_Product2) and then - (Sale_Count_02 = TC_Count2) and then - (Product_02_Stats = TC_Stat2)) - then - Report.Failed ("Product 2 information incorrect"); - end if; - - -- Verify the information of the third product. - if ((Product_03 /= TC_Product3) or else - (Product_03.Manufacture /= TC_Product3.Manufacture) or else - (Sale_Count_03 /= TC_Count3) or else - (Sale_Rec_03 /= TC_Rec3(1)) or else - (Sale_Rec_03.Buyer /= TC_Rec3(1).Buyer) or else - (Sale_Rec_04 /= TC_Rec3(2)) or else - (Sale_Rec_04.Buyer /= TC_Rec3(2).Buyer) or else - (Sale_Rec_05 /= TC_Rec3(3)) or else - (Sale_Rec_05.Buyer /= TC_Rec3(3).Buyer) or else - (Product_03_Stats /= TC_Stat3)) - then - Report.Failed ("Product 3 information incorrect"); - end if; - - end Verify_Data_Block; - - exception - - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - if Ada.Streams.Stream_IO.Is_Open (Info_File) then - Ada.Streams.Stream_IO.Delete (Info_File); - else - Ada.Streams.Stream_IO.Open (Info_File, - Ada.Streams.Stream_IO.In_File, - The_Filename); - Ada.Streams.Stream_IO.Delete (Info_File); - end if; - - exception - - -- Since Use_Error or Name_Error can be raised if, for the specified - -- mode, the environment does not support Stream_IO operations, - -- the following handlers are included: - - when Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Stream IO Create"); - - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Stream IO Create"); - - when others => - Report.Failed ("Unexpected exception raised on Stream IO Create"); - - end Test_for_Stream_IO_Support; - - Report.Result; - -end CXACA01; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a b/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a deleted file mode 100644 index 5106dd3991d..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a +++ /dev/null @@ -1,360 +0,0 @@ --- CXACA02.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 user defined subprograms can override the default --- attributes 'Read and 'Write using attribute definition clauses. --- Use objects of record types. --- --- TEST DESCRIPTION: --- This test demonstrates that the default implementations of the --- 'Read and 'Write attributes can be overridden by user specified --- subprograms in conjunction with attribute definition clauses. --- These attributes have been overridden below, and in the user defined --- substitutes, values are added or subtracted to global variables. --- The global variables are evaluated to ensure that the user defined --- subprograms were used in overriding the type-related default --- attributes. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations that support external --- Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 21 Nov 95 SAIC Corrected recursive attribute definitions --- for ACVC 2.0.1. --- 24 Aug 96 SAIC Corrected typo in test verification criteria. --- ---! - -with Report; -with Ada.Streams.Stream_IO; - -procedure CXACA02 is -begin - - Report.Test ("CXACA02", "Check that user defined subprograms can " & - "override the default attributes 'Read and " & - "'Write using attribute definition clauses"); - - Test_for_Stream_IO_Support: - declare - - Data_File : Ada.Streams.Stream_IO.File_Type; - Data_Stream : Ada.Streams.Stream_IO.Stream_Access; - The_Filename : constant String := Report.Legal_File_Name; - - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Data_File, - Ada.Streams.Stream_IO.Out_File, - The_Filename); - - Operational_Test_Block: - declare - - type Origin_Type is (Foreign, Domestic); - subtype String_Data_Type is String(1..8); - - type Product_Type is - record - Item : String_Data_Type; - ID : Natural range 1..100; - Manufacture : Origin_Type := Domestic; - Distributor : String_Data_Type; - Importer : String_Data_Type; - end record; - - type Sales_Record_Type is - record - Name : String_Data_Type; - Sale_Item : Boolean := False; - Buyer : Origin_Type; - Quantity_Discount : Boolean; - Cash_Discount : Boolean; - end record; - - - -- Mode conformant, user defined subprograms that will override - -- the type-related attributes. - -- In this test, the user defines these subprograms to add/subtract - -- specific values from global variables. - - procedure Product_Read - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : out Product_Type ); - - procedure Product_Write - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : Product_Type ); - - procedure Sales_Read - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : out Sales_Record_Type ); - - procedure Sales_Write - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : Sales_Record_Type ); - - -- Attribute definition clauses. - - for Product_Type'Read use Product_Read; - for Product_Type'Write use Product_Write; - - for Sales_Record_Type'Read use Sales_Read; - for Sales_Record_Type'Write use Sales_Write; - - - -- Object Declarations - - Product_01 : Product_Type := - ("Product1", 1, Domestic, "Distrib1", "Import 1"); - Product_02 : Product_Type := - ("Product2", 2, Foreign, "Distrib2", "Import 2"); - - Sale_Rec_01 : Sales_Record_Type := - ("Buyer 01", False, Domestic, True, True); - Sale_Rec_02 : Sales_Record_Type := - ("Buyer 02", True, Domestic, True, False); - Sale_Rec_03 : Sales_Record_Type := (Name => "Buyer 03", - Sale_Item => True, - Buyer => Foreign, - Quantity_Discount => False, - Cash_Discount => True); - Sale_Rec_04 : Sales_Record_Type := - ("Buyer 04", True, Foreign, False, False); - Sale_Rec_05 : Sales_Record_Type := - ("Buyer 05", False, Foreign, False, False); - - TC_Read_Total : Integer := 100; - TC_Write_Total : Integer := 0; - - - -- Subprogram bodies. - -- These subprograms are designed to override the default attributes - -- 'Read and 'Write for the specified types. Each adds/subtracts - -- a quantity to/from a program control variable, indicating its - -- activity. In addition, each component of the record is - -- individually read from or written to the stream, using the - -- appropriate 'Read or 'Write attribute for the component type. - -- The string components are moved to/from the stream using the - -- 'Input and 'Output attributes for the string subtype, so that - -- the bounds of the strings are also written/read. - - procedure Product_Read - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : out Product_Type ) is - begin - TC_Read_Total := TC_Read_Total - 10; - - The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1. - Natural'Read(Data_Stream, The_Item.ID); -- Field 2. - Origin_Type'Read(Data_Stream, -- Field 3. - The_Item.Manufacture); - The_Item.Distributor := -- Field 4. - String_Data_Type'Input(Data_Stream); - The_Item.Importer := -- Field 5. - String_Data_Type'Input(Data_Stream); - end Product_Read; - - - procedure Product_Write - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : Product_Type ) is - begin - TC_Write_Total := TC_Write_Total + 5; - - String_Data_Type'Output(Data_Stream, The_Item.Item); -- Field 1. - Natural'Write(Data_Stream, The_Item.ID); -- Field 2. - Origin_Type'Write(Data_Stream, -- Field 3. - The_Item.Manufacture); - String_Data_Type'Output(Data_Stream, -- Field 4. - The_Item.Distributor); - String_Data_Type'Output(Data_Stream, -- Field 5. - The_Item.Importer); - end Product_Write; - - - procedure Sales_Read - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : out Sales_Record_Type ) is - begin - TC_Read_Total := TC_Read_Total - 20; - - The_Item.Name := String_Data_Type'Input(Data_Stream); -- Field 1. - Boolean'Read(Data_Stream, The_Item.Sale_Item); -- Field 2. - Origin_Type'Read(Data_Stream, The_Item.Buyer); -- Field 3. - Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4. - Boolean'Read(Data_Stream, The_Item.Cash_Discount); -- Field 5. - end Sales_Read; - - - procedure Sales_Write - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - The_Item : Sales_Record_Type ) is - begin - TC_Write_Total := TC_Write_Total + 10; - - String_Data_Type'Output(Data_Stream, The_Item.Name); -- Field 1. - Boolean'Write(Data_Stream, The_Item.Sale_Item); -- Field 2. - Origin_Type'Write(Data_Stream, The_Item.Buyer); -- Field 3. - Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4. - Boolean'Write(Data_Stream, The_Item.Cash_Discount); -- Field 5. - end Sales_Write; - - - - begin - - Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File); - - -- Write product and sales data to the stream. - - Product_Type'Write (Data_Stream, Product_01); - Sales_Record_Type'Write (Data_Stream, Sale_Rec_01); - Sales_Record_Type'Write (Data_Stream, Sale_Rec_02); - - Product_Type'Write (Data_Stream, Product_02); - Sales_Record_Type'Write (Data_Stream, Sale_Rec_03); - Sales_Record_Type'Write (Data_Stream, Sale_Rec_04); - Sales_Record_Type'Write (Data_Stream, Sale_Rec_05); - - -- Read data from the stream, and verify the use of the user specified - -- attributes. - - Verify_Data_Block: - declare - - TC_Product1, - TC_Product2 : Product_Type; - - TC_Sale1, - TC_Sale2, - TC_Sale3, - TC_Sale4, - TC_Sale5 : Sales_Record_Type; - - begin - - -- Reset the mode of the stream file so that Read/Input - -- operations may be performed. - - Ada.Streams.Stream_IO.Reset (Data_File, - Ada.Streams.Stream_IO.In_File); - - -- Data is read/reconstructed from the stream, in the order that - -- the data was placed into the stream. - - Product_Type'Read (Data_Stream, TC_Product1); - Sales_Record_Type'Read (Data_Stream, TC_Sale1); - Sales_Record_Type'Read (Data_Stream, TC_Sale2); - - Product_Type'Read (Data_Stream, TC_Product2); - Sales_Record_Type'Read (Data_Stream, TC_Sale3); - Sales_Record_Type'Read (Data_Stream, TC_Sale4); - Sales_Record_Type'Read (Data_Stream, TC_Sale5); - - -- Verify product data was correctly written to/read from stream. - - if TC_Product1 /= Product_01 then - Report.Failed ("Data verification error, Product 1"); - end if; - if TC_Product2 /= Product_02 then - Report.Failed ("Data verification error, Product 2"); - end if; - - if TC_Sale1 /= Sale_Rec_01 then - Report.Failed ("Data verification error, Sale_Rec_01"); - end if; - if TC_Sale2 /= Sale_Rec_02 then - Report.Failed ("Data verification error, Sale_Rec_02"); - end if; - if TC_Sale3 /= Sale_Rec_03 then - Report.Failed ("Data verification error, Sale_Rec_03"); - end if; - if TC_Sale4 /= Sale_Rec_04 then - Report.Failed ("Data verification error, Sale_Rec_04"); - end if; - if TC_Sale5 /= Sale_Rec_05 then - Report.Failed ("Data verification error, Sale_Rec_05"); - end if; - - -- Verify that the user defined subprograms were used to - -- override the default 'Read and 'Write attributes. - -- There were two "product" reads and two writes; there - -- were five "sale record" reads and five writes. - - if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then - Report.Failed ("Incorrect use of user defined attributes"); - end if; - - end Verify_Data_Block; - - exception - - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - if Ada.Streams.Stream_IO.Is_Open (Data_File) then - Ada.Streams.Stream_IO.Delete (Data_File); - else - Ada.Streams.Stream_IO.Open (Data_File, - Ada.Streams.Stream_IO.Out_File, - The_Filename); - Ada.Streams.Stream_IO.Delete (Data_File); - end if; - - - exception - - -- Since Use_Error or Name_Error can be raised if, for the specified - -- mode, the environment does not support Stream_IO operations, - -- the following handlers are included: - - when Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Stream IO Create"); - - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Stream IO Create"); - - when others => - Report.Failed ("Unexpected exception raised"); - - end Test_for_Stream_IO_Support; - - Report.Result; - -end CXACA02; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a b/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a deleted file mode 100644 index ac4a905e830..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a +++ /dev/null @@ -1,264 +0,0 @@ --- CXACB01.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 default attributes 'Input and 'Output work properly when --- used with objects of a variety of types, including two-dimensional --- arrays and records without default discriminants. --- --- TEST DESCRIPTION: --- This test simulates utility company service record storage, using --- Stream_IO to allow the storage of heterogeneous data in a single --- stream file. --- --- Three types of data are written to the stream file for each utility --- service customer. --- First, the general information on the customer is written. --- This is an object of a discriminated (without default) record --- type. This is followed by an integer object containing a count of --- the number of service months for the customer. Finally, a --- two-dimensional array object with monthly consumption information for --- the customer is written to the stream. --- --- Objects of record types with discriminants without defaults should --- have their discriminants included in the stream when using 'Output. --- Likewise, discriminants should be extracted --- from the stream when using 'Input. Similarly, array bounds are written --- to and read from the stream when using 'Output and 'Input with array --- objects. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations that support external --- Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with FXACB00; -with Ada.Streams.Stream_IO; -with Report; - -procedure CXACB01 is -begin - - Report.Test ("CXACB01", "Check that the default attributes 'Input and " & - "'Output work properly when used with objects " & - "of record, natural, and array types" ); - - Test_for_Stream_IO_Support: - declare - - Util_File : Ada.Streams.Stream_IO.File_Type; - Util_Stream : Ada.Streams.Stream_IO.Stream_Access; - Utility_Service_Filename : constant String := Report.Legal_File_Name; - - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Util_File, - Ada.Streams.Stream_IO.Out_File, - Utility_Service_Filename); - - Operational_Test_Block: - declare - - -- The following procedure will store all of the customer specific - -- information into the stream. - - procedure Store_Data_In_Stream - (Customer : in FXACB00.Service_Type; - Months : in FXACB00.Months_In_Service_Type; - History : in FXACB00.Service_History_Type) is - begin - FXACB00.Service_Type'Output (Util_Stream, Customer); - FXACB00.Months_In_Service_Type'Output (Util_Stream, Months); - FXACB00.Service_History_Type'Output (Util_Stream, History); - end Store_Data_In_Stream; - - - -- The following procedure will remove from the stream all of the - -- customer related information. - - procedure Retrieve_Data_From_Stream - (Customer : out FXACB00.Service_Type; - Months : out FXACB00.Months_In_Service_Type; - History : out FXACB00.Service_History_Type) is - begin - Customer := FXACB00.Service_Type'Input (Util_Stream); - Months := FXACB00.Months_In_Service_Type'Input (Util_Stream); - History := FXACB00.Service_History_Type'Input (Util_Stream); - end Retrieve_Data_From_Stream; - - - begin - - Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File); - - -- Write all of the customer service information (record, numeric, - -- and array objects) defined in package FXACB00 into the stream. - - Data_Storage_Block: - begin - - Store_Data_In_Stream (Customer => FXACB00.Customer1, - Months => FXACB00.C1_Months, - History => FXACB00.C1_Service_History); - - Store_Data_In_Stream (FXACB00.Customer2, - FXACB00.C2_Months, - History => FXACB00.C2_Service_History); - - Store_Data_In_Stream (Months => FXACB00.C3_Months, - History => FXACB00.C3_Service_History, - Customer => FXACB00.Customer3); - end Data_Storage_Block; - - - Data_Verification_Block: - declare - - TC_Residence : FXACB00.Service_Type (FXACB00.Residence); - TC_Apartment : FXACB00.Service_Type (FXACB00.Apartment); - TC_Commercial : FXACB00.Service_Type (FXACB00.Commercial); - - - TC_Months1, - TC_Months2, - TC_Months3 : FXACB00.Months_In_Service_Type := - FXACB00.Months_In_Service_Type'First; - - - TC_History1 : - FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type, - FXACB00.Month_In_Quarter_Type) := - (others => (others => FXACB00.Electric_Usage_Type'Last)); - - TC_History2 : - FXACB00.Service_History_Type - (FXACB00.Quarterly_Period_Type range - FXACB00.Spring .. FXACB00.Summer, - FXACB00.Month_In_Quarter_Type) := - (others => (others => FXACB00.Electric_Usage_Type'Last)); - - TC_History3 : - FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type, - FXACB00.Month_In_Quarter_Type) := - (others => (others => FXACB00.Electric_Usage_Type'Last)); - - begin - - Ada.Streams.Stream_IO.Reset (Util_File, - Ada.Streams.Stream_IO.In_File); - - -- Input all of the data that is contained in the stream. - -- Compare all data with the original data in package FXACB00 - -- that was written to the stream. - - Retrieve_Data_From_Stream (TC_Residence, TC_Months1, TC_History1); - Retrieve_Data_From_Stream (TC_Apartment, TC_Months2, TC_History2); - Retrieve_Data_From_Stream (Customer => TC_Commercial, - Months => TC_Months3, - History => TC_History3); - - -- After all the data has been correctly extracted, the file - -- should be empty. - - if not Ada.Streams.Stream_IO.End_Of_File (Util_File) then - Report.Failed ("Stream file not empty"); - end if; - - -- Verify that the data values read from the stream are the same - -- as those written to the stream. - - if ((FXACB00."/="(FXACB00.Customer1, TC_Residence)) or else - (FXACB00."/="(FXACB00.Customer2, TC_Apartment)) or else - (FXACB00."/="(FXACB00.Customer3, TC_Commercial))) - then - Report.Failed ("Customer information incorrect"); - end if; - - if ((FXACB00."/="(FXACB00.C1_Months, TC_Months1)) or - (FXACB00."/="(FXACB00.C2_Months, TC_Months2)) or - (FXACB00."/="(FXACB00.C3_Months, TC_Months3))) - then - Report.Failed ("Number of Months information incorrect"); - end if; - - if not ((FXACB00."="(FXACB00.C1_Service_History, TC_History1)) and - (FXACB00."="(FXACB00.C2_Service_History, TC_History2)) and - (FXACB00."="(FXACB00.C3_Service_History, TC_History3))) - then - Report.Failed ("Service history information incorrect"); - end if; - - end Data_Verification_Block; - - exception - - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - -- Delete the file. - if Ada.Streams.Stream_IO.Is_Open (Util_File) then - Ada.Streams.Stream_IO.Delete (Util_File); - else - Ada.Streams.Stream_IO.Open (Util_File, - Ada.Streams.Stream_IO.Out_File, - Utility_Service_Filename); - Ada.Streams.Stream_IO.Delete (Util_File); - end if; - - - exception - - -- Since Use_Error or Name_Error can be raised if, for the specified - -- mode, the environment does not support Stream_IO operations, - -- the following handlers are included: - - when Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Stream IO Create"); - - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Stream IO Create"); - - when others => - Report.Failed ("Unexpected exception raised"); - - end Test_for_Stream_IO_Support; - - Report.Result; - -end CXACB01; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a b/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a deleted file mode 100644 index a0ade9ebe1c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a +++ /dev/null @@ -1,421 +0,0 @@ --- CXACB02.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 user defined subprograms can override the default --- attributes 'Input and 'Output using attribute definition clauses, --- when used with objects of discriminated record and multi-dimensional --- array types. --- --- TEST DESCRIPTION: --- This test demonstrates that the default implementations of the --- 'Input and 'Output attributes can be overridden by user specified --- subprograms in conjunction with attribute definition clauses. --- These attributes have been overridden below, and in the user defined --- substitutes, values are added or subtracted to global variables. --- Following the completion of the writing/reading test, the global --- variables are evaluated to ensure that the user defined subprograms --- were used in overriding the type-related default attributes. --- --- APPLICABILITY CRITERIA: --- Applicable to all implementations that support external --- Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 14 Nov 95 SAIC Corrected test errors for ACVC 2.0.1. --- ---! - -with Report; -with Ada.Streams.Stream_IO; - -procedure CXACB02 is -begin - - Report.Test ("CXACB02", "Check that user defined subprograms can " & - "override the default attributes 'Input and " & - "'Output using attribute definition clauses"); - - Test_for_Stream_IO_Support: - declare - - Util_File : Ada.Streams.Stream_IO.File_Type; - Util_Stream : Ada.Streams.Stream_IO.Stream_Access; - Utility_Filename : constant String := Report.Legal_File_Name; - - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Util_File, - Ada.Streams.Stream_IO.Out_File, - Utility_Filename); - - Operational_Test_Block: - declare - - type Customer_Type is (Residence, Apartment, Commercial); - type Electric_Usage_Type is range 0..100000; - type Months_In_Service_Type is range 1..12; - type Quarterly_Period_Type is (Spring, Summer, Autumn, Winter); - subtype Month_In_Quarter_Type is Positive range 1..3; - type Service_History_Type is - array (Quarterly_Period_Type range <>, - Month_In_Quarter_Type range <>) of Electric_Usage_Type; - - type Service_Type (Customer : Customer_Type) is - record - Name : String (1..21); - Account_ID : Natural range 0..100; - case Customer is - when Residence | Apartment => - Low_Income_Credit : Boolean := False; - when Commercial => - Baseline_Allowance : Natural range 0..1000; - Quantity_Discount : Boolean := False; - end case; - end record; - - - -- Mode conformant, user defined subprograms that will override - -- the type-related attributes. - -- In this test, the user defines these subprograms to add/subtract - -- specific values from global variables. - - function Service_Input - (Stream : access Ada.Streams.Root_Stream_Type'Class) - return Service_Type; - - procedure Service_Output - (Stream : access Ada.Streams.Root_Stream_Type'Class; - Item : Service_Type); - - function History_Input - (Stream : access Ada.Streams.Root_Stream_Type'Class) - return Service_History_Type; - - procedure History_Output - (Stream : access Ada.Streams.Root_Stream_Type'Class; - Item : Service_History_Type); - - - -- Attribute definition clauses. - - for Service_Type'Input use Service_Input; - for Service_Type'Output use Service_Output; - - for Service_History_Type'Input use History_Input; - for Service_History_Type'Output use History_Output; - - - -- Object Declarations - - Customer1 : Service_Type (Residence) := - (Residence, "1221 Morningstar Lane", 44, False); - Customer2 : Service_Type (Apartment) := - (Customer => Apartment, - Account_ID => 67, - Name => "15 South Front St. #8", - Low_Income_Credit => True); - Customer3 : Service_Type (Commercial) := - (Commercial, - "12442 Central Avenue ", - 100, - Baseline_Allowance => 938, - Quantity_Discount => True); - - C1_Service_History : - Service_History_Type (Quarterly_Period_Type, - Month_In_Quarter_Type) := - (Spring => (1 => 35, 2 => 39, 3 => 32), - Summer => (1 => 34, 2 => 33, 3 => 39), - Autumn => (1 => 45, 2 => 40, 3 => 38), - Winter => (1 => 53, 2 => 0, 3 => 0)); - - C2_Service_History : - Service_History_Type (Quarterly_Period_Type range Spring..Summer, - Month_In_Quarter_Type) := - (Spring => (23, 22, 0), Summer => (0, 0, 0)); - - C3_Service_History : - Service_History_Type (Quarterly_Period_Type, - Month_In_Quarter_Type) := - (others => (others => 200)); - - - TC_Input_Total : Integer := 0; - TC_Output_Total : Integer := 0; - - - -- Subprogram bodies. - -- These subprograms are designed to override the default attributes - -- 'Input and 'Output for the specified types. Each adds/subtracts - -- a quantity to/from a program control variable, indicating its - -- activity. Each user defined "Input" function uses the 'Read - -- attribute for the type to accomplish the operation. Likewise, - -- each user defined "Output" subprogram uses the 'Write attribute - -- for the type. - - function Service_Input - ( Stream : access Ada.Streams.Root_Stream_Type'Class ) - return Service_Type is - Customer : Customer_Type; - begin - TC_Input_Total := TC_Input_Total + 1; - - -- Extract the discriminant value from the stream. - -- This discriminant would not otherwise be extracted from the - -- stream when the Service_Type'Read attribute is used below. - Customer_Type'Read (Stream, Customer); - - declare - -- Declare a constant of Service_Type, using the value just - -- read from the stream as the discriminant value of the - -- object. - Service : Service_Type(Customer); - begin - Service_Type'Read (Stream, Service); - return Service; - end; - end Service_Input; - - - procedure Service_Output - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - Item : Service_Type ) is - begin - TC_Output_Total := TC_Output_Total + 2; - -- Write the discriminant value to the stream. - -- The attribute 'Write (for the record type) will not write the - -- discriminant of the record object to the stream. Therefore, it - -- must be explicitly written using the 'Write attribute of the - -- discriminant type. - Customer_Type'Write (Stream, Item.Customer); - -- Write the record component values (but not the discriminant) to - -- the stream. - Service_Type'Write (Stream, Item); - end Service_Output; - - - function History_Input - ( Stream : access Ada.Streams.Root_Stream_Type'Class ) - return Service_History_Type is - Quarter_Bound_Low : Quarterly_Period_Type; - Quarter_Bound_High : Quarterly_Period_Type; - Month_Bound_Low : Month_In_Quarter_Type; - Month_Bound_High : Month_In_Quarter_Type; - begin - TC_Input_Total := TC_Input_Total + 3; - - -- Read the value of the array bounds from the stream. - -- Use these bounds in the creation of an array object that will - -- be used to store data from the stream. - -- The array bound values would not otherwise be read from the - -- stream by use of the Service_History_Type'Read attribute. - Quarterly_Period_Type'Read (Stream, Quarter_Bound_Low); - Quarterly_Period_Type'Read (Stream, Quarter_Bound_High); - Month_In_Quarter_Type'Read (Stream, Month_Bound_Low); - Month_In_Quarter_Type'Read (Stream, Month_Bound_High); - - declare - Service_History_Array : - Service_History_Type - (Quarterly_Period_Type range - Quarter_Bound_Low..Quarter_Bound_High, - Month_In_Quarter_Type range - Month_Bound_Low .. Month_Bound_High); - begin - Service_History_Type'Read (Stream, Service_History_Array); - return Service_History_Array; - end; - end History_Input; - - - procedure History_Output - ( Stream : access Ada.Streams.Root_Stream_Type'Class; - Item : Service_History_Type ) is - begin - TC_Output_Total := TC_Output_Total + 7; - -- Write the upper/lower bounds of the array object dimensions to - -- the stream. - Quarterly_Period_Type'Write (Stream, Item'First(1)); - Quarterly_Period_Type'Write (Stream, Item'Last(1)); - Month_In_Quarter_Type'Write (Stream, Item'First(2)); - Month_In_Quarter_Type'Write (Stream, Item'Last(2)); - -- Write the array values to the stream in canonical order (last - -- dimension varying fastest). - Service_History_Type'Write (Stream, Item); - end History_Output; - - - - begin - - Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File); - - -- Write data to the stream. A customer service record is followed - -- by a service history array. - - Service_Type'Output (Util_Stream, Customer1); - Service_History_Type'Output (Util_Stream, C1_Service_History); - - Service_Type'Output (Util_Stream, Customer2); - Service_History_Type'Output (Util_Stream, C2_Service_History); - - Service_Type'Output (Util_Stream, Customer3); - Service_History_Type'Output (Util_Stream, C3_Service_History); - - - -- Read data from the stream, and verify the use of the user specified - -- attributes. - - Verify_Data_Block: - declare - - TC_Residence : Service_Type (Residence); - TC_Apartment : Service_Type (Apartment); - TC_Commercial : Service_Type (Commercial); - - TC_History1 : Service_History_Type (Quarterly_Period_Type, - Month_In_Quarter_Type) := - (others => (others => Electric_Usage_Type'First)); - - TC_History2 : Service_History_Type (Quarterly_Period_Type - range Spring .. Summer, - Month_In_Quarter_Type) := - (others => (others => Electric_Usage_Type'First)); - - TC_History3 : Service_History_Type (Quarterly_Period_Type, - Month_In_Quarter_Type) := - (others => (others => Electric_Usage_Type'First)); - - begin - - -- Reset Stream file to mode In_File. - - Ada.Streams.Stream_IO.Reset (Util_File, - Ada.Streams.Stream_IO.In_File); - - -- Read data from the stream. - - TC_Residence := Service_Type'Input (Util_Stream); - TC_History1 := Service_History_Type'Input (Util_Stream); - - TC_Apartment := Service_Type'Input (Util_Stream); - TC_History2 := Service_History_Type'Input (Util_Stream); - - TC_Commercial := Service_Type'Input (Util_Stream); - TC_History3 := Service_History_Type'Input (Util_Stream); - - - -- Verify product data was correctly written to/read from stream, - -- including discriminants and array bounds. - - if (TC_Residence /= Customer1) or - (TC_Residence.Customer /= Customer1.Customer) or - (TC_History1'Last(1) /= C1_Service_History'Last(1)) or - (TC_History1'First(1) /= C1_Service_History'First(1)) or - (TC_History1'Last(2) /= C1_Service_History'Last(2)) or - (TC_History1'First(2) /= C1_Service_History'First(2)) - then - Report.Failed ("Incorrect data from stream - 1"); - end if; - - if (TC_Apartment /= Customer2) or - (TC_Apartment.Customer /= Customer2.Customer) or - (TC_History2 /= C2_Service_History) or - (TC_History2'Last(1) /= C2_Service_History'Last(1)) or - (TC_History2'First(1) /= C2_Service_History'First(1)) or - (TC_History2'Last(2) /= C2_Service_History'Last(2)) or - (TC_History2'First(2) /= C2_Service_History'First(2)) - then - Report.Failed ("Incorrect data from stream - 2"); - end if; - - if (TC_Commercial /= Customer3) or - (TC_Commercial.Customer /= Customer3.Customer) or - (TC_History3 /= C3_Service_History) or - (TC_History3'Last(1) /= C3_Service_History'Last(1)) or - (TC_History3'First(1) /= C3_Service_History'First(1)) or - (TC_History3'Last(2) /= C3_Service_History'Last(2)) or - (TC_History3'First(2) /= C3_Service_History'First(2)) - then - Report.Failed ("Incorrect data from stream - 3"); - end if; - - -- Verify that the user defined subprograms were used to override - -- the default 'Input and 'Output attributes. - -- There were three calls on each of the user defined attributes. - - if (TC_Input_Total /= 12 ) or (TC_Output_Total /= 27 ) then - Report.Failed ("Incorrect use of user defined attributes"); - end if; - - end Verify_Data_Block; - - exception - - when others => - Report.Failed ("Exception raised in Operational Test Block"); - - end Operational_Test_Block; - - if Ada.Streams.Stream_IO.Is_Open (Util_File) then - Ada.Streams.Stream_IO.Delete (Util_File); - else - Ada.Streams.Stream_IO.Open (Util_File, - Ada.Streams.Stream_IO.Out_File, - Utility_Filename); - Ada.Streams.Stream_IO.Delete (Util_File); - end if; - - - exception - - -- Since Use_Error or Name_Error can be raised if, for the specified - -- mode, the environment does not support Stream_IO operations, - -- the following handlers are included: - - when Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable ("Name_Error raised on Stream IO Create"); - - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable ("Use_Error raised on Stream IO Create"); - - when others => - Report.Failed ("Unexpected exception raised"); - - end Test_for_Stream_IO_Support; - - Report.Result; - -end CXACB02; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a b/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a deleted file mode 100644 index 3ab88f40e6d..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a +++ /dev/null @@ -1,299 +0,0 @@ --- CXACC01.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 use of 'Class'Output and 'Class'Input allow stream --- manipulation of objects of non-limited class-wide types. --- --- TEST DESCRIPTION: --- This test demonstrates the uses of 'Class'Output and 'Class'Input --- in moving objects of a particular class to and from a stream file. --- A procedure uses a class-wide parameter to move objects of specific --- types in the class to the stream, using the 'Class'Output attribute --- of the root type of the class. A function returns a class-wide object, --- using the 'Class'Input attribute of the root type of the class to --- extract the object from the stream. --- A field-by-field comparison of record objects is performed to validate --- the data read from the stream. Operator precedence rules are used --- in the comparison rather than parentheses. --- --- APPLICABILITY CRITERIA: --- This test is applicable to all implementations capable of supporting --- external Stream_IO files. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 14 Nov 95 SAIC Corrected prefix of 'Tag attribute for ACVC 2.0.1. --- 24 Aug 96 SAIC Changed a call to "Create" to "Reset". --- 26 Feb 97 CTA.PWB Allowed for non-support of some IO operations. ---! - -with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report; - -procedure CXACC01 is - - Order_File : Ada.Streams.Stream_IO.File_Type; - Order_Stream : Ada.Streams.Stream_IO.Stream_Access; - Order_Filename : constant String := - Report.Legal_File_Name ( Nam => "CXACC01" ); - Incomplete : exception; - -begin - - Report.Test ("CXACC01", "Check that the use of 'Class'Output " & - "and 'Class'Input allow stream manipulation " & - "of objects of non-limited class-wide types"); - - Test_for_Stream_IO_Support: - begin - - -- If an implementation does not support Stream_IO in a particular - -- environment, the exception Use_Error or Name_Error will be raised on - -- calls to various Stream_IO operations. This block statement - -- encloses a call to Create, which should produce an exception in a - -- non-supportive environment. These exceptions will be handled to - -- produce a Not_Applicable result. - - Ada.Streams.Stream_IO.Create (Order_File, - Ada.Streams.Stream_IO.Out_File, - Order_Filename); - - exception - - when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error => - Report.Not_Applicable - ( "Files not supported - Create as Out_File for Stream_IO" ); - raise Incomplete; - - end Test_for_Stream_IO_Support; - - Operational_Test_Block: - declare - - -- Store tag values associated with objects of tagged types. - - TC_Box_Office_Tag : constant String := - Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag); - - TC_Summer_Tag : constant String := - Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag); - - TC_Mayoral_Tag : constant String := - Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag); - - TC_Late_Tag : constant String := - Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag); - - -- The following procedure will take an object of the Ticket_Request - -- class and output it to the stream. Objects of any extended type - -- in the class can be output to the stream with this procedure. - - procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is - begin - FXACC00.Ticket_Request'Class'Output (Order_Stream, Order); - end Order_Entry; - - - -- The following function will retrieve from the stream an object of - -- the Ticket_Request class. - - function Order_Retrieval return FXACC00.Ticket_Request'Class is - begin - return FXACC00.Ticket_Request'Class'Input (Order_Stream); - end Order_Retrieval; - - begin - - Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File); - - -- Store the data objects in the stream. - -- Each of the objects is of a different type within the class. - - Order_Entry (FXACC00.Box_Office_Request); -- Object of root type - Order_Entry (FXACC00.Summer_Subscription); -- Obj. of extended type - Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type - Order_Entry (FXACC00.Late_Request); -- Object of twice - -- extended type. - - -- Reset mode of stream to In_File prior to reading data from it. - Reset1: - begin - Ada.Streams.Stream_IO.Reset (Order_File, - Ada.Streams.Stream_IO.In_File); - exception - when Ada.Streams.Stream_IO.Use_Error => - Report.Not_Applicable - ( "Reset to In_File not supported for Stream_IO - 1" ); - raise Incomplete; - end Reset1; - - Process_Order_Block: - declare - - use FXACC00; - - -- Declare variables of the root type class, - -- and initialize them with class-wide objects returned from - -- the stream as function result. - - Order_1 : Ticket_Request'Class := Order_Retrieval; - Order_2 : Ticket_Request'Class := Order_Retrieval; - Order_3 : Ticket_Request'Class := Order_Retrieval; - Order_4 : Ticket_Request'Class := Order_Retrieval; - - -- Declare objects of the specific types from within the class - -- that correspond to the types of the data written to the - -- stream. Perform a type conversion on the class-wide objects. - - Ticket_Order : Ticket_Request := - Ticket_Request(Order_1); - Subscriber_Order : Subscriber_Request := - Subscriber_Request(Order_2); - VIP_Order : VIP_Request := - VIP_Request(Order_3); - Last_Minute_Order : Last_Minute_Request := - Last_Minute_Request(Order_4); - - begin - - -- Perform a field-by-field comparison of all the class-wide - -- objects input from the stream with specific type objects - -- originally written to the stream. - - if Ticket_Order.Location /= - Box_Office_Request.Location or - Ticket_Order.Number_Of_Tickets /= - Box_Office_Request.Number_Of_Tickets - then - Report.Failed ("Ticket_Request object validation failure"); - end if; - - if Subscriber_Order.Location /= - Summer_Subscription.Location or - Subscriber_Order.Number_Of_Tickets /= - Summer_Subscription.Number_Of_Tickets or - Subscriber_Order.Subscription_Number /= - Summer_Subscription.Subscription_Number - then - Report.Failed ("Subscriber_Request object validation failure"); - end if; - - if VIP_Order.Location /= - Mayoral_Ticket_Request.Location or - VIP_Order.Number_Of_Tickets /= - Mayoral_Ticket_Request.Number_Of_Tickets or - VIP_Order.Rank /= - Mayoral_Ticket_Request.Rank - then - Report.Failed ("VIP_Request object validation failure"); - end if; - - if Last_Minute_Order.Location /= - Late_Request.Location or - Last_Minute_Order.Number_Of_Tickets /= - Late_Request.Number_Of_Tickets or - Last_Minute_Order.Rank /= - Late_Request.Rank or - Last_Minute_Order.Special_Consideration /= - Late_Request.Special_Consideration or - Last_Minute_Order.Donation /= - Late_Request.Donation - then - Report.Failed ("Last_Minute_Request object validation failure"); - end if; - - -- Verify tag values from before and after processing. - -- The 'Tag attribute is used with objects of a class-wide type. - - if TC_Box_Office_Tag /= - Ada.Tags.External_Tag(Order_1'Tag) - then - Report.Failed("Failed tag comparison - 1"); - end if; - - if TC_Summer_Tag /= - Ada.Tags.External_Tag(Order_2'Tag) - then - Report.Failed("Failed tag comparison - 2"); - end if; - - if TC_Mayoral_Tag /= - Ada.Tags.External_Tag(Order_3'Tag) - then - Report.Failed("Failed tag comparison - 3"); - end if; - - if TC_Late_Tag /= - Ada.Tags.External_Tag(Order_4'Tag) - then - Report.Failed("Failed tag comparison - 4"); - end if; - - end Process_Order_Block; - - -- After all the data has been correctly extracted, the file - -- should be empty. - - if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then - Report.Failed ("Stream file not empty"); - end if; - - exception - when Incomplete => - raise; - when Constraint_Error => - Report.Failed ("Constraint_Error raised in Operational Block"); - when others => - Report.Failed ("Exception raised in Operational Test Block"); - end Operational_Test_Block; - - Deletion: - begin - if Ada.Streams.Stream_IO.Is_Open (Order_File) then - Ada.Streams.Stream_IO.Delete (Order_File); - else - Ada.Streams.Stream_IO.Open (Order_File, - Ada.Streams.Stream_IO.Out_File, - Order_Filename); - Ada.Streams.Stream_IO.Delete (Order_File); - end if; - exception - when others => - Report.Failed - ( "Delete not properly implemented for Stream_IO" ); - end Deletion; - - Report.Result; - -exception - - when Incomplete => - Report.Result; - when others => - Report.Failed ( "Unexpected exception" ); - Report.Result; - -end CXACC01; diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a b/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a deleted file mode 100644 index ae3497abde0..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a +++ /dev/null @@ -1,199 +0,0 @@ --- CXAF001.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 an implementation supports the functionality defined --- in Package Ada.Command_Line. --- --- TEST DESCRIPTION: --- This test verifies that an implementation supports the subprograms --- contained in package Ada.Command_Line. Each of the subprograms --- is exercised in a general sense, to ensure that it is available, --- and that it provides the prescribed results in a known test --- environment. Function Argument_Count must return zero, or the --- number of arguments passed to the program calling it. Function --- Argument is called with a parameter value one greater than the --- actual number of arguments passed to the executing program, which --- must result in Constraint_Error being raised. Function Command_Name --- should return the name of the executing program that called it --- (specifically, this test name). Function Set_Exit_Status is called --- with two different parameter values, the constants Failure and --- Success defined in package Ada.Command_Line. --- --- The setting of the variable TC_Verbose allows for some additional --- output to be displayed during the running of the test as an aid in --- tracing the processing flow of the test. --- --- APPLICABILITY CRITERIA: --- This test is applicable to implementations that support the --- declaration of package Command_Line as defined in the Ada Reference --- manual. --- An alternative declaration is allowed for package Command_Line if --- different functionality is appropriate for the external execution --- environment. --- --- --- CHANGE HISTORY: --- 10 Jul 95 SAIC Initial prerelease version. --- 02 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. --- 05 AUG 98 EDS Allow Null string result to be returned from --- Function Command ---! - -with Ada.Command_Line; -with Ada.Exceptions; -with Report; - -procedure CXAF001 is -begin - - Report.Test ("CXAF001", "Check that an implementation supports the " & - "functionality defined in Package " & - "Ada.Command_Line"); - - Test_Block: - declare - - use Ada.Exceptions; - - type String_Access is access all String; - - TC_Verbose : Boolean := False; - Number_Of_Arguments : Natural := Natural'Last; - Name_Of_Command : String_Access; - - begin - - -- Check the result of function Argument_Count. - -- Note: If the external environment does not support passing arguments - -- to the program invoking the function, the function result - -- will be zero. - - Number_Of_Arguments := Ada.Command_Line.Argument_Count; - if Number_Of_Arguments = Natural'Last then - Report.Failed("Argument_Count did not provide a return result"); - end if; - if TC_Verbose then - Report.Comment - ("Argument_Count = " & Integer'Image(Number_Of_Arguments)); - end if; - - - -- Check that the result of Function Argument is Constraint_Error - -- when the Number argument is outside the range of 1..Argument_Count. - - Test_Function_Argument_1 : - begin - declare - - -- Define a value that will be outside the range of - -- 1..Argument_Count. - -- Note: If the external execution environment does not support - -- passing arguments to a program, then Argument(N) for - -- any N will raise Constraint_Error, since - -- Argument_Count = 0; - - Arguments_Plus_One : Positive := - Ada.Command_Line.Argument_Count + 1; - - -- Using the above value in a call to Argument must result in - -- the raising of Constraint_Error. - - Argument_String : constant String := - Ada.Command_Line.Argument(Arguments_Plus_One); - - begin - Report.Failed("Constraint_Error not raised by Function " & - "Argument when provided a Number argument " & - "out of range"); - end; - exception - when Constraint_Error => null; -- OK, expected exception. - if TC_Verbose then - Report.Comment ("Argument_Count raised Constraint_Error"); - end if; - when others => - Report.Failed ("Unexpected exception raised by Argument " & - "in Test_Function_Argument_1 block"); - end Test_Function_Argument_1; - - - -- Check that Function Argument returns a string result. - - Test_Function_Argument_2 : - begin - if Ada.Command_Line.Argument_Count > 0 then - Report.Comment - ("Last argument is: " & - Ada.Command_Line.Argument(Ada.Command_Line.Argument_Count)); - elsif TC_Verbose then - Report.Comment("Argument_Count is zero, no test of Function " & - "Argument for string result"); - end if; - exception - when others => - Report.Failed ("Unexpected exception raised by Argument " & - "in Test_Function_Argument_2 block"); - end Test_Function_Argument_2; - - - -- Check the result of Function Command_Name. - - Name_Of_Command := new String'(Ada.Command_Line.Command_Name); - - if Name_Of_Command = null then - Report.Failed("Null string pointer returned from Function Command"); - elsif Name_Of_Command.all = "" then - Report.Comment("Null string result returned from Function Command"); - elsif TC_Verbose then - Report.Comment("Invoking command is " & Name_Of_Command.all); - end if; - - - -- Check that procedure Set_Exit_Status is available. - -- Note: If the external execution environment does not support - -- returning an exit value from a program, then Set_Exit_Status - -- does nothing. - - Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); - if TC_Verbose then - Report.Comment("Exit status set to Failure"); - end if; - - Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); - if TC_Verbose then - Report.Comment("Exit status set to Success"); - 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 CXAF001; |