diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxa4027.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxa/cxa4027.a | 342 |
1 files changed, 0 insertions, 342 deletions
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; |