| -- 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; |
