ADDED natools-chunked_strings-tests-cxa4010.adb Index: natools-chunked_strings-tests-cxa4010.adb ================================================================== --- natools-chunked_strings-tests-cxa4010.adb +++ natools-chunked_strings-tests-cxa4010.adb @@ -0,0 +1,137 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Strings; use Ada.Strings; + +procedure Natools.Chunked_Strings.Tests.CXA4010 + (Report : in out Natools.Tests.Reporter'Class) is +begin + Natools.Tests.Section (Report, "Port of ACATS CXA4010"); + + declare + + Pamphlet_Paragraph_Count : constant := 2; + Lines : constant := 4; + Line_Length : constant := 40; + + type Document_Type is array (Positive range <>) of Chunked_String; + + type Camera_Ready_Copy_Type is + array (1 .. Lines) of String (1 .. Line_Length); + + procedure Enter_Text_Into_Document (Document : in out Document_Type); + procedure Create_Camera_Ready_Copy + (Document : in Document_Type; + Camera_Copy : out Camera_Ready_Copy_Type); + procedure Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type); + + Pamphlet : Document_Type (1 .. Pamphlet_Paragraph_Count); + Camera_Ready_Copy : Camera_Ready_Copy_Type := + (others => (others => Ada.Strings.Space)); + TC_Finished_Product : constant 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 + Document (1) := To_Chunked_String ("Ada is a language"); + Document (1) := Insert (Document (1), + Index (Document (1), "language"), + To_String ("progra" + & Chunked_Strings."*" (2, 'm') + & "ing ")); + Document (1) := + Overwrite (Document (1), + Index (Document (1), + To_String (Tail (Document (1), 8, ' ')), + Ada.Strings.Backward), + "language designed to support long-lifed"); + Document (1) := + Overwrite (Document (1), + Index (Document (1), + To_String (Tail (Document (1), 5, ' ')), + Ada.Strings.Backward), + "lived, reliable software systems."); + Document (2) := 'G' + & To_Chunked_String ("o ") + & To_Chunked_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 + Camera_Copy (1) := + Slice (Document (1), + 1, + Index (To_Chunked_String (Slice (Document (1), + 1, Line_Length)), + Ada.Strings.Maps.To_Set (' '), + Ada.Strings.Inside, + Ada.Strings.Backward)) + & ' '; + Camera_Copy (2) := + Slice (Document (1), + 40, + Index_Non_Blank (To_Chunked_String (Slice (Document (1), + 40, 79)), + Ada.Strings.Backward) + 39); + Camera_Copy (3) (1 .. 9) := + Slice (Document (1), 80, Length (Document (1))); + Camera_Copy (4) (1 .. Length (Document (2))) := + To_String (Head (Document (2), Length (Document (2)))); + end Create_Camera_Ready_Copy; + + + procedure Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) is + begin + for I in Draft'Range loop + declare + Name : constant String := "Slice" & Positive'Image (I); + begin + if Draft (I) = Master (I) then + Natools.Tests.Item (Report, Name, Natools.Tests.Success); + else + Natools.Tests.Item (Report, Name, Natools.Tests.Fail); + Natools.Tests.Info (Report, "Draft: """ & Draft (I) & '"'); + Natools.Tests.Info (Report, "Master: """ & Master (I) & '"'); + end if; + exception + when Error : others => + Natools.Tests.Report_Exception (Report, Name, Error); + end; + end loop; + end Valid_Proofread; + begin + Enter_Text_Into_Document (Pamphlet); + Create_Camera_Ready_Copy (Document => Pamphlet, + Camera_Copy => Camera_Ready_Copy); + Valid_Proofread (Draft => Camera_Ready_Copy, + Master => TC_Finished_Product); + exception + when Error : others => + Natools.Tests.Report_Exception (Report, "Preparation", Error); + end; + + Natools.Tests.End_Section (Report); + +end Natools.Chunked_Strings.Tests.CXA4010; ADDED natools-chunked_strings-tests-cxa4010.ads Index: natools-chunked_strings-tests-cxa4010.ads ================================================================== --- natools-chunked_strings-tests-cxa4010.ads +++ natools-chunked_strings-tests-cxa4010.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests.CXA4010 is the transcription to -- +-- Chunked_String of ACATS test CXA4010 for Unbounded_String. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic procedure Natools.Chunked_Strings.Tests.CXA4010 + (Report : in out Natools.Tests.Reporter'Class); +pragma Preelaborate (CXA4010); ADDED natools-chunked_strings-tests-cxa4011.adb Index: natools-chunked_strings-tests-cxa4011.adb ================================================================== --- natools-chunked_strings-tests-cxa4011.adb +++ natools-chunked_strings-tests-cxa4011.adb @@ -0,0 +1,409 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Strings; use Ada.Strings; + +procedure Natools.Chunked_Strings.Tests.CXA4011 + (Report : in out Natools.Tests.Reporter'Class) +is + package NT renames Natools.Tests; + + procedure Test (Test_Name : String; + C_1 : Character; + C_2 : Character; + Name_1 : String; + Name_2 : String); + + + procedure Test (Test_Name : String; + C_1 : Character; + C_2 : Character; + Name_1 : String; + Name_2 : String) is + begin + if C_1 = C_2 then + NT.Item (Report, Test_Name, NT.Success); + else + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, Name_1 & ": " & Character'Image (C_1)); + NT.Info (Report, Name_2 & ": " & Character'Image (C_2)); + end if; + end Test; +begin + NT.Section (Report, "Port of ACATS CXA4011"); + + declare + Cad_String : constant Chunked_String + := To_Chunked_String ("cad"); + Complete_String : constant Chunked_String + := To_Chunked_String ("Incomplete") + & Ada.Strings.Space + & To_Chunked_String ("String"); + Incomplete_String : Chunked_String + := To_Chunked_String ("ncomplete Strin"); + Incorrect_Spelling : Chunked_String + := To_Chunked_String ("Guob Dai"); + Magic_String : constant Chunked_String + := To_Chunked_String ("abracadabra"); + Incantation : Chunked_String := Magic_String; + + A_Small_G : constant Character := 'g'; + A_Small_D : constant Character := 'd'; + + ABCD_Set : constant Maps.Character_Set := Maps.To_Set ("abcd"); + B_Set : constant Maps.Character_Set := Maps.To_Set ("b"); + AB_Set : constant Maps.Character_Set + := Maps."OR" (Maps.To_Set ('a'), B_Set); + + Code_Map : constant Maps.Character_Mapping + := Maps.To_Mapping (From => "abcd", To => "wxyz"); + Reverse_Code_Map : constant Maps.Character_Mapping + := Maps.To_Mapping (From => "wxyz", To => "abcd"); + Non_Existent_Map : constant Maps.Character_Mapping + := Maps.To_Mapping (From => "jkl", To => "mno"); + + Token_Start : array (1 .. 3) of Positive; + Token_End : array (1 .. 3) of Natural := (0, 0, 0); + Matching_Letters : Natural := 0; + + Tests : array (1 .. 5) of Boolean; + begin + declare + Name : constant String := "Operator ""&"""; + Tests : array (1 .. 3) of Boolean; + begin + Incomplete_String := 'I' & Incomplete_String; + Incomplete_String := Incomplete_String & A_Small_G; + if not Is_Valid (Incomplete_String) + or not Is_Valid (Complete_String) then + NT.Item (Report, Name, NT.Error); + if not Is_Valid (Incomplete_String) then + NT.Info (Report, "Incomplete_String is invalid"); + end if; + if not Is_Valid (Complete_String) then + NT.Info (Report, "Complete_String is invalid"); + end if; + else + Tests (1) := Incomplete_String < Complete_String; + Tests (2) := Incomplete_String > Complete_String; + Tests (3) := Incomplete_String /= Complete_String; + if Tests (1) or Tests (2) or Tests (3) then + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Incomplete_String: """ + & To_String (Incomplete_String) & '"'); + NT.Info (Report, "Complete_String: """ + & To_String (Complete_String) & '"'); + if Tests (1) then + NT.Info (Report, "-> Incomplete_String < Complete_String"); + end if; + if Tests (2) then + NT.Info (Report, "-> Incomplete_String < Complete_String"); + end if; + if Tests (3) then + NT.Info (Report, "-> Incomplete_String /= Complete_String"); + end if; + else + NT.Item (Report, Name, NT.Success); + end if; + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + NT.Section (Report, "Function Element"); + + declare + Name : constant String := "Element of complete vs constant"; + begin + Test (Name, + Element (Incomplete_String, Length (Incomplete_String)), + A_Small_G, + "Element (""" & To_String (Incomplete_String) + & ',' & Natural'Image (Length (Incomplete_String)) & ')', + "A_Small_G"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Element of complete vs Element of Tail"; + begin + Test (Name, + Element (Incomplete_String, 2), + Element (Tail (Incomplete_String, 2), 1), + "Element (""" & To_String (Incomplete_String) & ", 2)", + "Element (""" & To_String (Tail (Incomplete_String, 2)) + & ", 1)"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Element of Head vs Element of constant"; + begin + Test (Name, + Element (Head (Incomplete_String, 4), 2), + Element (To_Chunked_String ("wnqz"), 2), + "Element (""" & To_String (Head (Incomplete_String, 4)) + & ", 2)", + "Element (""wnqz"", 2)"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + declare + Name : constant String := "Procedure Replace_Element"; + begin + Replace_Element (Incorrect_Spelling, 2, 'o'); + Replace_Element (Incorrect_Spelling, + Index (Incorrect_Spelling, B_Set), + A_Small_D); + Replace_Element (Source => Incorrect_Spelling, + Index => Length (Incorrect_Spelling), + By => 'y'); + Test (Report, Name, Incorrect_Spelling, "Good Day"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + -- Function Count + Matching_Letters := Count (Source => Magic_String, + Set => ABCD_Set); + NT.Item (Report, "Function Count with Set parameter", + NT.To_Result (Matching_Letters = 9)); + if Matching_Letters /= 9 then + NT.Info + (Report, + "Count (""" & To_String (Magic_String) & """, ABCD_Set) " + & Natural'Image (Matching_Letters) + & " (should be 9)"); + Dump (Report, Magic_String); + end if; + Tests (1) := Count (Magic_String, "ab") + = Count (Magic_String, "ac") + Count (Magic_String, "ad"); + Tests (2) := Count (Magic_String, "ab") = 2; + NT.Item (Report, "Function Count with String parameter", + NT.To_Result (Tests (1) and Tests (2))); + if not Tests (1) or not Tests (2) then + NT.Info + (Report, + "Count (""" & To_String (Magic_String) & """, ""ab"") " + & Natural'Image (Count (Magic_String, "ab")) + & " (should be 2)"); + NT.Info + (Report, + "Count (""" & To_String (Magic_String) & """, ""ac"") " + & Natural'Image (Count (Magic_String, "ac"))); + NT.Info + (Report, + "Count (""" & To_String (Magic_String) & """, ""ad"") " + & Natural'Image (Count (Magic_String, "ad"))); + end if; + + -- Find_Token + Find_Token (Magic_String, + AB_Set, + Ada.Strings.Inside, + Token_Start (1), + Token_End (1)); + Tests (1) := Natural (Token_Start (1)) = To_String (Magic_String)'First + and Token_End (1) = Index (Magic_String, B_Set); + Find_Token (Source => Magic_String, + Set => ABCD_Set, + Test => Ada.Strings.Outside, + First => Token_Start (2), + Last => Token_End (2)); + Tests (2) := Natural (Token_Start (2)) = 3 and Token_End (2) = 3; + Find_Token (Magic_String, + Maps.To_Set (A_Small_G), + Ada.Strings.Inside, + First => Token_Start (3), + Last => Token_End (3)); + Tests (3) := Token_Start (3) = To_String (Magic_String)'First + and Token_End (3) = 0; + NT.Item (Report, "Procedure Find_Token", + NT.To_Result (Tests (1) and Tests (2) and Tests (3))); + if not Tests (1) then + NT.Info (Report, + "Start: " + & Positive'Image (Token_Start (1)) & " /= " + & Positive'Image (To_String (Magic_String)'First) + & " (should be both 1)"); + NT.Info (Report, + "End: " + & Natural'Image (Token_End (1)) & " /= " + & Natural'Image (Index (Magic_String, B_Set)) + & " (should be both 2)"); + end if; + if not Tests (2) then + NT.Info + (Report, + "Start: " & Positive'Image (Token_Start (2)) & " (should be 3)"); + NT.Info + (Report, + "End: " & Natural'Image (Token_End (2)) & " (should be 3)"); + end if; + if not Tests (3) then + NT.Info + (Report, + "Start: " + & Positive'Image (Token_Start (3)) & " /= " + & Positive'Image (To_String (Magic_String)'First) + & " (should be 1)"); + NT.Info + (Report, + "End: " + & Natural'Image (Token_End (3)) & " (should be 0)"); + end if; + + -- Translate + Incantation := Translate (Magic_String, Code_Map); + Tests (1) := Incantation = To_Chunked_String ("wxrwywzwxrw"); + NT.Item (Report, "Function Translate", + NT.To_Result (Tests (1))); + if not Tests (1) then + NT.Info (Report, + '"' & To_String (Incantation) + & """ /= ""wxrwywzwxrw"""); + end if; + Translate (Incantation, Reverse_Code_Map); + Tests (1) := Incantation = Translate (Magic_String, Non_Existent_Map); + NT.Item + (Report, "Procedure Translate", NT.To_Result (Tests (1))); + if not Tests (1) then + NT.Info (Report, + '"' & To_String (Incantation) & """ /= """ + & To_String (Translate (Magic_String, + Non_Existent_Map)) + & """ (should be """ + & To_String (Magic_String) & """)"); + end if; + + -- Trim + declare + XYZ_Set : constant Maps.Character_Set := Maps.To_Set ("xyz"); + PQR_Set : constant Maps.Character_Set := Maps.To_Set ("pqr"); + Pad : constant Chunked_String := To_Chunked_String ("Pad"); + The_New_Ada : constant Chunked_String := To_Chunked_String ("Ada9X"); + Space_Array : constant array (1 .. 4) of Chunked_String + := (To_Chunked_String (" Pad "), + To_Chunked_String ("Pad "), + To_Chunked_String (" Pad"), + Pad); + String_Array : constant array (1 .. 5) of Chunked_String + := (To_Chunked_String ("xyzxAda9Xpqr"), + To_Chunked_String ("Ada9Xqqrp"), + To_Chunked_String ("zxyxAda9Xqpqr"), + To_Chunked_String ("xxxyAda9X"), + The_New_Ada); + begin + for I in 1 .. 4 loop + Tests (I) := Trim (Space_Array (I), Ada.Strings.Both) = Pad; + end loop; + NT.Item + (Report, "Trim spaces", + NT.To_Result (Tests (1) and Tests (2) + and Tests (3) and Tests (4))); + for I in 1 .. 4 loop + if not Tests (I) then + NT.Info + (Report, + "Part" & Positive'Image (I) & ": Trim (""" + & To_String (Space_Array (I)) & """, Both) -> """ + & To_String (Trim (Space_Array (I), Ada.Strings.Both)) + & """ (shoud be """ & To_String (Pad) & '"'); + end if; + end loop; + + for I in 1 .. 5 loop + Tests (I) := Trim (String_Array (I), + Left => XYZ_Set, + Right => PQR_Set) + = The_New_Ada; + end loop; + NT.Item + (Report, "Trim sets of characters", + NT.To_Result (Tests (1) and Tests (2) and Tests (3) + and Tests (4) and Tests (5))); + for I in 1 .. 5 loop + if not Tests (I) then + NT.Info + (Report, + "Part" & Positive'Image (I) & ": Trim (""" + & To_String (String_Array (I)) + & """, XYZ_Set, PQR_Set) -> """ + & To_String (Trim (String_Array (I), XYZ_Set, PQR_Set)) + & """ (shoud be """ & To_String (The_New_Ada) & '"'); + end if; + end loop; + end; + + -- Delete + Tests (1) := Delete (Source => Delete (Magic_String, + 8, Length (Magic_String)), + From => To_String (Magic_String)'First, + Through => 4) + = Cad_String; + NT.Item (Report, "Function Delete", + NT.To_Result (Tests (1))); + if not Tests (1) then + NT.Info + (Report, + '"' & To_String (Delete (Delete (Magic_String, + 8, Length (Magic_String)), + To_String (Magic_String)'First, 4)) + & """ /= """ & To_String (Cad_String) & '"'); + end if; + + -- Constructors "*" + declare + SOS : Chunked_String; + Dot : constant Chunked_String := To_Chunked_String ("Dot_"); + Dash : constant String := "Dash_"; + Distress : constant Chunked_String + := To_Chunked_String ("Dot_Dot_Dot_") + & To_Chunked_String ("Dash_Dash_Dash_") + & To_Chunked_String ("Dot_Dot_Dot"); + Repeat : constant Natural := 3; + Separator : constant Character := '_'; + Separator_Set : constant Maps.Character_Set + := Maps.To_Set (Separator); + begin + SOS := Repeat * Dot; + SOS := SOS & Repeat * Dash & Repeat * Dot; + if Trim (SOS, Maps.Null_Set, Separator_Set) /= Distress then + NT.Item (Report, "Function ""*""", NT.Fail); + NT.Info + (Report, + '"' & To_String (Trim (SOS, Maps.Null_Set, Separator_Set)) + & """ /= """ & To_String (Distress) & '"'); + else + NT.Item (Report, "Function ""*""", + NT.Success); + end if; + end; + exception + when Error : others => + NT.Report_Exception (Report, "Preparation", Error); + end; + + NT.End_Section (Report); + +end Natools.Chunked_Strings.Tests.CXA4011; ADDED natools-chunked_strings-tests-cxa4011.ads Index: natools-chunked_strings-tests-cxa4011.ads ================================================================== --- natools-chunked_strings-tests-cxa4011.ads +++ natools-chunked_strings-tests-cxa4011.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests.CXA4011 is the transcription to -- +-- Chunked_String of ACATS test CXA4011 for Unbounded_String. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic procedure Natools.Chunked_Strings.Tests.CXA4011 + (Report : in out Natools.Tests.Reporter'Class); +pragma Preelaborate (CXA4011); ADDED natools-chunked_strings-tests-cxa4030.adb Index: natools-chunked_strings-tests-cxa4030.adb ================================================================== --- natools-chunked_strings-tests-cxa4030.adb +++ natools-chunked_strings-tests-cxa4030.adb @@ -0,0 +1,549 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Characters.Handling; +with Ada.Characters.Latin_1; +with Ada.Exceptions; +with Ada.Strings; use Ada.Strings; + +procedure Natools.Chunked_Strings.Tests.CXA4030 + (Report : in out Natools.Tests.Reporter'Class) +is + package NT renames Natools.Tests; +begin + NT.Section (Report, "Port of ACATS CXA4030"); + + declare + package L1 renames Ada.Characters.Latin_1; + + New_Character_String : Chunked_String + := To_Chunked_String (L1.LC_A_Grave & L1.LC_A_Ring + & L1.LC_AE_Diphthong & L1.LC_C_Cedilla + & L1.LC_E_Acute & L1.LC_I_Circumflex + & L1.LC_Icelandic_Eth & L1.LC_N_Tilde + & L1.LC_O_Oblique_Stroke & L1.LC_Icelandic_Thorn); + + TC_New_Character_String : constant Chunked_String + := To_Chunked_String (L1.UC_A_Grave & L1.UC_A_Ring + & L1.UC_AE_Diphthong & L1.UC_C_Cedilla + & L1.UC_E_Acute & L1.UC_I_Circumflex + & L1.UC_Icelandic_Eth & L1.UC_N_Tilde + & L1.UC_O_Oblique_Stroke & L1.UC_Icelandic_Thorn); + Map_To_Lower_Case_Ptr : constant Maps.Character_Mapping_Function + := Ada.Characters.Handling.To_Lower'Access; + Map_To_Upper_Case_Ptr : constant Maps.Character_Mapping_Function + := Ada.Characters.Handling.To_Upper'Access; + begin + NT.Section (Report, "Function Index, Forward direction"); + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Test (Report, Name, + Index (Source => To_Chunked_String + ("The library package Strings.Unbounded"), + Pattern => "unb", + Going => Ada.Strings.Forward, + Mapping => Map_To_Lower_Case_Ptr), + 29); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower"; + begin + Test (Report, Name, + Index (To_Chunked_String + ("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN"), + "ain", + Mapping => Map_To_Lower_Case_Ptr), + 6); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to lower"; + begin + Test (Report, Name, + Index (To_Chunked_String ("maximum number"), + "um", + Ada.Strings.Forward, + Ada.Characters.Handling.To_Lower'Access), + 6); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to upper"; + begin + Test (Report, Name, + Index (To_Chunked_String ("CoMpLeTeLy MiXeD CaSe StRiNg"), + "MIXED CASE STRING", + Ada.Strings.Forward, + Map_To_Upper_Case_Ptr), + 12); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower (no match)"; + begin + Test (Report, Name, + Index (To_Chunked_String + ("STRING WITH NO MATCHING PATTERNS"), + "WITH", + Mapping => Map_To_Lower_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to upper"; + begin + Test (Report, Name, + Index (To_Chunked_String ("THIS STRING IS IN UPPER CASE"), + "IS", + Ada.Strings.Forward, + Ada.Characters.Handling.To_Upper'Access), + 3); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Null string"; + begin + Test (Report, Name, + Index (Null_Chunked_String, + "is", + Mapping => Map_To_Lower_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower"; + begin + Test (Report, Name, + Index (To_Chunked_String ("AAABBBaaabbb"), + "aabb", + Mapping => Ada.Characters.Handling.To_Lower'Access), + 2); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Function Index, Backward direction"); + + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Test (Report, Name, + Index (To_Chunked_String ("Case of a Mixed Case String"), + "case", + Ada.Strings.Backward, + Map_To_Lower_Case_Ptr), + 17); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to upper"; + begin + Test (Report, Name, + Index (To_Chunked_String ("Case of a Mixed Case String"), + "CASE", + Ada.Strings.Backward, + Mapping => Map_To_Upper_Case_Ptr), + 17); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower"; + begin + Test (Report, Name, + Index (To_Chunked_String ("rain, Rain, and more RAIN"), + "rain", + Ada.Strings.Backward, + Ada.Characters.Handling.To_Lower'Access), + 22); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to upper"; + begin + Test (Report, Name, + Index (To_Chunked_String ("RIGHT place, right time"), + "RIGHT", + Going => Ada.Strings.Backward, + Mapping => Ada.Characters.Handling.To_Upper'Access), + 14); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower (no match)"; + begin + Test (Report, Name, + Index (To_Chunked_String ("WOULD MATCH BUT FOR THE CASE"), + "WOULD MATCH BUT FOR THE CASE", + Going => Ada.Strings.Backward, + Mapping => Map_To_Lower_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + declare + Null_String : constant String := ""; + TC_Natural : Natural := 1000; + begin + TC_Natural + := Index (To_Chunked_String ("A Valid Chunked String"), + Null_String, + Going => Ada.Strings.Forward, + Mapping => Ada.Characters.Handling.To_Lower'Access); + NT.Item (Report, "Pattern_Error raised in Index", NT.Fail); + NT.Info (Report, "No exception has been raised."); + NT.Info (Report, "Return value: " & Natural'Image (TC_Natural)); + exception + when Pattern_Error => + NT.Item (Report, "Pattern_Error raised in Index", NT.Success); + when Error : others => + NT.Item (Report, "Pattern_Error raised in Index", NT.Fail); + NT.Info (Report, "Wrong exception " + & Ada.Exceptions.Exception_Name (Error) + & "has been raised."); + end; + + + NT.Section (Report, "Function Count with mapping function"); + + declare + Name : constant String := "Upper case mapped to lower"; + begin + Test (Report, Name, + Count (Source => To_Chunked_String ("ABABABA"), + Pattern => "aba", + Mapping => Map_To_Lower_Case_Ptr), + 2); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower (no match)"; + begin + Test (Report, Name, + Count (To_Chunked_String ("ABABABA"), + "ABA", + Mapping => Map_To_Lower_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Test (Report, Name, + Count (To_Chunked_String ("This IS a MISmatched issue"), + "is", + Ada.Characters.Handling.To_Lower'Access), + 4); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to upper"; + begin + Test (Report, Name, + Count (To_Chunked_String ("ABABABA"), + "ABA", + Map_To_Upper_Case_Ptr), + 2); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to upper (no match)"; + begin + Test (Report, Name, + Count (To_Chunked_String ("This IS a MISmatched issue"), + "is", + Mapping => Map_To_Upper_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Test (Report, Name, + Count (To_Chunked_String + ("She sells sea shells by the sea shore"), + "s", + Ada.Characters.Handling.To_Lower'Access), + 8); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty string"; + begin + Test (Report, Name, + Count (Null_Chunked_String, + "match", + Map_To_Upper_Case_Ptr), + 0); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + declare + Null_Pattern_String : constant String := ""; + TC_Natural : Natural := 1000; + begin + TC_Natural := Count (To_Chunked_String ("A Valid String"), + Null_Pattern_String, + Map_To_Lower_Case_Ptr); + NT.Item (Report, "Pattern_Error raised in Count", NT.Fail); + NT.Info (Report, "No exception has been raised."); + NT.Info (Report, "Return value: " & Natural'Image (TC_Natural)); + exception + when Pattern_Error => + NT.Item (Report, "Pattern_Error raised in Count", NT.Success); + when Error : others => + NT.Item (Report, "Pattern_Error raised in Count", NT.Fail); + NT.Info (Report, "Wrong exception " + & Ada.Exceptions.Exception_Name (Error) + & "has been raised."); + end; + + + NT.Section (Report, "Function Translate"); + + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Test (Report, Name, + Translate (Source => To_Chunked_String + ("A Sample Mixed Case String"), + Mapping => Map_To_Lower_Case_Ptr), + "a sample mixed case string"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to lower"; + begin + Test (Report, Name, + Translate (To_Chunked_String ("ALL LOWER CASE"), + Ada.Characters.Handling.To_Lower'Access), + "all lower case"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to lower"; + begin + Test (Report, Name, + Translate (To_Chunked_String ("end with lower case"), + Map_To_Lower_Case_Ptr), + "end with lower case"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty string"; + begin + Test (Report, Name, + Translate (Null_Chunked_String, + Ada.Characters.Handling.To_Lower'Access), + Null_Chunked_String); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to upper"; + begin + Test (Report, Name, + Translate (To_Chunked_String ("start with lower case"), + Map_To_Upper_Case_Ptr), + "START WITH LOWER CASE"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Upper case mapped to upper"; + begin + Test (Report, Name, + Translate (To_Chunked_String ("ALL UPPER CASE STRING"), + Ada.Characters.Handling.To_Upper'Access), + "ALL UPPER CASE STRING"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to upper"; + begin + Test (Report, Name, + Translate (To_Chunked_String + ("LoTs Of MiXeD CaSe ChArAcTeRs"), + Map_To_Upper_Case_Ptr), + "LOTS OF MIXED CASE CHARACTERS"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Diacritics"; + begin + Test (Report, Name, + Translate (New_Character_String, + Ada.Characters.Handling.To_Upper'Access), + TC_New_Character_String); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Procedure Translate"); + + declare + use Ada.Characters.Handling; + + Str_1 : Chunked_String + := To_Chunked_String ("AN ALL UPPER CASE STRING"); + Str_2 : Chunked_String + := To_Chunked_String ("A Mixed Case String"); + Str_3 : Chunked_String + := To_Chunked_String ("a string with lower case letters"); + TC_Str_1 : constant Chunked_String := Str_1; + TC_Str_3 : constant Chunked_String := Str_3; + begin + declare + Name : constant String := "Upper case mapped to lower"; + begin + Translate (Source => Str_1, Mapping => Map_To_Lower_Case_Ptr); + Test (Report, Name, Str_1, + To_Chunked_String ("an all upper case string")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped back to upper"; + begin + Translate (Source => Str_1, Mapping => Map_To_Upper_Case_Ptr); + Test (Report, Name, Str_1, TC_Str_1); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Mixed case mapped to lower"; + begin + Translate (Str_2, Mapping => Map_To_Lower_Case_Ptr); + Test (Report, Name, Str_2, + To_Chunked_String ("a mixed case string")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to upper"; + begin + Translate (Str_2, Mapping => To_Upper'Access); + Test (Report, Name, Str_2, + To_Chunked_String ("A MIXED CASE STRING")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to lower"; + begin + Translate (Str_3, To_Lower'Access); + Test (Report, Name, Str_3, TC_Str_3); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Lower case mapped to upper"; + begin + Translate (Str_3, To_Upper'Access); + Test (Report, Name, Str_3, + To_Chunked_String ("A STRING WITH LOWER CASE LETTERS")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Diacritics"; + begin + Translate (New_Character_String, Map_To_Upper_Case_Ptr); + Test (Report, Name, New_Character_String, TC_New_Character_String); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + end; + + NT.End_Section (Report); + exception + when Error : others => + NT.Item (Report, "Preparation", NT.Error); + NT.Info (Report, "Exception: " + & Ada.Exceptions.Exception_Name (Error)); + NT.Info (Report, Ada.Exceptions.Exception_Message (Error)); + end; + + NT.End_Section (Report); + +end Natools.Chunked_Strings.Tests.CXA4030; ADDED natools-chunked_strings-tests-cxa4030.ads Index: natools-chunked_strings-tests-cxa4030.ads ================================================================== --- natools-chunked_strings-tests-cxa4030.ads +++ natools-chunked_strings-tests-cxa4030.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests.CXA4030 is the transcription to -- +-- Chunked_String of ACATS test CXA4030 for Unbounded_String. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic procedure Natools.Chunked_Strings.Tests.CXA4030 + (Report : in out Natools.Tests.Reporter'Class); +pragma Preelaborate (CXA4030); ADDED natools-chunked_strings-tests-cxa4031.adb Index: natools-chunked_strings-tests-cxa4031.adb ================================================================== --- natools-chunked_strings-tests-cxa4031.adb +++ natools-chunked_strings-tests-cxa4031.adb @@ -0,0 +1,440 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Exceptions; + +procedure Natools.Chunked_Strings.Tests.CXA4031 + (Report : in out Natools.Tests.Reporter'Class) +is + package NT renames Natools.Tests; +begin + NT.Section (Report, "Port of ACATS CXA4031"); + + declare + subtype LC_Characters is Character range 'a' .. 'z'; + + Null_String : constant String := ""; + TC_String : constant String := "A Standard String"; + + TC_Chunked_String, + TC_New_Chunked_String : Chunked_String := Null_Chunked_String; + begin + NT.Section (Report, "Function To_Chunked_String with Length parameter"); + + declare + Name : constant String := "Length = 10"; + Result : Natural; + begin + Result := Length (To_Chunked_String (Length => 10)); + if Result = 10 then + NT.Item (Report, Name, NT.Success); + else + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Found length" & Natural'Image (Result)); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Singleton"; + Result : Natural; + begin + Result := Length (To_Chunked_String (1)); + if Result = 1 then + NT.Item (Report, Name, NT.Success); + else + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Found length" & Natural'Image (Result)); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty string"; + Result : Natural; + begin + Result := Length (To_Chunked_String (0)); + if Result = 0 then + NT.Item (Report, Name, NT.Success); + else + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Found length" & Natural'Image (Result)); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Concatenation of the above"; + Result : Natural; + begin + Result := Length (To_Chunked_String (Length => 10) + & To_Chunked_String (1) + & To_Chunked_String (0)); + if Result = 10 + 1 + 0 then + NT.Item (Report, Name, NT.Success); + else + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Found length" & Natural'Image (Result)); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Append (Chunked, Chunked)"); + + declare + Name : constant String := "Non-empty and non-empty"; + begin + TC_Chunked_String := To_Chunked_String ("Sample string of length L"); + TC_New_Chunked_String := To_Chunked_String (" and then some"); + Append (TC_Chunked_String, TC_New_Chunked_String); + Test (Report, Name, TC_Chunked_String, + "Sample string of length L and then some"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Non-empty and empty"; + begin + TC_Chunked_String := To_Chunked_String ("Sample string of length L"); + TC_New_Chunked_String := Null_Chunked_String; + Test (Report, Name, TC_Chunked_String, "Sample string of length L"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty and non-empty"; + begin + TC_Chunked_String := Null_Chunked_String; + Append (TC_Chunked_String, + To_Chunked_String ("New Chunked String")); + Test (Report, Name, TC_Chunked_String, "New Chunked String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Procedure Append (Chunked, String)"); + + declare + Name : constant String := "Non-empty and non-empty"; + begin + TC_Chunked_String := To_Chunked_String ("A Chunked String and "); + Append (Source => TC_Chunked_String, New_Item => TC_String); + Test (Report, Name, TC_Chunked_String, + "A Chunked String and A Standard String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Non-empty and empty"; + begin + TC_Chunked_String := To_Chunked_String ("A Chunked String"); + Append (TC_Chunked_String, New_Item => Null_String); + Test (Report, Name, TC_Chunked_String, "A Chunked String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty and non-empty"; + begin + TC_Chunked_String := Null_Chunked_String; + Append (TC_Chunked_String, TC_String); + Test (Report, Name, TC_Chunked_String, "A Standard String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Procedure Append (Chunked, Character)"); + + declare + Name : constant String := "Non-empty initial string"; + begin + TC_Chunked_String := To_Chunked_String ("Lower Case = "); + for I in LC_Characters'Range loop + Append (Source => TC_Chunked_String, + New_Item => I); + end loop; + Test (Report, Name, TC_Chunked_String, + "Lower Case = abcdefghijklmnopqrstuvwxyz"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty initial string"; + begin + TC_Chunked_String := Null_Chunked_String; + Append (TC_Chunked_String, New_Item => 'a'); + Test (Report, Name, TC_Chunked_String, "a"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Function ""="""); + TC_Chunked_String := To_Chunked_String (TC_String); + + declare + Name : constant String := "Chunked_String and String"; + begin + NT.Item (Report, Name, NT.To_Result (TC_Chunked_String = TC_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "String and Chunked_String"; + begin + NT.Item (Report, Name, + NT.To_Result ("A Standard String" = TC_Chunked_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty chunked string and empty string"; + begin + NT.Item (Report, Name, NT.To_Result (Null_Chunked_String = "")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "With inline conversion"; + begin + NT.Item (Report, Name, + NT.To_Result ("Test String" = To_Chunked_String ("Test String"))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Function ""<"""); + + declare + Name : constant String := "Differing by a trailing space"; + begin + NT.Item (Report, Name, + NT.To_Result ("Extra Space" < To_Chunked_String ("Extra Space "))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by the last letter"; + begin + NT.Item (Report, Name, + NT.To_Result (To_Chunked_String ("tess") < "test")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by the first letter"; + begin + NT.Item (Report, Name, + NT.To_Result (To_Chunked_String ("best") < "test")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty strings"; + begin + NT.Item (Report, Name, + NT.To_Result (not (Null_Chunked_String < Null_String))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Equal with leading blank"; + begin + NT.Item (Report, Name, + NT.To_Result (not (" leading blank" + < To_Chunked_String (" leading blank")))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Equal with ending blank"; + begin + NT.Item (Report, Name, + NT.To_Result (not ("ending blank " + < To_Chunked_String ("ending blank ")))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Function ""<="""); + TC_Chunked_String := To_Chunked_String ("Sample string"); + + declare + Name : constant String := "Prefix"; + begin + NT.Item (Report, Name, + NT.To_Result (not (TC_Chunked_String <= "Sample strin"))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by case"; + begin + NT.Item (Report, Name, + NT.To_Result (not ("sample string" <= TC_Chunked_String))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty strings"; + begin + NT.Item (Report, Name, NT.To_Result (Null_Chunked_String <= "")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Equal strings"; + begin + NT.Item (Report, Name, + NT.To_Result ("Sample string" <= TC_Chunked_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Function "">"""); + TC_Chunked_String := To_Chunked_String ("A MUCH LONGER STRING"); + + declare + Name : constant String := "Differing by case"; + begin + NT.Item (Report, Name, + NT.To_Result ("A much longer string" > TC_Chunked_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Prefix"; + begin + NT.Item (Report, Name, + NT.To_Result (To_Chunked_String (TC_String) > "A Standard Strin")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by case"; + begin + NT.Item (Report, Name, + NT.To_Result ("abcdefgh" > To_Chunked_String ("ABCDEFGH"))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty strings"; + begin + NT.Item (Report, Name, + NT.To_Result (not (Null_Chunked_String > Null_String))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + + NT.Section (Report, "Function "">="""); + TC_Chunked_String := To_Chunked_String (TC_String); + + declare + Name : constant String := "Equal strings"; + begin + NT.Item (Report, Name, NT.To_Result (TC_Chunked_String >= TC_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Empty strings"; + begin + NT.Item (Report, Name, + NT.To_Result (Null_String >= Null_Chunked_String)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by the last letter"; + begin + NT.Item (Report, Name, + NT.To_Result ("test" >= To_Chunked_String ("tess"))); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Differing by case"; + begin + NT.Item (Report, Name, + NT.To_Result (To_Chunked_String ("Programming") >= "PROGRAMMING")); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + exception + when Error : others => + NT.Item (Report, "Preparation", NT.Error); + NT.Info (Report, "Exception: " + & Ada.Exceptions.Exception_Name (Error)); + NT.Info (Report, Ada.Exceptions.Exception_Message (Error)); + end; + + NT.End_Section (Report); + +end Natools.Chunked_Strings.Tests.CXA4031; ADDED natools-chunked_strings-tests-cxa4031.ads Index: natools-chunked_strings-tests-cxa4031.ads ================================================================== --- natools-chunked_strings-tests-cxa4031.ads +++ natools-chunked_strings-tests-cxa4031.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests.CXA4031 is the transcription to -- +-- Chunked_String of ACATS test CXA4031 for Unbounded_String. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic procedure Natools.Chunked_Strings.Tests.CXA4031 + (Report : in out Natools.Tests.Reporter'Class); +pragma Preelaborate (CXA4031); ADDED natools-chunked_strings-tests-cxa4032.adb Index: natools-chunked_strings-tests-cxa4032.adb ================================================================== --- natools-chunked_strings-tests-cxa4032.adb +++ natools-chunked_strings-tests-cxa4032.adb @@ -0,0 +1,536 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Exceptions; +with Ada.Strings.Maps.Constants; + +procedure Natools.Chunked_Strings.Tests.CXA4032 + (Report : in out Natools.Tests.Reporter'Class) +is + package NT renames Natools.Tests; +begin + NT.Section (Report, "Port of ACATS CXA4032"); + + declare + TC_Null_String : constant String := ""; + TC_String_5 : constant String (1 .. 5) := "ABCDE"; + TC_Chunked_String : Chunked_String := To_Chunked_String ("Test String"); + begin + NT.Section (Report, "Procedure Replace_Slice"); + declare + Name : constant String + := "Index_Error raised when Low > Source'Last+1"; + begin + Replace_Slice (Source => TC_Chunked_String, + Low => Length (TC_Chunked_String) + 2, + High => Length (TC_Chunked_String), + By => TC_String_5); + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "No exception has been raised."); + NT.Info (Report, + "Final value: """ & To_String (TC_Chunked_String) & '"'); + exception + when Ada.Strings.Index_Error => + NT.Item (Report, Name, NT.Success); + when Error : others => + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Wrong exception " + & Ada.Exceptions.Exception_Name (Error) + & " raised instead"); + end; + + + declare + Name : constant String := "1-character slice replacement"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Replace_Slice (TC_Chunked_String, 5, 5, TC_String_5); + Test (Report, Name, TC_Chunked_String, "TestABCDEString"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Prefix replacement"; + begin + Replace_Slice (TC_Chunked_String, 1, 4, TC_String_5); + Test (Report, Name, TC_Chunked_String, "ABCDEABCDEString"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Suffix replacement by empty"; + begin + Replace_Slice (TC_Chunked_String, + 11, + Length (TC_Chunked_String), + TC_Null_String); + Test (Report, Name, TC_Chunked_String, "ABCDEABCDE"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Slice insertion in the middle"; + begin + Replace_Slice (TC_Chunked_String, Low => 4, High => 1, By => "xxx"); + Test (Report, Name, TC_Chunked_String, "ABCxxxDEABCDE"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Slice insertion at the beginning"; + begin + Replace_Slice (TC_Chunked_String, Low => 1, High => 0, By => "yyy"); + Test (Report, Name, TC_Chunked_String, "yyyABCxxxDEABCDE"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Slice insertion at the end"; + begin + Replace_Slice (TC_Chunked_String, + Length (TC_Chunked_String) + 1, + Length (TC_Chunked_String), + By => "zzz"); + Test (Report, Name, TC_Chunked_String, "yyyABCxxxDEABCDEzzz"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Insert"); + TC_Chunked_String := To_Chunked_String ("Test String"); + + declare + Name : constant String := "Index_Error raised on incorrect Before"; + begin + Insert (Source => TC_Chunked_String, + Before => Length (TC_Chunked_String) + 2, + New_Item => TC_String_5); + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "No exception has been raised."); + NT.Info (Report, + "Final value: """ & To_String (TC_Chunked_String) & '"'); + exception + when Ada.Strings.Index_Error => + NT.Item (Report, Name, NT.Success); + when Error : others => + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Wrong exception " + & Ada.Exceptions.Exception_Name (Error) + & " raised instead"); + end; + + + declare + Name : constant String := "Prefix insertion"; + begin + Insert (TC_Chunked_String, 1, "**"); + Test (Report, Name, TC_Chunked_String, "**Test String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Suffix insertion"; + begin + Insert (TC_Chunked_String, Length (TC_Chunked_String) + 1, "**"); + Test (Report, Name, TC_Chunked_String, "**Test String**"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Insertion in the middle"; + begin + Insert (TC_Chunked_String, 8, "---"); + Test (Report, Name, TC_Chunked_String, "**Test ---String**"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty insertion"; + begin + Insert (TC_Chunked_String, 3, TC_Null_String); + Test (Report, Name, TC_Chunked_String, "**Test ---String**"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Overwrite"); + + declare + Name : constant String := "Index_Error raised on incorrect Position"; + begin + Overwrite (Source => TC_Chunked_String, + Position => Length (TC_Chunked_String) + 2, + New_Item => TC_String_5); + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "No exception has been raised."); + NT.Info (Report, + "Final value: """ & To_String (TC_Chunked_String) & '"'); + exception + when Ada.Strings.Index_Error => + NT.Item (Report, Name, NT.Success); + when Error : others => + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Wrong exception " + & Ada.Exceptions.Exception_Name (Error) + & " raised instead"); + end; + + + declare + Name : constant String := "Normal overwrite"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Overwrite (Source => TC_Chunked_String, + Position => 1, + New_Item => "XXXX"); + Test (Report, Name, TC_Chunked_String, "XXXX String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Overwrite after the end"; + begin + Overwrite (TC_Chunked_String, Length (TC_Chunked_String) + 1, "**"); + Test (Report, Name, TC_Chunked_String, "XXXX String**"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty overwrite"; + begin + Overwrite (TC_Chunked_String, 3, TC_Null_String); + Test (Report, Name, TC_Chunked_String, "XXXX String**"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Complete overwrite"; + begin + Overwrite (TC_Chunked_String, 1, "abcdefghijklmn"); + Test (Report, Name, TC_Chunked_String, "abcdefghijklmn"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Delete"); + + + declare + Name : constant String := "Empty deletion at the end"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Delete (Source => TC_Chunked_String, + From => Length (TC_Chunked_String), + Through => Length (TC_Chunked_String) - 1); + Test (Report, Name, TC_Chunked_String, "Test String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty deletion at the beginning"; + begin + Delete (TC_Chunked_String, 1, 0); + Test (Report, Name, TC_Chunked_String, "Test String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Prefix deletion"; + begin + Delete (TC_Chunked_String, 1, 5); + Test (Report, Name, TC_Chunked_String, "String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "1-character range deletion"; + begin + Delete (TC_Chunked_String, 3, 3); + Test (Report, Name, TC_Chunked_String, "Sting"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Trim"); + + + declare + Name : constant String := "Nothing to trim"; + begin + TC_Chunked_String := To_Chunked_String ("No Spaces"); + Trim (Source => TC_Chunked_String, Side => Ada.Strings.Both); + Test (Report, Name, TC_Chunked_String, "No Spaces"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Trim left but not right"; + begin + TC_Chunked_String := To_Chunked_String (" Leading Spaces "); + Trim (TC_Chunked_String, Ada.Strings.Left); + Test (Report, Name, TC_Chunked_String, "Leading Spaces "); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Trim right but not left"; + begin + TC_Chunked_String := To_Chunked_String (" Ending Spaces "); + Trim (TC_Chunked_String, Ada.Strings.Right); + Test (Report, Name, TC_Chunked_String, " Ending Spaces"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Trim on both sides"; + begin + TC_Chunked_String + := To_Chunked_String (" Spaces on both ends "); + Trim (TC_Chunked_String, Ada.Strings.Both); + Test (Report, Name, TC_Chunked_String, "Spaces on both ends"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Trim (with Character Set parameter)"); + + declare + Name : constant String := "Normal trim"; + begin + TC_Chunked_String := To_Chunked_String ("lowerCASEletters"); + Trim (Source => TC_Chunked_String, + Left => Ada.Strings.Maps.Constants.Lower_Set, + Right => Ada.Strings.Maps.Constants.Lower_Set); + Test (Report, Name, TC_Chunked_String, "CASE"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Nothing to trim"; + begin + TC_Chunked_String := To_Chunked_String ("lowerCASEletters"); + Trim (TC_Chunked_String, + Ada.Strings.Maps.Constants.Upper_Set, + Ada.Strings.Maps.Constants.Upper_Set); + Test (Report, Name, TC_Chunked_String, "lowerCASEletters"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Normal trim"; + begin + TC_Chunked_String := To_Chunked_String ("012abcdefghGFEDCBA789ab"); + Trim (TC_Chunked_String, + Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set, + Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set); + Test (Report, Name, TC_Chunked_String, "ghG"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Head"); + + declare + Name : constant String := "Empty head"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Head (Source => TC_Chunked_String, + Count => 0, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, Null_Chunked_String); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Normal Head"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Head (Source => TC_Chunked_String, + Count => 4, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "Test"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "No-op Head"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Head (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String), + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "Test String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Head with padding"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Head (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String) + 4, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "Test String****"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty string with padding"; + begin + TC_Chunked_String := Null_Chunked_String; + Head (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String) + 3, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "***"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + + NT.Section (Report, "Procedure Tail"); + + declare + Name : constant String := "Empty tail"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Tail (Source => TC_Chunked_String, + Count => 0, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, Null_Chunked_String); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Normal tail"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Tail (Source => TC_Chunked_String, + Count => 6, + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "No-op tail"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Tail (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String), + Pad => '*'); + Test (Report, Name, TC_Chunked_String, "Test String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Tail with padding"; + begin + TC_Chunked_String := To_Chunked_String ("Test String"); + Tail (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String) + 5, + Pad => 'x'); + Test (Report, Name, TC_Chunked_String, "xxxxxTest String"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + + declare + Name : constant String := "Empty string with padding"; + begin + TC_Chunked_String := Null_Chunked_String; + Tail (Source => TC_Chunked_String, + Count => Length (TC_Chunked_String) + 3, + Pad => 'X'); + Test (Report, Name, TC_Chunked_String, "XXX"); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + NT.End_Section (Report); + exception + when Error : others => + NT.Report_Exception (Report, "Preparation", Error); + end; + + NT.End_Section (Report); + +end Natools.Chunked_Strings.Tests.CXA4032; ADDED natools-chunked_strings-tests-cxa4032.ads Index: natools-chunked_strings-tests-cxa4032.ads ================================================================== --- natools-chunked_strings-tests-cxa4032.ads +++ natools-chunked_strings-tests-cxa4032.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests.CXA4032 is the transcription to -- +-- Chunked_String of ACATS test CXA4032 for Unbounded_String. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic procedure Natools.Chunked_Strings.Tests.CXA4032 + (Report : in out Natools.Tests.Reporter'Class); +pragma Preelaborate (CXA4032); ADDED natools-chunked_strings-tests.adb Index: natools-chunked_strings-tests.adb ================================================================== --- natools-chunked_strings-tests.adb +++ natools-chunked_strings-tests.adb @@ -0,0 +1,195 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Natools.Chunked_Strings.Tests.CXA4010; +with Natools.Chunked_Strings.Tests.CXA4011; +with Natools.Chunked_Strings.Tests.CXA4030; +with Natools.Chunked_Strings.Tests.CXA4031; +with Natools.Chunked_Strings.Tests.CXA4032; + +package body Natools.Chunked_Strings.Tests is + package NT renames Natools.Tests; + + procedure All_Blackbox_Tests (Report : in out Natools.Tests.Reporter'Class) + is + procedure Test_CXA4010 is new CXA4010; + procedure Test_CXA4011 is new CXA4011; + procedure Test_CXA4030 is new CXA4030; + procedure Test_CXA4031 is new CXA4031; + procedure Test_CXA4032 is new CXA4032; + begin + NT.Section (Report, "Blackbox tests of Chunked_Strings"); + Test_CXA4010 (Report); + Test_CXA4011 (Report); + Test_CXA4030 (Report); + Test_CXA4031 (Report); + Test_CXA4032 (Report); + NT.End_Section (Report); + end All_Blackbox_Tests; + + + procedure All_Tests (Report : in out Natools.Tests.Reporter'Class) is + begin + NT.Section (Report, "All tests of Chunked_Strings"); + All_Blackbox_Tests (Report); + NT.End_Section (Report); + end All_Tests; + + + + procedure Dump (Report : in out Natools.Tests.Reporter'Class; + Dumped : in Chunked_String) + is + package Maps renames Ada.Strings.Maps; + use type Maps.Character_Set; + + procedure Print_Chunk (Index : Positive; Chunk : String_Access); + procedure Print_Chunks (Data : Chunk_Array_Access); + procedure Print_Line (Raw : String); + + Printable : constant Maps.Character_Set + := Maps.To_Set (Maps.Character_Ranges'((Low => 'a', High => 'z'), + (Low => 'A', High => 'Z'), + (Low => '0', High => '9'))) + or Maps.To_Set (" -_"); + Non_Printable : constant Character := '.'; + + procedure Print_Chunk (Index : Positive; Chunk : String_Access) is + I : Natural; + begin + if Chunk = null then + NT.Info (Report, "Chunk" & Positive'Image (Index) & ": null"); + else + NT.Info (Report, "Chunk" & Positive'Image (Index) & ": " + & Natural'Image (Chunk.all'First) & " .." + & Natural'Image (Chunk.all'Last)); + I := Chunk.all'First; + while I <= Chunk.all'Last loop + Print_Line + (Chunk.all (I .. Positive'Min (Chunk.all'Last, I + 16))); + I := I + 16; + end loop; + end if; + end Print_Chunk; + + procedure Print_Chunks (Data : Chunk_Array_Access) is + begin + if Data = null then + NT.Info (Report, "Null data"); + end if; + if Data.all'Length = 0 then + NT.Info (Report, "Empty data"); + end if; + for C in Data.all'Range loop + Print_Chunk (C, Data.all (C)); + end loop; + end Print_Chunks; + + procedure Print_Line (Raw : String) is + Hex : constant String := "0123456789ABCDEF"; + Line : String (1 .. 4 * Raw'Length + 2) := (others => ' '); + begin + for I in Raw'Range loop + declare + Pos : constant Natural := Character'Pos (Raw (I)); + High : constant Natural := (Pos - 1) / 16; + Low : constant Natural := (Pos - 1) mod 16; + Hex_Base : constant Positive + := Line'First + 3 * (I - Raw'First); + Raw_Base : constant Positive + := Line'First + 3 * Raw'Length + 2 + (I - Raw'First); + begin + Line (Hex_Base) := Hex (Hex'First + High); + Line (Hex_Base + 1) := Hex (Hex'First + Low); + if Maps.Is_In (Raw (I), Printable) then + Line (Raw_Base) := Raw (I); + else + Line (Raw_Base) := Non_Printable; + end if; + end; + end loop; + NT.Info (Report, Line); + end Print_Line; + begin + NT.Info (Report, "Chunk_Size " & Positive'Image (Dumped.Chunk_Size) + & " (default" & Positive'Image (Default_Chunk_Size) + & ')'); + NT.Info (Report, "Allocation_Unit " + & Positive'Image (Dumped.Allocation_Unit) + & " (default" & Positive'Image (Default_Allocation_Unit) + & ')'); + NT.Info (Report, "Size " & Natural'Image (Dumped.Size)); + Print_Chunks (Dumped.Data); + end Dump; + + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Chunked_String; + Reference : in String) is + begin + if not Is_Valid (Computed) then + NT.Item (Report, Test_Name, NT.Error); + return; + end if; + if Computed = To_Chunked_String (Reference) then + NT.Item (Report, Test_Name, NT.Success); + else + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, "Computed """ & To_String (Computed) & '"'); + NT.Info (Report, "Reference """ & Reference & '"'); + end if; + end Test; + + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Chunked_String; + Reference : in Chunked_String) is + begin + if not Is_Valid (Computed) then + NT.Item (Report, Test_Name, NT.Error); + return; + end if; + if not Is_Valid (Reference) then + NT.Item (Report, Test_Name, NT.Error); + return; + end if; + if Computed = Reference then + NT.Item (Report, Test_Name, NT.Success); + else + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, "Computed """ & To_String (Computed) & '"'); + NT.Info (Report, "Reference """ & To_String (Reference) & '"'); + end if; + end Test; + + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Natural; + Reference : in Natural) is + begin + if Computed = Reference then + NT.Item (Report, Test_Name, NT.Success); + else + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, "Computed" & Natural'Image (Computed) + & ", expected" & Natural'Image (Reference)); + end if; + end Test; + +end Natools.Chunked_Strings.Tests; ADDED natools-chunked_strings-tests.ads Index: natools-chunked_strings-tests.ads ================================================================== --- natools-chunked_strings-tests.ads +++ natools-chunked_strings-tests.ads @@ -0,0 +1,57 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Chunked_Strings.Tests is the test suite for Chunked_String. -- +-- -- +-- It currently contains only black-box tests (i.e. without any assumption -- +-- on the internal implementaiton), taken from Unbounded_String tests in -- +-- ACATS. -- +-- -- +-- It also provides private helper functions used in more specialized test -- +-- packages. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +generic package Natools.Chunked_Strings.Tests is + pragma Preelaborate (Tests); + + procedure All_Blackbox_Tests (Report : in out Natools.Tests.Reporter'Class); + + procedure All_Tests (Report : in out Natools.Tests.Reporter'Class); + +private + + procedure Dump (Report : in out Natools.Tests.Reporter'Class; + Dumped : in Chunked_String); + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Chunked_String; + Reference : in String); + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Chunked_String; + Reference : in Chunked_String); + + procedure Test (Report : in out Natools.Tests.Reporter'Class; + Test_Name : in String; + Computed : in Natural; + Reference : in Natural); + +end Natools.Chunked_Strings.Tests;