with Ada.Command_Line; use Ada.Command_Line; with GNATCOLL.Asserts; with GNATCOLL.Strings; with GNATCOLL.Strings_Impl; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Wide_Characters.Handling; use Ada.Wide_Characters.Handling; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Source_Info; with GNAT.Strings; use GNAT.Strings; with Memory; pragma Warnings (Off); with System.Memory; pragma Warnings (On); with Test_Assert; function Test return Integer is package A renames Test_Assert; generic with package Strings is new GNATCOLL.Strings_Impl.Strings (<>); with function Image (S : Strings.Char_String) return String is <>; First_Displayable : Strings.Char_Type := Strings.Char_Type'Val (Character'Pos ('A')); procedure Do_Test (Title : String); -- Tests for various instances of xstring type On_Error is new GNATCOLL.Asserts.Error_Reporter with null record; overriding procedure On_Assertion_Failed (Self : On_Error; Msg : String; Details : String; Location : String; Entity : String); Report : On_Error; package Asserts is new GNATCOLL.Asserts.Asserts (Report); package Equals_Boolean is new Asserts.Equals (Boolean, Boolean'Image); package Equals_Integer is new Asserts.Equals (Integer, Integer'Image); use Equals_Boolean, Equals_Integer; function Image (S : String) return String is ("--" & S & "--"); function Image (S : Wide_String) return String; -- For convenience of instantiation of Asserts, below. procedure Reset_Mem; -- Reset memory allocation counters --------------- -- Reset_Mem -- --------------- procedure Reset_Mem is begin Memory.Allocs := 0; Memory.Reallocs := 0; end Reset_Mem; ----------- -- Image -- ----------- function Image (S : Wide_String) return String is Result : Unbounded_String; begin Append (Result, "--"); for C of S loop if Wide_Character'Pos (C) <= 127 then Append (Result, Character'Val (Wide_Character'Pos (C))); else Append (Result, '[' & Integer'Image (Wide_Character'Pos (C)) & ']'); end if; end loop; Append (Result, "--"); return To_String (Result); end Image; ------------------------- -- On_Assertion_Failed -- ------------------------- overriding procedure On_Assertion_Failed (Self : On_Error; Msg : String; Details : String; Location : String; Entity : String) is pragma Unreferenced (Self); begin Put_Line ((if Msg = "" then "" else Msg & " ") & "(at " & Location & ", in " & Entity & ")" & ASCII.LF & " " & Details); end On_Assertion_Failed; ------------- -- Do_Test -- ------------- procedure Do_Test (Title : String) is use Strings; function Image (S : XString) return String is (Image (S.To_String)); package Equals1 is new Asserts.Equals (T => Strings.Char_Type, Image => Strings.Char_Type'Image); package Equals2 is new Asserts.Equals (T => Strings.Char_String, Image => Image); use Equals1, Equals2; generic type Left_Type (<>) is private; type Right_Type (<>) is private; Op : String; with function Compare (Left : Left_Type; Right : Right_Type) return Boolean; with function Image (L : Left_Type) return String is <>; with function Image (L : Right_Type) return String is <>; procedure Assert_Generic (Left : Left_Type; Right : Right_Type; Location : String := GNAT.Source_Info.Source_Location; Entity : String := GNAT.Source_Info.Enclosing_Entity); procedure Assert_Generic (Left : Left_Type; Right : Right_Type; Location : String := GNAT.Source_Info.Source_Location; Entity : String := GNAT.Source_Info.Enclosing_Entity) is begin if not Compare (Left, Right) then Asserts.Assert_Failed (Image (Left) & ' ' & Op & ' ' & Image (Right), Location => Location, Entity => Entity); end if; end Assert_Generic; procedure Assert is new Assert_Generic (XString, Char_String, "=", "="); procedure Assert is new Assert_Generic (Char_String, XString, "=", "="); procedure Assert is new Assert_Generic (XString, XString, "=", "="); procedure Assert_Less is new Assert_Generic (XString, Char_String, "<", "<"); procedure Assert_Less is new Assert_Generic (Char_String, XString, "<", "<"); procedure Assert_Less is new Assert_Generic (XString, XString, "<", "<"); procedure Assert_Less_Equal is new Assert_Generic (XString, Char_String, "<=", "<="); procedure Assert_Less_Equal is new Assert_Generic (Char_String, XString, "<=", "<="); procedure Assert_Less_Equal is new Assert_Generic (XString, XString, "<=", "<="); procedure Assert_Greater is new Assert_Generic (XString, Char_String, ">", ">"); procedure Assert_Greater is new Assert_Generic (Char_String, XString, ">", ">"); procedure Assert_Greater is new Assert_Generic (XString, XString, ">", ">"); procedure Assert_Greater_Equal is new Assert_Generic (XString, Char_String, ">=", ">="); procedure Assert_Greater_Equal is new Assert_Generic (Char_String, XString, ">=", ">="); procedure Assert_Greater_Equal is new Assert_Generic (XString, XString, ">=", ">="); Space : constant Char_Type := Char_Type'Val (Character'Pos (' ')); Spaces : constant Char_String := Space & Space; Newline : constant Char_Type := Char_Type'Val (Character'Pos (ASCII.LF)); Equal : constant Char_Type := Char_Type'Val (Character'Pos ('=')); Empty : Char_String (1 .. 0); Short : Char_String (3 .. 7); Long : Char_String (3 .. Integer (Strings.SSize'Last) + 10); Null_String : Char_String (1 .. 0); procedure Test_Append; procedure Test_Compare; procedure Test_Indexing (Base : Char_String); procedure Test_Trim; procedure Test_Substrings; procedure Test_Starts; procedure Test_Head_Tail; procedure Test_Iterate; procedure Test_Modify (Base : Char_String); procedure Test_Shrink; procedure Test_Swap; procedure Test_Justify (Base : Char_String); procedure Test_Split (Base : Char_String); procedure Test_Search (Base : Char_String); procedure Test_Casing; procedure Test_Access; ----------------- -- Test_Append -- ----------------- procedure Test_Append is S, S2 : XString; begin S.Set (Short); A.Assert (S = Short, Title); S.Set (Long); A.Assert (S = Long, Title); S2 := S; Append (S, Short); A.Assert (S2 = Long, Title); A.Assert (S = Long & Short, Title); S.Set (Short); A.Assert (S = Short, Title); A.Assert (S2 = Long, Title); -- Appending to a slice S.Set (Long); S2 := S; S.Slice (2, 3); S.Append (Short); A.Assert (S2 = Long, Title); A.Assert (S = Long (Long'First + 1 .. Long'First + 2) & Short, Title); end Test_Append; ------------------ -- Test_Compare -- ------------------ procedure Test_Compare is S, S2 : XString; begin -- Test equality between null strings S := Null_XString; if S /= Null_XString then raise Program_Error; end if; A.Assert (S.Is_Empty = True, Title); -- Test equality for short string and null string S := Null_XString; S.Set (Empty); A.Assert (S = Empty, Title); if S /= Null_XString then raise Program_Error; end if; Assert (Compare (S, Empty), 0); -- Test equality for big string and null string S := Null_XString; S.Set (Long); -- force malloc S.Set (Empty); -- reset to empty string A.Assert (S = Empty, Title); if S /= Null_XString then raise Program_Error; end if; A.Assert (S.Is_Empty = True, Title); A.Assert (Compare (S, Empty) = 0, Title); -- Test equality for short strings S := Null_XString; S2 := Null_XString; S.Set (Short); S2.Set (Short); if S /= S2 then raise Program_Error; end if; -- Test equality for long strings S := Null_XString; S2 := Null_XString; S.Set (Long); S2.Set (Long); if S /= S2 then raise Program_Error; end if; -- Test equality for short and long strings S := Null_XString; S2 := Null_XString; S.Set (Long); -- force malloc S.Set (Short); S2.Set (Short); if S /= S2 then raise Program_Error; end if; -- Test equality with Char_String declare XS : XString; S : Char_String := Short; begin XS.Set (Short); A.Assert (To_String(XS) = S, Title); A.Assert (To_XString(S) = XS, Title); A.Assert (Compare (XS, S) = 0, Title); end; -- Test equality with substrings declare S, S2, S3 : XString; begin S.Set (Short); S2.Set (Long); A.Assert (S = Short, Title); A.Assert (Short = S, Title); A.Assert (S2 = Long, Title); A.Assert (Long = S2, Title); A.Assert (S.Slice (2, 3) = S.Slice (2, 3), Title); A.Assert (Compare (S.Slice (2, 3), S.Slice (2, 3)) = 0, Title); A.Assert (S.Slice (2, 3) = S2.Slice (2, 3), Title); A.Assert (Compare (S.Slice (2, 3), S2.Slice (2, 3)) = 0, Title); A.Assert (S2.Slice (2, 3) = S.Slice (2, 3), Title); A.Assert (Compare (S2.Slice (2, 3), S.Slice (2, 3)) = 0, Title); A.Assert (S2.Slice (2, 3) = S2.Slice (2, 3), Title); A.Assert (Compare (S2.Slice (2, 3), S2.Slice (2, 3)) = 0, Title); -- Test inequality with substring A.Assert (Compare(S2,S) = 1, Title); A.Assert (Compare(S,S2) = -1, Title); -- Check that we have the same behavior as with standard strings A.Assert (S.Slice (3, 2) = Null_XString, Title); A.Assert (S.Slice (Natural'Last, 1) = Null_XString, Title); A.Assert (S.Slice (1, 0) = Null_XString, Title); S3 := S2; S3.Slice (3, 2); A.Assert (S3 = Null_XString, Title); S3 := S2; S3.Slice (Natural'Last, 1); A.Assert (S3 = Null_XString, Title); S3 := S2; S3.Slice (3, 0); A.Assert (S3 = Null_XString, Title); end; declare S, S2, S3 : XString; begin S.Set (Short); S2.Set (Long); Assert_Less (S, S2); Assert_Greater (S2, S); Assert_Less (S, Short (Short'First + 1 .. Short'Last)); Assert_Less_Equal (S, Short (Short'First + 1 .. Short'Last)); Assert_Greater_Equal (Short (Short'First + 1 .. Short'Last), S); Assert_Greater (Short (Short'First + 1 .. Short'Last), S); Assert_Less (Short, S.Slice (2, 3)); Assert_Less_Equal (Short, S.Slice (2, 3)); Assert_Greater_Equal (S.Slice (2, 3), Short); Assert_Greater (S.Slice (2, 3), Short); A.Assert (Compare (S, Short (Short'First + 1 .. Short'Last)) = -1, Title); A.Assert (Compare (Short (Short'First + 1 .. Short'Last), S) = 1, Title); Assert_Less (S2, Long (Long'First + 1 .. Long'Last)); Assert_Less (Long, S2.Slice (2, 3)); A.Assert (Compare (S2, Long (Long'First + 1 .. Long'Last)) = -1, Title); A.Assert (Compare (Long (Long'First + 1 .. Long'Last), S2) = 1, Title); A.Assert (Compare (S, S) = 0, Title); A.Assert (Compare (S2, S2) = 0, Title); S3.Set(Short(Short'First) & Char_Type'Val(Char_Type'Pos(Short(Short'First + 1)) + 1) & Short(Short'First + 2..Short'Last)); A.Assert (Compare (S3, S) = 1, Title); end; end Test_Compare; ------------------- -- Test_Indexing -- ------------------- procedure Test_Indexing (Base : Char_String) is Is_Long : constant Boolean := Base'Length > Natural (Strings.SSize'Last); S, S2 : XString; Idx : Positive; begin S.Set (Base); Reset_Mem; -- Test the constant indexing aspect -- We check memory allocations to make sure we are using -- a constant indexing aspect if S (1) /= First_Displayable then raise Program_Error; end if; if S (2) /= Char_Type'Succ (First_Displayable) then raise Program_Error; end if; A.Assert (Memory.Allocs = 0, Title); A.Assert (Memory.Reallocs = 0, Title); begin if S (10000) /= First_Displayable then null; end if; if S (Base'Length + 1) /= First_Displayable then null; end if; raise Program_Error; -- should have receive exeption exception when Ada.Strings.Index_Error => null; end; -- Testing loops -- We check memory allocations to make sure we are using -- a constant indexing aspect Reset_Mem; Idx := Base'First; for C of S loop Assert (C, Base (Idx)); Idx := Idx + 1; end loop; Assert (Idx, Base'Last + 1); S2 := S; -- Test that the string is still shareable A.Assert (S = Base, Title); A.Assert (S2 = Base, Title); A.Assert (Memory.Allocs = (if not Strings.Copy_On_Write and then Is_Long then 1 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); -- Same test for loops on indexes Reset_Mem; Idx := Base'First; for Idx2 in S.Iterate loop A.Assert (Idx2 = Idx - Base'First + 1, Title); A.Assert (S (Idx2) = Base (Idx), Title); Idx := Idx + 1; end loop; Assert (Idx, Base'Last + 1); S2 := S; A.Assert (S = Base, Title); A.Assert (S2 = Base, Title); A.Assert (Memory.Allocs = (if not Strings.Copy_On_Write and then Is_Long then 1 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); -- Test the Variable indexing aspect S.Set (Base); S (2) := First_Displayable; A.Assert (S = Base (Base'First) & First_Displayable & Base (Base'First + 2 .. Base'Last), Title); Reset_Mem; S.Set (Base); S2 := S; S (2) := First_Displayable; -- makes a copy A.Assert (S2 = Base, Title); A.Assert (S = Base (Base'First) & First_Displayable & Base (Base'First + 2 .. Base'Last), Title); A.Assert (Memory.Allocs = (if Is_Long then 1 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); Reset_Mem; S.Set (Base); declare R : Character_Reference := S.Reference (2); begin S2 := S; R := First_Displayable; A.Assert (S2 = Base, Title); A.Assert (S = Base (Base'First) & First_Displayable & Base (Base'First + 2 .. Base'Last), Title); end; A.Assert (Memory.Allocs = (if Is_Long then 1 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); end Test_Indexing; --------------- -- Test_Trim -- --------------- procedure Test_Trim is pragma Compile_Time_Error (Short'Length + 2 * Spaces'Length > Integer (SSize'Last), "Cannot test short string with spaces"); -- So that we can test Trim with small strings. S, S2 : XString; begin -- Short strings S.Set (Spaces & Short & Spaces); A.Assert (S.Trim (Chars => Space) = Short, Title); A.Assert (S.Trim (Ada.Strings.Right) = Spaces & Short, Title); A.Assert (S.Trim (Ada.Strings.Left) = Short & Spaces, Title); S.Trim (Chars => Space); A.Assert (S = Short, Title); S.Set (Spaces & Short & Spaces); S.Trim (Side => Ada.Strings.Right, Chars => Space); A.Assert (S = Spaces & Short, Title); S.Set (Spaces & Short & Spaces); S.Trim (Side => Ada.Strings.Left, Chars => Space); A.Assert (S = Short & Spaces, Title); -- Long strings S.Set (Spaces & Long & Spaces); A.Assert (S.Trim = Long, Title); A.Assert (S.Trim (Ada.Strings.Right) = Spaces & Long, Title); A.Assert (S.Trim (Ada.Strings.Left) = Long & Spaces, Title); S2 := S; S.Trim (Chars => Space); A.Assert (S = Long, Title); S := S2; S.Trim (Side => Ada.Strings.Right, Chars => Space); A.Assert (S = Spaces & Long, Title); S := S2; S.Trim (Side => Ada.Strings.Left, Chars => Space); A.Assert (S = Long & Spaces, Title); -- Long strings with First /= 1 S.Set (Spaces & Spaces & Long & Spaces & Spaces); S.Slice (3, Spaces'Length * 4 + Long'Length - 2); A.Assert (S.Trim = Long, Title); A.Assert (S.Trim (Ada.Strings.Right) = Spaces & Long, Title); A.Assert (S.Trim (Ada.Strings.Left) = Long & Spaces, Title); S2 := S; S.Trim; A.Assert (S = Long, Title); S := S2; S.Trim (Ada.Strings.Right); A.Assert (S = Spaces & Long, Title); S := S2; S.Trim (Ada.Strings.Left); A.Assert (S = Long & Spaces, Title); end Test_Trim; --------------------- -- Test_Substrings -- --------------------- procedure Test_Substrings is S, S2, S3 : XString; begin -- Short strings S.Set (Spaces & Short & Spaces); S2 := S; -- shared buffer S.Trim; -- get a substring S2.Append (Short); -- no longer shared S3 := S; -- shared buffer S3.Append (Short); -- no longer shared A.Assert (S = Short, Title); A.Assert (S2 = Spaces & Short & Spaces & Short, Title); A.Assert (S3 = Short & Short, Title); -- Check that first character is still index 1 even with -- small strings. A.Assert (S (1) = First_Displayable, Title); end Test_Substrings; ----------------- -- Test_Starts -- ----------------- procedure Test_Starts is S : XString; begin S.Set (Short); A.Assert (S.Starts_With (Short) = True, Title); A.Assert (S.Starts_With (Short (3 .. 4)) = True, Title); A.Assert (S.Starts_With (Null_XString) = True, Title); A.Assert (S.Starts_With (Null_String) = True, Title); A.Assert (S.Starts_With (Short & First_Displayable) = False, Title); A.Assert (S.Ends_With (Short) = True, Title); A.Assert (S.Ends_With (Short (Short'Last - 1 .. Short'Last)) = True, Title); A.Assert (S.Ends_With (Null_XString) = True, Title); A.Assert (S.Ends_With (Null_String) = True, Title); A.Assert (S.Ends_With (Short & First_Displayable) = False, Title); S.Set (Long); A.Assert (S.Starts_With (Long) = True, Title); A.Assert (S.Starts_With (Long (3 .. 4)) = True, Title); A.Assert (S.Starts_With (Null_XString) = True, Title); A.Assert (S.Starts_With (Null_String) = True, Title); A.Assert (S.Starts_With (Long & First_Displayable) = False, Title); A.Assert (S.Ends_With (Long) = True, Title); A.Assert (S.Ends_With (Long (Long'Last - 1 .. Long'Last)) = True, Title); A.Assert (S.Ends_With (Null_XString) = True, Title); A.Assert (S.Ends_With (Null_String) = True, Title); A.Assert (S.Ends_With (Long & First_Displayable) = False, Title); end Test_Starts; -------------------- -- Test_Head_Tail -- -------------------- procedure Test_Head_Tail is S, S2 : XString; begin S.Set (Short); A.Assert (S.Head (1) = Short (Short'First .. Short'First), Title); A.Assert (S.Head (2) = Short (Short'First .. Short'First + 1), Title); A.Assert (S.Head (1000) = Short, Title); A.Assert (S.Tail (1) = Short (Short'Last .. Short'Last), Title); A.Assert (S.Tail (2) = Short (Short'Last - 1 .. Short'Last), Title); A.Assert (S.Tail (1000) = Short, Title); S.Set (Long); A.Assert (S.Head (1) = Long (Long'First .. Long'First), Title); A.Assert (S.Head (2) = Long (Long'First .. Long'First + 1), Title); A.Assert (S.Head (1000) = Long, Title); A.Assert (S.Tail (1) = Long (Long'Last .. Long'Last), Title); A.Assert (S.Tail (2) = Long (Long'Last - 1 .. Long'Last), Title); A.Assert (S.Tail (1000) = Long, Title); S.Set (Long); S.Slice (3, 10); A.Assert (S.Head (1) = Long (Long'First + 2 .. Long'First + 2), Title); A.Assert (S.Head (2) = Long (Long'First + 2 .. Long'First + 3), Title); A.Assert (S.Head (1000) = Long (Long'First + 2 .. Long'First + 9), Title); A.Assert (S.Tail (1) = Long (Long'First + 9 .. Long'First + 9), Title); A.Assert (S.Tail (2) = Long (Long'First + 8 .. Long'First + 9), Title); A.Assert (S.Tail (1000) =Long (Long'First + 2 .. Long'First + 9), Title); -- A slice into itself S.Set (Long); S.Slice (3, 10, Into => S); A.Assert (S = Long (Long'First + 2 .. Long'First + 9), Title); -- A slice into an already allocated string should not leak -- memory. S.Set (Long); S2.Set (Long); S.Slice (3, 10, Into => S2); A.Assert (S = Long, Title); A.Assert (S2 = Long (Long'First + 2 .. Long'First + 9), Title); end Test_Head_Tail; ------------------ -- Test_Iterate -- ------------------ procedure Test_Iterate is S : XString; Expected : Natural; E : Char_Type; begin -- Iterate on indexes, short string S.Set (Short); Expected := 1; for Index of S.Iterate loop A.Assert (Index = Expected, Title); Expected := Expected + 1; end loop; A.Assert (Expected = Short'Length + 1, Title); Expected := 1; for Index of S.Slice (2, 3).Iterate loop A.Assert (Index = Expected, Title); Expected := Expected + 1; end loop; A.Assert (Expected = 3, Title); -- Iterate on characters, short string E := First_Displayable; for C of S loop A.Assert (C = E, Title); E := Char_Type'Succ (E); end loop; A.Assert (Char_Type'Pos (E) = Char_Type'Pos (First_Displayable) + Short'Length, Title); E := Char_Type'Succ (First_Displayable); for C of S.Slice (2, 3) loop A.Assert (C = E, Title); E := Char_Type'Succ (E); end loop; A.Assert (Char_Type'Pos (E) = Char_Type'Pos (First_Displayable) + 3, Title); -- Iterate on indexes, long string S.Set (Long); Expected := 1; for Index of S.Iterate loop A.Assert (Index = Expected, Title); Expected := Expected + 1; end loop; A.Assert (Expected = Long'Length + 1, Title); Expected := 1; for Index of S.Slice (2, 10).Iterate loop A.Assert (Index = Expected, Title); Expected := Expected + 1; end loop; A.Assert (Expected = 10, Title); -- Iterate on characters, long string E := First_Displayable; for C of S loop A.Assert (C = E, Title); E := Char_Type'Succ (E); end loop; A.Assert (Char_Type'Pos (E) = Char_Type'Pos (First_Displayable) + Long'Length, Title); E := Char_Type'Succ (First_Displayable); for C of S.Slice (2, 10) loop A.Assert (C = E, Title); E := Char_Type'Succ (E); end loop; A.Assert (Char_Type'Pos (E) = Char_Type'Pos (First_Displayable) + 10, Title); end Test_Iterate; ----------------- -- Test_Modify -- ----------------- procedure Test_Modify(Base : Char_String) is S, S2 : XString; begin S.Set (Base); S2 := S; S.Replace (2, First_Displayable); A.Assert (S = Base (Base'First) & First_Displayable & Base (Base'First + 2 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Replace with small string S.Set (Base); S2 := S; S.Replace (2, 3, (3 => First_Displayable)); A.Assert (S = Base (Base'First) & First_Displayable & Base (Base'First + 3 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Replace with longer string S.Set (Base); S2 := S; S.Replace (2, 3, (3 .. 20 => First_Displayable)); A.Assert (S = Base (Base'First) & (3 .. 20 => First_Displayable) & Base (Base'First + 3 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Replace an empty string (same as insert) S.Set (Base); S2 := S; S.Replace (2, 1, (3 .. 20 => First_Displayable)); A.Assert (S = Base (Base'First) & (3 .. 20 => First_Displayable) & Base (Base'First + 1 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Replace with self S.Set (Base); S.Replace_Slice (1, 1, S); A.Assert (S = Base & Base (Base'First + 1 .. Base'Last), Title); S.Set (Base); S2 := S; S.Insert (3, First_Displayable & First_Displayable); A.Assert (S = Base (Base'First .. Base'First + 1) & First_Displayable & First_Displayable & Base (Base'First + 2 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Overwrite with shorter string S.Set (Base); S2 := S; S.Overwrite (3, Base (Base'First .. Base'First + 1)); A.Assert (S = Base (Base'First .. Base'First + 1) & Base (Base'First .. Base'First + 1) & Base (Base'First + 4 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Overwrite with longer string S.Set (Base); S2 := S; S.Overwrite (3, Base); A.Assert (S = Base (Base'First .. Base'First + 1) & Base, Title); A.Assert (S2 = Base, Title); -- Deleting S.Set (Base); S2 := S; S.Delete (3, 4); A.Assert (S = Base (Base'First .. Base'First + 1) & Base (Base'First + 4 .. Base'Last), Title); A.Assert (S2 = Base, Title); -- Deleting past the end S.Set (Base); S2 := S; S.Delete (3, 10_000); A.Assert (S = Base (Base'First .. Base'First + 1), Title); A.Assert (S2 = Base, Title); -- Clearing the string S.Set (Base); S2 := S; S.Clear; A.Assert (S2 = Base, Title); A.Assert (S = Null_String, Title); end Test_Modify; ----------------- -- Test_Shrink -- ----------------- procedure Test_Shrink is S : XString; begin S.Set (Short); S.Shrink; A.Assert (S = Short, Title); S := 50 * Long; S.Set (Long); S.Shrink; A.Assert (S = Long, Title); S.Set (Short); S.Shrink; A.Assert (S = Short, Title); end Test_Shrink; --------------- -- Test_Swap -- --------------- procedure Test_Swap is S, S2 : XString; begin -- Swapping two short strings S.Set (Short); S2.Set (Spaces); S.Swap (S2); A.Assert (S = Spaces, Title); A.Assert (S2 = Short, Title); S.Swap (S2); A.Assert (S = Short, Title); A.Assert (S2 = Spaces, Title); -- Swapping a short and a long string S.Set (Short); S2.Set (Long); S.Swap (S2); A.Assert (S = Long, Title); A.Assert (S2 = Short, Title); S.Swap (S2); A.Assert (S = Short, Title); A.Assert (S2 = Long, Title); -- Swapping self S.Set (Short); S.Swap (S); A.Assert (S = Short, Title); S.Set (Long); S.Swap (S); A.Assert (S = Long, Title); end Test_Swap; ------------------ -- Test_Justify -- ------------------ procedure Test_Justify (Base : Char_String) is S, S2 : XString; begin -- procedure Center S.Set (Base); S.Center (Width => Base'Length + 4); A.Assert (S = Space & Space & Base & Space & Space, Title); S.Clear; S.Set (Base); S.Center (Width => Base'Length + 3); A.Assert (S = Space & Space & Base & Space, Title); S.Clear; S.Set (Base); S.Center (Width => Base'Length - 1); A.Assert (S = Base, Title); S.Clear; S.Set (Base); S.Center (Base'Length + 2, First_Displayable); A.Assert (S = First_Displayable & Base & First_Displayable, Title); -- function Center S.Clear; S.Set (Base); A.Assert (S.Center (Base'Length + 4) = Space & Space & Base & Space & Space, Title); A.Assert (S.Center (Base'Length + 3) = Space & Space & Base & Space, Title); A.Assert (S.Center (Base'Length - 1) = Base, Title); -- procedure Left justify S.Clear; S.Set (Base); S.Left_Justify (Width => Base'Length + 2); A.Assert (S = Base & Space & Space, Title); S.Clear; S.Set (Base); S.Left_Justify (Width => Base'Length - 1); A.Assert (S = Base, Title); S.Clear; S.Set (Base); S.Left_Justify (Base'Length + 2, First_Displayable); A.Assert (S = Base & First_Displayable & First_Displayable, Title); -- function Left justify S.Clear; S.Set (Base); A.Assert (S.Left_Justify (Base'Length + 2) = Base & Space & Space, Title); A.Assert (S.Left_Justify (Base'Length - 1) = Base, Title); A.Assert (S.Left_Justify (Base'Length + 2, First_Displayable) = Base & First_Displayable & First_Displayable, Title); -- procedure Right justify S.Clear; S.Set (Base); S.Right_Justify (Width => Base'Length + 2); A.Assert (S = Space & Space & Base, Title); S.Clear; S.Set (Base); S.Right_Justify (Width => Base'Length - 1); A.Assert (S = Base, Title); S.Clear; S.Set (Base); S.Right_Justify (Base'Length + 2, First_Displayable); A.Assert (S = First_Displayable & First_Displayable & Base, Title); -- function Right justify S.Set (Base); A.Assert (S.Right_Justify (Base'Length + 2) = Space & Space & Base, Title); A.Assert (S.Right_Justify (Base'Length - 1) = Base, Title); A.Assert (S.Right_Justify (Base'Length + 2, First_Displayable) = First_Displayable & First_Displayable & Base, Title); end Test_Justify; ---------------- -- Test_Split -- ---------------- procedure Test_Split (Base : Char_String) is Is_Long : constant Boolean := Base'Length > Natural (Strings.SSize'Last); S, S2 : XString; begin S.Set (Space & Space & Base & Space & Base & Space & Base & Space & Space); Reset_Mem; declare R : constant XString_Array := S.Split (Space); begin -- 3 copies per non-null substring when not copy-on-write -- 1 copy when creating the slide -- 2 copies when returning the array, since have a temporary -- created by the compiler A.Assert (Memory.Allocs = (if Is_Long and not Copy_On_Write then 9 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); A.Assert (R'Length = 7, Title); A.Assert (R (R'First + 0) = Null_XString, Title); A.Assert (R (R'First + 1) = Null_String, Title); A.Assert (R (R'First + 2) = Base, Title); A.Assert (R (R'First + 3) = Base, Title); A.Assert (R (R'First + 4) = Base, Title); A.Assert (R (R'First + 5) = Null_String, Title); A.Assert (R (R'First + 6) = Null_String, Title); S2.Set_As_Join (Space, R); A.Assert (S2 = S, Title); A.Assert (Join (Space, R) = S, Title); A.Assert (Join ((1 => Space), R) = S, Title); end; Reset_Mem; declare R : XString_Array (1 .. 20); Last : Natural; begin S.Split (Space, Into => R, Last => Last); -- One copy per non-null substring when not copy-on-write A.Assert (Memory.Allocs = (if Is_Long and not Copy_On_Write then 3 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); A.Assert (Last = 7, Title); end; Reset_Mem; declare R : constant XString_Array := S.Right_Split (Space); begin -- Three copies per non-null substring when not copy-on-write A.Assert (Memory.Allocs = (if Is_Long and not Copy_On_Write then 9 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); A.Assert (R'Length = 7, Title); A.Assert (R (R'First + 6) = Null_XString, Title); A.Assert (R (R'First + 5) = Null_String, Title); A.Assert (R (R'First + 4) = Base, Title); A.Assert (R (R'First + 3) = Base, Title); A.Assert (R (R'First + 2) = Base, Title); A.Assert (R (R'First + 1) = Null_String, Title); A.Assert (R (R'First + 0) = Null_String, Title); end; Reset_Mem; declare R : XString_Array (1 .. 20); Last : Natural; begin S.Right_Split (Space, Into => R, Last => Last); A.Assert (Memory.Allocs = (if Is_Long and not Copy_On_Write then 3 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); A.Assert (Last = 7, Title); end; declare R : constant XString_Array := S.Split (Space, Max_Split => 1); R2 : constant XString_Array := S.Right_Split (Space, Max_Split => 1); begin A.Assert (R'Length = 1, Title); A.Assert (R (R'First + 0) = S, Title); A.Assert (R2'Length = 1, Title); A.Assert (R2 (R2'First + 0) = S, Title); S2.Set_As_Join (Space, R); A.Assert (S2 = S, Title); A.Assert (Join (Space, R) = S, Title); A.Assert (Join ((1 => Space), R) = S, Title); end; declare R : constant XString_Array := S.Split (Space, Max_Split => 2); R2 : constant XString_Array := S.Right_Split (Space, Max_Split => 2); begin A.Assert (R'Length = 2, Title); A.Assert (R (R'First + 0) = Null_XString, Title); A.Assert (R (R'First + 1) = Space & Base & Space & Base & Space & Base & Space & Space, Title); A.Assert (R2'Length = 2, Title); A.Assert (R2 (R2'First + 0) = Null_XString, Title); A.Assert (R2 (R2'First + 1) = Space & Space & Base & Space & Base & Space & Base & Space, Title); S2.Set_As_Join (Space, R); A.Assert (S2 = S, Title); A.Assert (Join (Space, R) = S, Title); A.Assert (Join ((1 => Space), R) = S, Title); end; declare R : constant XString_Array := S.Split (Space, Omit_Empty => True); R2 : constant XString_Array := S.Right_Split (Space, Omit_Empty => True); begin A.Assert (R'Length = 3, Title); A.Assert (R (R'First + 0) = Base, Title); A.Assert (R (R'First + 1) = Base, Title); A.Assert (R (R'First + 2) = Base, Title); A.Assert (R2'Length = 3, Title); A.Assert (R2 (R2'First + 2) = Base, Title); A.Assert (R2 (R2'First + 1) = Base, Title); A.Assert (R2 (R2'First + 0) = Base, Title); end; declare R : constant XString_Array := Null_XString.Split (Space, Omit_Empty => True); R2 : constant XString_Array := Null_XString.Right_Split (Space, Omit_Empty => True); begin A.Assert (R'Length = 0, Title); A.Assert (R2'Length = 0, Title); end; -- Splitting on strings declare R : constant XString_Array := S.Split (Space & Space); begin A.Assert (R'Length = 3, Title); A.Assert (R (R'First + 0) = Null_XString, Title); A.Assert (R (R'First + 1) = Base & Space & Base & Space & Base, Title); A.Assert (R (R'First + 2) = Null_XString, Title); end; declare R : constant XString_Array := S.Split (Space & Space, Omit_Empty => True); begin A.Assert (R'Length = 1, Title); A.Assert (R (R'First + 0) = Base & Space & Base & Space & Base, Title); end; A.Assert (Null_XString.Split (Space & Space)'Length = 0, Title); A.Assert (Null_XString.Split (Null_String)'Length = 0, Title); A.Assert (S.Split (Null_String)'Length = 0, Title); declare R : constant XString_Array := S.Right_Split (Space & Space); begin A.Assert (R'Length = 3, Title); A.Assert (R (R'First + 0) = Null_XString, Title); A.Assert (R (R'First + 1) = Base & Space & Base & Space & Base, Title); A.Assert (R (R'First + 2) = Null_XString, Title); end; declare R : constant XString_Array := S.Right_Split (Space & Space, Omit_Empty => True); begin A.Assert (R'Length = 1, Title); A.Assert (R (R'First + 0) = Base & Space & Base & Space & Base, Title); end; A.Assert (Null_XString.Right_Split (Space & Space)'Length = 0, Title); A.Assert (Null_XString.Right_Split (Null_String)'Length = 0, Title); A.Assert (S.Right_Split (Null_String)'Length = 0, Title); -- Joining A.Assert (Join (Null_XString, XString_Array'(1 .. 0 => Null_XString)) = Null_XString, Title); A.Assert (Join (Space, XString_Array'(1 .. 0 => Null_XString)) = Null_XString, Title); A.Assert (Join (Space & Space, XString_Array'(1 .. 0 => Null_XString)) = Null_XString, Title); -- Parsing a file containing "key = value" lines declare L : XString_Array (1 .. 2); Key, Value : XString; Last : Natural; begin S.Set (Spaces & Newline & Base & Equal & Base & Newline & Base & Equal & Base & Newline & Base & Equal & Base & Newline); Reset_Mem; for Line of S.Split (Newline) loop Line.Split (Equal, Into => L, Last => Last); if Last = 2 then Key := L (1); Key.Trim; Value := L (2); Value.Trim; end if; end loop; A.Assert (Memory.Allocs = (if Is_Long and not Copy_On_Write then 14 else 0), Title); A.Assert (Memory.Reallocs = 0, Title); end; end Test_Split; ----------------- -- Test_Search -- ----------------- procedure Test_Search (Base : Char_String) is S, S2 : XString; begin S.Set (Space & Space & Base & Space & Base & Space & Base & Space & Space); A.Assert (S.Count (Space) = 6, Title); A.Assert (S.Count (Char_Type'Val (0)) = 0, Title); A.Assert (S.Count (Space & Space) = 2, Title); A.Assert (S.Count (First_Displayable & Char_Type'Succ (First_Displayable)) = 3, Title); A.Assert (S.Count (Null_String) = Natural'Last, Title); A.Assert (Null_XString.Count (Space) = 0, Title); A.Assert (Null_XString.Count (Space & Space) = 0, Title); A.Assert (Null_XString.Count (Null_String) = 0, Title); A.Assert (S.Find (Space) = 1, Title); A.Assert (S.Find (Space & Space) = 1, Title); A.Assert (S.Slice (2, 3).Find (Space) = 1, Title); A.Assert (S.Slice (3, Base'Length * 2).Find (Space) = Base'Length + 1, Title); A.Assert (S.Find (Space, Low => 2, High => 3) = 2, Title); A.Assert (S.Find (Space, Low => 3) = Base'Length + 3, Title); A.Assert (S.Find (Base, Low => 3, High => 4) = 0, Title); A.Assert (S.Find (First_Displayable) = 3, Title); A.Assert (S.Find (Base) = 3, Title); A.Assert (S.Right_Find (Space) = S.Length, Title); A.Assert (S.Right_Find (Space & Space) = S.Length - 1, Title); A.Assert (S.Right_Find (Base) = S.Length - 1 - Base'Length, Title); A.Assert (S.Find (First_Displayable & First_Displayable) = 0, Title); A.Assert (S.Right_Find (First_Displayable & First_Displayable) = 0, Title); end Test_Search; ----------------- -- Test_Casing -- ----------------- procedure Test_Casing is S : XString; S2 : XString; begin S.Set (Short); A.Assert (S.Is_Upper = True, Title); A.Assert (S.Is_Lower = False, Title); S2 := To_Lower(S); A.Assert (S2.Is_Upper = False, Title); A.Assert (S2.Is_Lower = True, Title); S.To_Lower; A.Assert (S.Is_Upper = False, Title); A.Assert (S.Is_Lower = True, Title); S.Capitalize; A.Assert ((Slice (S, 1, 1).Is_Upper and Slice (S, 2, S.Length).Is_Lower) = True, Title); A.Assert ((Slice (S, 1, 1).Is_Lower or Slice (S, 2, S.Length).Is_Upper) = False, Title); S2 := To_Upper(S); A.Assert (S2.Is_Upper = True, Title); A.Assert (S2.Is_Lower = False, Title); S.To_Upper; A.Assert (S.Is_Upper = True, Title); A.Assert (S.Is_Lower = False, Title); S.Set (Long); A.Assert (S.Is_Upper = (Long'Length < 100), Title); A.Assert (S.Is_Lower = False, Title); S2 := To_Lower(S); A.Assert (S2.Is_Upper = False, Title); A.Assert (S2.Is_Lower = True, Title); S.To_Lower; A.Assert (S.Is_Upper = False, Title); A.Assert (S.Is_Lower = True, Title); S2 := To_Upper(S); A.Assert (S2.Is_Upper = True, Title); A.Assert (S2.Is_Lower = False, Title); S.To_Upper; A.Assert (S.Is_Upper = True, Title); A.Assert (S.Is_Lower = False, Title); S.Capitalize; A.Assert ((Slice (S, 1, 1).Is_Upper and Slice (S, 2, S.Length).Is_Lower) = True, Title); A.Assert ((Slice (S, 1, 1).Is_Lower or Slice (S, 2, S.Length).Is_Upper) = False, Title); end Test_Casing; ----------------- -- Test_Access -- ----------------- procedure Test_Access is S : XString; Is_Long : Boolean; procedure Callback (Data : Char_String) is begin A.Assert (Data = (if Is_Long then Long else Short), Title); S.Append (Space); A.Assert (Data = (if Is_Long then Long else Short), Title); A.Assert (S = (if Is_Long then Long else Short) & Space, Title); S := Null_XString; A.Assert (Data = (if Is_Long then Long else Short), Title); end Callback; begin S.Set (Short); Is_Long := False; S.Access_String (Callback'Access); S.Set (Long); Is_Long := True; S.Access_String (Callback'Access); end Test_Access; begin declare C : Char_Type := First_Displayable; begin for S in Short'Range loop Short (S) := C; C := Char_Type'Succ (C); end loop; C := First_Displayable; for S in Long'Range loop Long (S) := C; C := Char_Type'Succ (C); end loop; end; declare -- coverage of function '*' (Count : Natural; -- Right : Char_Type) return XString -- and of function '*' (Count : Natural; -- Right : XString) return XString S1 : XString := 4 * First_Displayable; S2 : XString := 4 * S1; begin A.Assert (S1.Length = 4); A.Assert (S1 (1) = First_Displayable); A.Assert (S1 (S1.Length) = First_Displayable); A.Assert (S2.Length = 16); A.Assert (S2 (1) = First_Displayable); A.Assert (S2 (S2.Length) = First_Displayable); end; Test_Append; Test_Compare; Test_Indexing (Short); Test_Indexing (Long); Test_Trim; Test_Substrings; Test_Starts; Test_Head_Tail; Test_Iterate; Test_Modify (Short); Test_Modify (Long); Test_Shrink; Test_Swap; Test_Justify (Short); Test_Justify (Long); Test_Search (Short); Test_Search (Long); Test_Split (Short); Test_Split (Long); Test_Casing; Test_Access; end Do_Test; procedure Test_COW is new Do_Test (GNATCOLL.Strings); package Basic_No_COW is new GNATCOLL.Strings_Impl.Strings (GNATCOLL.Strings_Impl.Optimal_String_Size, Character, String, Copy_On_Write => False); procedure Test_No_COW is new Do_Test (Basic_No_COW); type SSize_3 is mod 128; package Strings3 is new GNATCOLL.Strings_Impl.Strings (SSize_3, Character, String); procedure Test3 is new Do_Test (Strings3); type SSize_2 is mod 10; package Wide is new GNATCOLL.Strings_Impl.Strings (SSize_2, Wide_Character, Wide_String, Copy_On_Write => True); procedure Test_Wide is new Do_Test (Wide); begin Test_No_COW("basic strings, no COW"); Test_COW("basic strings, with COW"); Test3("strings with size" & SSize_3'Last'Img); Test_Wide("wide strings"); return A.Report; end Test;