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