From 798a90555d7d72881c3d81d773328dc4156b4e6e Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 15 Mar 2005 16:52:27 +0100 Subject: [PATCH] a-stzunb.adb, [...]: Move Realloc_For_Chunk to private part of package. 2005-03-08 Robert Dewar * a-stzunb.adb, a-stzunb.adb a-stzunb.ads, a-stzunb.ads, a-stwiun.ads, a-stwiun.adb, a-strunb.ads, a-strunb.adb: Move Realloc_For_Chunk to private part of package. New subprograms for AI-301 * a-szuzti.adb, a-suteio.adb, a-swuwti.adb: Improve efficiency of Get_Line procedure. Avoid unnecessary use of Get/Set_Wide_String From-SVN: r96487 --- gcc/ada/a-strunb.adb | 14 +-- gcc/ada/a-strunb.ads | 25 +++- gcc/ada/a-stwiun.adb | 265 ++++++++++++++++++++++++++++++------------- gcc/ada/a-stwiun.ads | 96 +++++++++++++--- gcc/ada/a-stzunb.adb | 259 +++++++++++++++++++++++++++++------------- gcc/ada/a-stzunb.ads | 103 ++++++++++++++--- gcc/ada/a-suteio.adb | 77 +++++++------ gcc/ada/a-swuwti.adb | 77 +++++++------ gcc/ada/a-szuzti.adb | 82 ++++++------- 9 files changed, 671 insertions(+), 327 deletions(-) diff --git a/gcc/ada/a-strunb.adb b/gcc/ada/a-strunb.adb index 8a997b3cf41..bf492ebedd0 100644 --- a/gcc/ada/a-strunb.adb +++ b/gcc/ada/a-strunb.adb @@ -39,16 +39,6 @@ package body Ada.Strings.Unbounded is use Ada.Finalization; - procedure Realloc_For_Chunk - (Source : in out Unbounded_String; - Chunk_Size : Natural); - pragma Inline (Realloc_For_Chunk); - -- Adjust the size allocated for the string. Add at least Chunk_Size so it - -- is safe to add a string of this size at the end of the current content. - -- The real size allocated for the string is Chunk_Size + x of the current - -- string size. This buffered handling makes the Append unbounded string - -- routines very fast. - --------- -- "&" -- --------- @@ -202,7 +192,7 @@ package body Ada.Strings.Unbounded is Result.Reference := new String (1 .. Result.Last); K := 1; - for I in 1 .. Left loop + for J in 1 .. Left loop Result.Reference (K .. K + Len - 1) := Right.Reference (1 .. Right.Last); K := K + Len; @@ -363,7 +353,7 @@ package body Ada.Strings.Unbounded is procedure Adjust (Object : in out Unbounded_String) is begin -- Copy string, except we do not copy the statically allocated null - -- string, since it can never be deallocated. Note that we do not copy + -- string since it can never be deallocated. Note that we do not copy -- extra string room here to avoid dragging unused allocated memory. if Object.Reference /= Null_String'Access then diff --git a/gcc/ada/a-strunb.ads b/gcc/ada/a-strunb.ads index c974b879e27..9c7ffcf9506 100644 --- a/gcc/ada/a-strunb.ads +++ b/gcc/ada/a-strunb.ads @@ -405,18 +405,31 @@ private pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String); pragma Finalize_Storage_Only (Unbounded_String); + -- Finalization is required only for freeing storage procedure Initialize (Object : in out Unbounded_String); procedure Adjust (Object : in out Unbounded_String); procedure Finalize (Object : in out Unbounded_String); - -- Note: the following declaration is illegal since library level - -- controlled objects are not allowed in preelaborated units. See - -- AI-161 for a discussion of this issue and an attempt to address it. - -- Meanwhile, what happens in GNAT is that this check is omitted for - -- internal implementation units (see check in sem_cat.adb). + procedure Realloc_For_Chunk + (Source : in out Unbounded_String; + Chunk_Size : Natural); + pragma Inline (Realloc_For_Chunk); + -- Adjust the size allocated for the string. Add at least Chunk_Size so it + -- is safe to add a string of this size at the end of the current content. + -- The real size allocated for the string is Chunk_Size + x of the current + -- string size. This buffered handling makes the Append unbounded string + -- routines very fast. This spec is in the private part so that it can be + -- accessed from children (e.g. from Unbounded.Text_IO). Null_Unbounded_String : constant Unbounded_String := - (AF.Controlled with Reference => Null_String'Access, Last => 0); + (AF.Controlled with + Reference => Null_String'Access, + Last => 0); + -- Note: this declaration is illegal since library level controlled + -- objects are not allowed in preelaborated units. See AI-161 for a + -- discussion of this issue and an attempt to address it. Meanwhile, + -- what happens in GNAT is that this check is omitted for internal + -- implementation units (see check in sem_cat.adb). end Ada.Strings.Unbounded; diff --git a/gcc/ada/a-stwiun.adb b/gcc/ada/a-stwiun.adb index b4217720079..e722111c8db 100644 --- a/gcc/ada/a-stwiun.adb +++ b/gcc/ada/a-stwiun.adb @@ -39,16 +39,6 @@ package body Ada.Strings.Wide_Unbounded is use Ada.Finalization; - procedure Realloc_For_Chunk - (Source : in out Unbounded_Wide_String; - Chunk_Size : Natural); - pragma Inline (Realloc_For_Chunk); - -- Adjust the size allocated for the string. Add at least Chunk_Size so it - -- is safe to add a string of this size at the end of the current - -- content. The real size allocated for the string is Chunk_Size + x % - -- of the current string size. This buffered handling makes the Append - -- unbounded wide string routines very fast. - --------- -- "&" -- --------- @@ -142,7 +132,6 @@ package body Ada.Strings.Wide_Unbounded is Result.Reference (1) := Left; Result.Reference (2 .. Result.Last) := Right.Reference (1 .. Right.Last); - return Result; end "&"; @@ -157,7 +146,7 @@ package body Ada.Strings.Wide_Unbounded is Result : Unbounded_Wide_String; begin - Result.Last := Left; + Result.Last := Left; Result.Reference := new Wide_String (1 .. Left); for J in Result.Reference'Range loop @@ -195,7 +184,7 @@ package body Ada.Strings.Wide_Unbounded is is Len : constant Natural := Right.Last; K : Positive; - Result : Unbounded_Wide_String; + Result : Unbounded_Wide_String; begin Result.Last := Left * Len; @@ -203,7 +192,7 @@ package body Ada.Strings.Wide_Unbounded is Result.Reference := new Wide_String (1 .. Result.Last); K := 1; - for I in 1 .. Left loop + for J in 1 .. Left loop Result.Reference (K .. K + Len - 1) := Right.Reference (1 .. Right.Last); K := K + Len; @@ -363,10 +352,9 @@ package body Ada.Strings.Wide_Unbounded is procedure Adjust (Object : in out Unbounded_Wide_String) is begin - -- Copy string, except we do not copy the statically allocated - -- null string, since it can never be deallocated. - -- Note that we do not copy extra string room here to avoid dragging - -- unused allocated memory. + -- Copy string, except we do not copy the statically allocated null + -- string, since it can never be deallocated. Note that we do not copy + -- extra string room here to avoid dragging unused allocated memory. if Object.Reference /= Null_Wide_String'Access then Object.Reference := @@ -417,13 +405,13 @@ package body Ada.Strings.Wide_Unbounded is function Count (Source : Unbounded_Wide_String; Pattern : Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.Identity) + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) return Natural is begin - return Wide_Search.Count - (Source.Reference (1 .. Source.Last), Pattern, Mapping); + return + Wide_Search.Count + (Source.Reference (1 .. Source.Last), Pattern, Mapping); end Count; function Count @@ -432,8 +420,9 @@ package body Ada.Strings.Wide_Unbounded is Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin - return Wide_Search.Count - (Source.Reference (1 .. Source.Last), Pattern, Mapping); + return + Wide_Search.Count + (Source.Reference (1 .. Source.Last), Pattern, Mapping); end Count; function Count @@ -441,7 +430,9 @@ package body Ada.Strings.Wide_Unbounded is Set : Wide_Maps.Wide_Character_Set) return Natural is begin - return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set); + return + Wide_Search.Count + (Source.Reference (1 .. Source.Last), Set); end Count; ------------ @@ -454,9 +445,10 @@ package body Ada.Strings.Wide_Unbounded is Through : Natural) return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Delete - (Source.Reference (1 .. Source.Last), From, Through)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Delete + (Source.Reference (1 .. Source.Last), From, Through)); end Delete; procedure Delete @@ -505,7 +497,7 @@ package body Ada.Strings.Wide_Unbounded is procedure Finalize (Object : in out Unbounded_Wide_String) is procedure Deallocate is - new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access); + new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access); begin -- Note: Don't try to free statically allocated null string @@ -513,6 +505,7 @@ package body Ada.Strings.Wide_Unbounded is if Object.Reference /= Null_Wide_String'Access then Deallocate (Object.Reference); Object.Reference := Null_Unbounded_Wide_String.Reference; + Object.Last := 0; end if; end Finalize; @@ -539,6 +532,7 @@ package body Ada.Strings.Wide_Unbounded is procedure Free (X : in out Wide_String_Access) is procedure Deallocate is new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access); + begin -- Note: Do not try to free statically allocated null string @@ -557,9 +551,8 @@ package body Ada.Strings.Wide_Unbounded is Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is begin - return - To_Unbounded_Wide_String - (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); + return To_Unbounded_Wide_String + (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); end Head; procedure Head @@ -568,10 +561,10 @@ package body Ada.Strings.Wide_Unbounded is Pad : Wide_Character := Wide_Space) is Old : Wide_String_Access := Source.Reference; - begin - Source.Reference := new Wide_String' - (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); + Source.Reference := + new Wide_String' + (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad)); Source.Last := Source.Reference'Length; Free (Old); end Head; @@ -584,12 +577,13 @@ package body Ada.Strings.Wide_Unbounded is (Source : Unbounded_Wide_String; Pattern : Wide_String; Going : Strings.Direction := Strings.Forward; - Mapping : Wide_Maps.Wide_Character_Mapping := - Wide_Maps.Identity) return Natural + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural is begin - return Wide_Search.Index - (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); + return + Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); end Index; function Index @@ -599,8 +593,9 @@ package body Ada.Strings.Wide_Unbounded is Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural is begin - return Wide_Search.Index - (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); + return + Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); end Index; function Index @@ -614,13 +609,66 @@ package body Ada.Strings.Wide_Unbounded is (Source.Reference (1 .. Source.Last), Set, Test, Going); end Index; + function Index + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural + is + begin + return + Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); + end Index; + + function Index + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural + is + begin + return + Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); + end Index; + + + function Index + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + is + begin + return + Wide_Search.Index + (Source.Reference (1 .. Source.Last), Set, From, Test, Going); + end Index; + function Index_Non_Blank (Source : Unbounded_Wide_String; Going : Strings.Direction := Strings.Forward) return Natural is begin - return Wide_Search.Index_Non_Blank - (Source.Reference (1 .. Source.Last), Going); + return + Wide_Search.Index_Non_Blank + (Source.Reference (1 .. Source.Last), Going); + end Index_Non_Blank; + + function Index_Non_Blank + (Source : Unbounded_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural + is + begin + return + Wide_Search.Index_Non_Blank + (Source.Reference (1 .. Source.Last), From, Going); end Index_Non_Blank; ---------------- @@ -643,9 +691,10 @@ package body Ada.Strings.Wide_Unbounded is New_Item : Wide_String) return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Insert - (Source.Reference (1 .. Source.Last), Before, New_Item)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Insert + (Source.Reference (1 .. Source.Last), Before, New_Item)); end Insert; procedure Insert @@ -687,9 +736,10 @@ package body Ada.Strings.Wide_Unbounded is New_Item : Wide_String) return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Overwrite - (Source.Reference (1 .. Source.Last), Position, New_Item)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Overwrite + (Source.Reference (1 .. Source.Last), Position, New_Item)); end Overwrite; procedure Overwrite @@ -698,15 +748,12 @@ package body Ada.Strings.Wide_Unbounded is New_Item : Wide_String) is NL : constant Natural := New_Item'Length; - begin if Position <= Source.Last - NL + 1 then Source.Reference (Position .. Position + NL - 1) := New_Item; - else declare Old : Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_String' (Wide_Fixed.Overwrite @@ -734,7 +781,6 @@ package body Ada.Strings.Wide_Unbounded is Alloc_Chunk_Size : constant Positive := Chunk_Size + (S_Length / Growth_Factor); Tmp : Wide_String_Access; - begin Tmp := new Wide_String (1 .. S_Length + Alloc_Chunk_Size); Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last); @@ -772,20 +818,18 @@ package body Ada.Strings.Wide_Unbounded is By : Wide_String) return Unbounded_Wide_String is begin - return - To_Unbounded_Wide_String + return To_Unbounded_Wide_String (Wide_Fixed.Replace_Slice (Source.Reference (1 .. Source.Last), Low, High, By)); end Replace_Slice; procedure Replace_Slice - (Source : in out Unbounded_Wide_String; - Low : Positive; - High : Natural; - By : Wide_String) + (Source : in out Unbounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String) is Old : Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_String' (Wide_Fixed.Replace_Slice @@ -794,6 +838,20 @@ package body Ada.Strings.Wide_Unbounded is Free (Old); end Replace_Slice; + ------------------------------- + -- Set_Unbounded_Wide_String -- + ------------------------------- + + procedure Set_Unbounded_Wide_String + (Target : out Unbounded_Wide_String; + Source : Wide_String) + is + begin + Target.Last := Source'Length; + Target.Reference := new Wide_String (1 .. Source'Length); + Target.Reference.all := Source; + end Set_Unbounded_Wide_String; + ----------- -- Slice -- ----------- @@ -808,7 +866,6 @@ package body Ada.Strings.Wide_Unbounded is if Low > Source.Last + 1 or else High > Source.Last then raise Index_Error; - else return Source.Reference (Low .. High); end if; @@ -821,8 +878,7 @@ package body Ada.Strings.Wide_Unbounded is function Tail (Source : Unbounded_Wide_String; Count : Natural; - Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String - is + Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is begin return To_Unbounded_Wide_String (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); @@ -834,7 +890,6 @@ package body Ada.Strings.Wide_Unbounded is Pad : Wide_Character := Wide_Space) is Old : Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_String' (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); @@ -847,7 +902,8 @@ package body Ada.Strings.Wide_Unbounded is ------------------------------ function To_Unbounded_Wide_String - (Source : Wide_String) return Unbounded_Wide_String + (Source : Wide_String) + return Unbounded_Wide_String is Result : Unbounded_Wide_String; begin @@ -867,28 +923,33 @@ package body Ada.Strings.Wide_Unbounded is return Result; end To_Unbounded_Wide_String; - -------------------- + ------------------- -- To_Wide_String -- -------------------- function To_Wide_String - (Source : Unbounded_Wide_String) return Wide_String + (Source : Unbounded_Wide_String) + return Wide_String is begin return Source.Reference (1 .. Source.Last); end To_Wide_String; + --------------- -- Translate -- --------------- function Translate (Source : Unbounded_Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String + Mapping : Wide_Maps.Wide_Character_Mapping) + return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Translate + (Source.Reference (1 .. Source.Last), Mapping)); end Translate; procedure Translate @@ -905,8 +966,10 @@ package body Ada.Strings.Wide_Unbounded is return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Translate + (Source.Reference (1 .. Source.Last), Mapping)); end Translate; procedure Translate @@ -926,8 +989,9 @@ package body Ada.Strings.Wide_Unbounded is Side : Trim_End) return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); end Trim; procedure Trim @@ -936,8 +1000,9 @@ package body Ada.Strings.Wide_Unbounded is is Old : Wide_String_Access := Source.Reference; begin - Source.Reference := new Wide_String' - (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); + Source.Reference := + new Wide_String' + (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); Source.Last := Source.Reference'Length; Free (Old); end Trim; @@ -945,11 +1010,14 @@ package body Ada.Strings.Wide_Unbounded is function Trim (Source : Unbounded_Wide_String; Left : Wide_Maps.Wide_Character_Set; - Right : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String + Right : Wide_Maps.Wide_Character_Set) + return Unbounded_Wide_String is begin - return To_Unbounded_Wide_String - (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right)); + return + To_Unbounded_Wide_String + (Wide_Fixed.Trim + (Source.Reference (1 .. Source.Last), Left, Right)); end Trim; procedure Trim @@ -958,12 +1026,45 @@ package body Ada.Strings.Wide_Unbounded is Right : Wide_Maps.Wide_Character_Set) is Old : Wide_String_Access := Source.Reference; - begin - Source.Reference := new Wide_String' - (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right)); + Source.Reference := + new Wide_String' + (Wide_Fixed.Trim + (Source.Reference (1 .. Source.Last), Left, Right)); Source.Last := Source.Reference'Length; Free (Old); end Trim; + --------------------- + -- Unbounded_Slice -- + --------------------- + + function Unbounded_Slice + (Source : Unbounded_Wide_String; + Low : Positive; + High : Natural) return Unbounded_Wide_String + is + begin + if Low > Source.Last + 1 or else High > Source.Last then + raise Index_Error; + else + return To_Unbounded_Wide_String (Source.Reference.all (Low .. High)); + end if; + end Unbounded_Slice; + + procedure Unbounded_Slice + (Source : Unbounded_Wide_String; + Target : out Unbounded_Wide_String; + Low : Positive; + High : Natural) + is + begin + if Low > Source.Last + 1 or else High > Source.Last then + raise Index_Error; + else + Target := + To_Unbounded_Wide_String (Source.Reference.all (Low .. High)); + end if; + end Unbounded_Slice; + end Ada.Strings.Wide_Unbounded; diff --git a/gcc/ada/a-stwiun.ads b/gcc/ada/a-stwiun.ads index ed231b2e66c..037109c6878 100644 --- a/gcc/ada/a-stwiun.ads +++ b/gcc/ada/a-stwiun.ads @@ -40,7 +40,6 @@ with Ada.Finalization; package Ada.Strings.Wide_Unbounded is pragma Preelaborate (Wide_Unbounded); - type Unbounded_Wide_String is private; Null_Unbounded_Wide_String : constant Unbounded_Wide_String; @@ -62,7 +61,13 @@ pragma Preelaborate (Wide_Unbounded); (Length : Natural) return Unbounded_Wide_String; function To_Wide_String - (Source : Unbounded_Wide_String) return Wide_String; + (Source : Unbounded_Wide_String) + return Wide_String; + + procedure Set_Unbounded_Wide_String + (Target : out Unbounded_Wide_String; + Source : Wide_String); + pragma Ada_05 (Set_Unbounded_Wide_String); procedure Append (Source : in out Unbounded_Wide_String; @@ -77,7 +82,8 @@ pragma Preelaborate (Wide_Unbounded); New_Item : Wide_Character); function "&" - (Left, Right : Unbounded_Wide_String) return Unbounded_Wide_String; + (Left : Unbounded_Wide_String; + Right : Unbounded_Wide_String) return Unbounded_Wide_String; function "&" (Left : Unbounded_Wide_String; @@ -109,6 +115,19 @@ pragma Preelaborate (Wide_Unbounded); Low : Positive; High : Natural) return Wide_String; + function Unbounded_Slice + (Source : Unbounded_Wide_String; + Low : Positive; + High : Natural) return Unbounded_Wide_String; + pragma Ada_05 (Unbounded_Slice); + + procedure Unbounded_Slice + (Source : Unbounded_Wide_String; + Target : out Unbounded_Wide_String; + Low : Positive; + High : Natural); + pragma Ada_05 (Unbounded_Slice); + function "=" (Left : Unbounded_Wide_String; Right : Unbounded_Wide_String) return Boolean; @@ -192,10 +211,41 @@ pragma Preelaborate (Wide_Unbounded); Test : Membership := Inside; Going : Direction := Forward) return Natural; + function Index + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) + return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Unbounded_Wide_String; + Pattern : Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Unbounded_Wide_String; + Set : Wide_Maps.Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index); + function Index_Non_Blank (Source : Unbounded_Wide_String; Going : Direction := Forward) return Natural; + function Index_Non_Blank + (Source : Unbounded_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index_Non_Blank); + function Count (Source : Unbounded_Wide_String; Pattern : Wide_String; @@ -219,12 +269,13 @@ pragma Preelaborate (Wide_Unbounded); Last : out Natural); ------------------------------------ - -- Wide_String Translation Subprograms -- + -- String Translation Subprograms -- ------------------------------------ function Translate (Source : Unbounded_Wide_String; - Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String; + Mapping : Wide_Maps.Wide_Character_Mapping) + return Unbounded_Wide_String; procedure Translate (Source : in out Unbounded_Wide_String; @@ -240,7 +291,7 @@ pragma Preelaborate (Wide_Unbounded); Mapping : Wide_Maps.Wide_Character_Mapping_Function); --------------------------------------- - -- Wide_String Transformation Subprograms -- + -- String Transformation Subprograms -- --------------------------------------- function Replace_Slice @@ -250,10 +301,10 @@ pragma Preelaborate (Wide_Unbounded); By : Wide_String) return Unbounded_Wide_String; procedure Replace_Slice - (Source : in out Unbounded_Wide_String; - Low : Positive; - High : Natural; - By : Wide_String); + (Source : in out Unbounded_Wide_String; + Low : Positive; + High : Natural; + By : Wide_String); function Insert (Source : Unbounded_Wide_String; @@ -271,9 +322,9 @@ pragma Preelaborate (Wide_Unbounded); New_Item : Wide_String) return Unbounded_Wide_String; procedure Overwrite - (Source : in out Unbounded_Wide_String; - Position : Positive; - New_Item : Wide_String); + (Source : in out Unbounded_Wide_String; + Position : Positive; + New_Item : Wide_String); function Delete (Source : Unbounded_Wide_String; @@ -361,12 +412,29 @@ private (Unbounded_Wide_String, To_Unbounded_Wide, To_Wide_String); pragma Finalize_Storage_Only (Unbounded_Wide_String); + -- Finalization is required only for freeing storage procedure Initialize (Object : in out Unbounded_Wide_String); procedure Adjust (Object : in out Unbounded_Wide_String); procedure Finalize (Object : in out Unbounded_Wide_String); + procedure Realloc_For_Chunk + (Source : in out Unbounded_Wide_String; + Chunk_Size : Natural); + -- Adjust the size allocated for the string. Add at least Chunk_Size so it + -- is safe to add a string of this size at the end of the current content. + -- The real size allocated for the string is Chunk_Size + x of the current + -- string size. This buffered handling makes the Append unbounded string + -- routines very fast. + Null_Unbounded_Wide_String : constant Unbounded_Wide_String := - (AF.Controlled with Reference => Null_Wide_String'Access, Last => 0); + (AF.Controlled with + Reference => Null_Wide_String'Access, + Last => 0); + -- Note: this declaration is illegal since library level controlled + -- objects are not allowed in preelaborated units. See AI-161 for a + -- discussion of this issue and an attempt to address it. Meanwhile, + -- what happens in GNAT is that this check is omitted for internal + -- implementation units (see check in sem_cat.adb). end Ada.Strings.Wide_Unbounded; diff --git a/gcc/ada/a-stzunb.adb b/gcc/ada/a-stzunb.adb index c6c5c4a9bd8..8717bb37577 100644 --- a/gcc/ada/a-stzunb.adb +++ b/gcc/ada/a-stzunb.adb @@ -39,16 +39,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is use Ada.Finalization; - procedure Realloc_For_Chunk - (Source : in out Unbounded_Wide_Wide_String; - Chunk_Size : Natural); - pragma Inline (Realloc_For_Chunk); - -- Adjust the size allocated for the string. Add at least Chunk_Size so it - -- is safe to add a string of this size at the end of the current content. - -- The real size allocated for the string is Chunk_Size + x of the current - -- string size. This buffered handling makes the Append unbounded wide - -- string routines very fast. - --------- -- "&" -- --------- @@ -142,7 +132,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is Result.Reference (1) := Left; Result.Reference (2 .. Result.Last) := Right.Reference (1 .. Right.Last); - return Result; end "&"; @@ -157,7 +146,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is Result : Unbounded_Wide_Wide_String; begin - Result.Last := Left; + Result.Last := Left; Result.Reference := new Wide_Wide_String (1 .. Left); for J in Result.Reference'Range loop @@ -195,7 +184,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is is Len : constant Natural := Right.Last; K : Positive; - Result : Unbounded_Wide_Wide_String; + Result : Unbounded_Wide_Wide_String; begin Result.Last := Left * Len; @@ -203,7 +192,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is Result.Reference := new Wide_Wide_String (1 .. Result.Last); K := 1; - for I in 1 .. Left loop + for J in 1 .. Left loop Result.Reference (K .. K + Len - 1) := Right.Reference (1 .. Right.Last); K := K + Len; @@ -417,11 +406,13 @@ package body Ada.Strings.Wide_Wide_Unbounded is (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := - Wide_Wide_Maps.Identity) return Natural + Wide_Wide_Maps.Identity) + return Natural is begin - return Wide_Wide_Search.Count - (Source.Reference (1 .. Source.Last), Pattern, Mapping); + return + Wide_Wide_Search.Count + (Source.Reference (1 .. Source.Last), Pattern, Mapping); end Count; function Count @@ -431,8 +422,9 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Natural is begin - return Wide_Wide_Search.Count - (Source.Reference (1 .. Source.Last), Pattern, Mapping); + return + Wide_Wide_Search.Count + (Source.Reference (1 .. Source.Last), Pattern, Mapping); end Count; function Count @@ -440,8 +432,9 @@ package body Ada.Strings.Wide_Wide_Unbounded is Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural is begin - return Wide_Wide_Search.Count - (Source.Reference (1 .. Source.Last), Set); + return + Wide_Wide_Search.Count + (Source.Reference (1 .. Source.Last), Set); end Count; ------------ @@ -454,9 +447,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is Through : Natural) return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Delete - (Source.Reference (1 .. Source.Last), From, Through)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Delete + (Source.Reference (1 .. Source.Last), From, Through)); end Delete; procedure Delete @@ -506,7 +500,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is procedure Deallocate is new Ada.Unchecked_Deallocation - (Wide_Wide_String, Wide_Wide_String_Access); + (Wide_Wide_String, Wide_Wide_String_Access); begin -- Note: Don't try to free statically allocated null string @@ -514,6 +508,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is if Object.Reference /= Null_Wide_Wide_String'Access then Deallocate (Object.Reference); Object.Reference := Null_Unbounded_Wide_Wide_String.Reference; + Object.Last := 0; end if; end Finalize; @@ -540,7 +535,8 @@ package body Ada.Strings.Wide_Wide_Unbounded is procedure Free (X : in out Wide_Wide_String_Access) is procedure Deallocate is new Ada.Unchecked_Deallocation - (Wide_Wide_String, Wide_Wide_String_Access); + (Wide_Wide_String, Wide_Wide_String_Access); + begin -- Note: Do not try to free statically allocated null string @@ -560,10 +556,9 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Unbounded_Wide_Wide_String is begin - return - To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Head - (Source.Reference (1 .. Source.Last), Count, Pad)); + return To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Head + (Source.Reference (1 .. Source.Last), Count, Pad)); end Head; procedure Head @@ -572,11 +567,11 @@ package body Ada.Strings.Wide_Wide_Unbounded is Pad : Wide_Wide_Character := Wide_Wide_Space) is Old : Wide_Wide_String_Access := Source.Reference; - begin - Source.Reference := new Wide_Wide_String' - (Wide_Wide_Fixed.Head - (Source.Reference (1 .. Source.Last), Count, Pad)); + Source.Reference := + new Wide_Wide_String' + (Wide_Wide_Fixed.Head + (Source.Reference (1 .. Source.Last), Count, Pad)); Source.Last := Source.Reference'Length; Free (Old); end Head; @@ -590,11 +585,13 @@ package body Ada.Strings.Wide_Wide_Unbounded is Pattern : Wide_Wide_String; Going : Strings.Direction := Strings.Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := - Wide_Wide_Maps.Identity) return Natural + Wide_Wide_Maps.Identity) + return Natural is begin - return Wide_Wide_Search.Index - (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); + return + Wide_Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); end Index; function Index @@ -605,8 +602,9 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Natural is begin - return Wide_Wide_Search.Index - (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); + return + Wide_Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping); end Index; function Index @@ -620,13 +618,68 @@ package body Ada.Strings.Wide_Wide_Unbounded is (Source.Reference (1 .. Source.Last), Set, Test, Going); end Index; + function Index + (Source : Unbounded_Wide_Wide_String; + Pattern : Wide_Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := + Wide_Wide_Maps.Identity) + return Natural + is + begin + return + Wide_Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); + end Index; + + function Index + (Source : Unbounded_Wide_Wide_String; + Pattern : Wide_Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) + return Natural + is + begin + return + Wide_Wide_Search.Index + (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping); + end Index; + + + function Index + (Source : Unbounded_Wide_Wide_String; + Set : Wide_Wide_Maps.Wide_Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural + is + begin + return + Wide_Wide_Search.Index + (Source.Reference (1 .. Source.Last), Set, From, Test, Going); + end Index; + function Index_Non_Blank (Source : Unbounded_Wide_Wide_String; Going : Strings.Direction := Strings.Forward) return Natural is begin - return Wide_Wide_Search.Index_Non_Blank - (Source.Reference (1 .. Source.Last), Going); + return + Wide_Wide_Search.Index_Non_Blank + (Source.Reference (1 .. Source.Last), Going); + end Index_Non_Blank; + + function Index_Non_Blank + (Source : Unbounded_Wide_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural + is + begin + return + Wide_Wide_Search.Index_Non_Blank + (Source.Reference (1 .. Source.Last), From, Going); end Index_Non_Blank; ---------------- @@ -649,9 +702,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Insert - (Source.Reference (1 .. Source.Last), Before, New_Item)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Insert + (Source.Reference (1 .. Source.Last), Before, New_Item)); end Insert; procedure Insert @@ -693,9 +747,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Overwrite - (Source.Reference (1 .. Source.Last), Position, New_Item)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Overwrite + (Source.Reference (1 .. Source.Last), Position, New_Item)); end Overwrite; procedure Overwrite @@ -704,15 +759,12 @@ package body Ada.Strings.Wide_Wide_Unbounded is New_Item : Wide_Wide_String) is NL : constant Natural := New_Item'Length; - begin if Position <= Source.Last - NL + 1 then Source.Reference (Position .. Position + NL - 1) := New_Item; - else declare Old : Wide_Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_Wide_String' (Wide_Wide_Fixed.Overwrite @@ -740,7 +792,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is Alloc_Chunk_Size : constant Positive := Chunk_Size + (S_Length / Growth_Factor); Tmp : Wide_Wide_String_Access; - begin Tmp := new Wide_Wide_String (1 .. S_Length + Alloc_Chunk_Size); Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last); @@ -778,20 +829,18 @@ package body Ada.Strings.Wide_Wide_Unbounded is By : Wide_Wide_String) return Unbounded_Wide_Wide_String is begin - return - To_Unbounded_Wide_Wide_String + return To_Unbounded_Wide_Wide_String (Wide_Wide_Fixed.Replace_Slice (Source.Reference (1 .. Source.Last), Low, High, By)); end Replace_Slice; procedure Replace_Slice - (Source : in out Unbounded_Wide_Wide_String; - Low : Positive; - High : Natural; - By : Wide_Wide_String) + (Source : in out Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural; + By : Wide_Wide_String) is Old : Wide_Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_Wide_String' (Wide_Wide_Fixed.Replace_Slice @@ -800,6 +849,20 @@ package body Ada.Strings.Wide_Wide_Unbounded is Free (Old); end Replace_Slice; + ------------------------------------ + -- Set_Unbounded_Wide_Wide_String -- + ------------------------------------ + + procedure Set_Unbounded_Wide_Wide_String + (Target : out Unbounded_Wide_Wide_String; + Source : Wide_Wide_String) + is + begin + Target.Last := Source'Length; + Target.Reference := new Wide_Wide_String (1 .. Source'Length); + Target.Reference.all := Source; + end Set_Unbounded_Wide_Wide_String; + ----------- -- Slice -- ----------- @@ -814,7 +877,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is if Low > Source.Last + 1 or else High > Source.Last then raise Index_Error; - else return Source.Reference (Low .. High); end if; @@ -828,8 +890,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is (Source : Unbounded_Wide_Wide_String; Count : Natural; Pad : Wide_Wide_Character := Wide_Wide_Space) - return Unbounded_Wide_Wide_String - is + return Unbounded_Wide_Wide_String is begin return To_Unbounded_Wide_Wide_String (Wide_Wide_Fixed.Tail @@ -842,7 +903,6 @@ package body Ada.Strings.Wide_Wide_Unbounded is Pad : Wide_Wide_Character := Wide_Wide_Space) is Old : Wide_Wide_String_Access := Source.Reference; - begin Source.Reference := new Wide_Wide_String' (Wide_Wide_Fixed.Tail @@ -876,7 +936,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Result; end To_Unbounded_Wide_Wide_String; - -------------------- + ------------------- -- To_Wide_Wide_String -- -------------------- @@ -887,6 +947,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Source.Reference (1 .. Source.Last); end To_Wide_Wide_String; + --------------- -- Translate -- --------------- @@ -897,9 +958,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Translate - (Source.Reference (1 .. Source.Last), Mapping)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Translate + (Source.Reference (1 .. Source.Last), Mapping)); end Translate; procedure Translate @@ -907,8 +969,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) is begin - Wide_Wide_Fixed.Translate - (Source.Reference (1 .. Source.Last), Mapping); + Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping); end Translate; function Translate @@ -917,9 +978,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Translate - (Source.Reference (1 .. Source.Last), Mapping)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Translate + (Source.Reference (1 .. Source.Last), Mapping)); end Translate; procedure Translate @@ -927,8 +989,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) is begin - Wide_Wide_Fixed.Translate - (Source.Reference (1 .. Source.Last), Mapping); + Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping); end Translate; ---------- @@ -940,8 +1001,9 @@ package body Ada.Strings.Wide_Wide_Unbounded is Side : Trim_End) return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); end Trim; procedure Trim @@ -964,9 +1026,10 @@ package body Ada.Strings.Wide_Wide_Unbounded is return Unbounded_Wide_Wide_String is begin - return To_Unbounded_Wide_Wide_String - (Wide_Wide_Fixed.Trim - (Source.Reference (1 .. Source.Last), Left, Right)); + return + To_Unbounded_Wide_Wide_String + (Wide_Wide_Fixed.Trim + (Source.Reference (1 .. Source.Last), Left, Right)); end Trim; procedure Trim @@ -976,11 +1039,45 @@ package body Ada.Strings.Wide_Wide_Unbounded is is Old : Wide_Wide_String_Access := Source.Reference; begin - Source.Reference := new Wide_Wide_String' - (Wide_Wide_Fixed.Trim - (Source.Reference (1 .. Source.Last), Left, Right)); + Source.Reference := + new Wide_Wide_String' + (Wide_Wide_Fixed.Trim + (Source.Reference (1 .. Source.Last), Left, Right)); Source.Last := Source.Reference'Length; Free (Old); end Trim; + --------------------- + -- Unbounded_Slice -- + --------------------- + + function Unbounded_Slice + (Source : Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural) return Unbounded_Wide_Wide_String + is + begin + if Low > Source.Last + 1 or else High > Source.Last then + raise Index_Error; + else + return + To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High)); + end if; + end Unbounded_Slice; + + procedure Unbounded_Slice + (Source : Unbounded_Wide_Wide_String; + Target : out Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural) + is + begin + if Low > Source.Last + 1 or else High > Source.Last then + raise Index_Error; + else + Target := + To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High)); + end if; + end Unbounded_Slice; + end Ada.Strings.Wide_Wide_Unbounded; diff --git a/gcc/ada/a-stzunb.ads b/gcc/ada/a-stzunb.ads index 3090b6ee6b2..f32a4b63182 100644 --- a/gcc/ada/a-stzunb.ads +++ b/gcc/ada/a-stzunb.ads @@ -40,7 +40,6 @@ with Ada.Finalization; package Ada.Strings.Wide_Wide_Unbounded is pragma Preelaborate (Wide_Wide_Unbounded); - type Unbounded_Wide_Wide_String is private; Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String; @@ -64,6 +63,11 @@ pragma Preelaborate (Wide_Wide_Unbounded); function To_Wide_Wide_String (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String; + procedure Set_Unbounded_Wide_Wide_String + (Target : out Unbounded_Wide_Wide_String; + Source : Wide_Wide_String); + pragma Ada_05 (Set_Unbounded_Wide_Wide_String); + procedure Append (Source : in out Unbounded_Wide_Wide_String; New_Item : Unbounded_Wide_Wide_String); @@ -77,8 +81,8 @@ pragma Preelaborate (Wide_Wide_Unbounded); New_Item : Wide_Wide_Character); function "&" - (Left, Right : Unbounded_Wide_Wide_String) - return Unbounded_Wide_Wide_String; + (Left : Unbounded_Wide_Wide_String; + Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String; function "&" (Left : Unbounded_Wide_Wide_String; @@ -110,6 +114,19 @@ pragma Preelaborate (Wide_Wide_Unbounded); Low : Positive; High : Natural) return Wide_Wide_String; + function Unbounded_Slice + (Source : Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural) return Unbounded_Wide_Wide_String; + pragma Ada_05 (Unbounded_Slice); + + procedure Unbounded_Slice + (Source : Unbounded_Wide_Wide_String; + Target : out Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural); + pragma Ada_05 (Unbounded_Slice); + function "=" (Left : Unbounded_Wide_Wide_String; Right : Unbounded_Wide_Wide_String) return Boolean; @@ -179,7 +196,8 @@ pragma Preelaborate (Wide_Wide_Unbounded); Pattern : Wide_Wide_String; Going : Direction := Forward; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := - Wide_Wide_Maps.Identity) return Natural; + Wide_Wide_Maps.Identity) + return Natural; function Index (Source : Unbounded_Wide_Wide_String; @@ -194,15 +212,49 @@ pragma Preelaborate (Wide_Wide_Unbounded); Test : Membership := Inside; Going : Direction := Forward) return Natural; + function Index + (Source : Unbounded_Wide_Wide_String; + Pattern : Wide_Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := + Wide_Wide_Maps.Identity) + return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Unbounded_Wide_Wide_String; + Pattern : Wide_Wide_String; + From : Positive; + Going : Direction := Forward; + Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) + return Natural; + pragma Ada_05 (Index); + + function Index + (Source : Unbounded_Wide_Wide_String; + Set : Wide_Wide_Maps.Wide_Wide_Character_Set; + From : Positive; + Test : Membership := Inside; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index); + function Index_Non_Blank (Source : Unbounded_Wide_Wide_String; Going : Direction := Forward) return Natural; + function Index_Non_Blank + (Source : Unbounded_Wide_Wide_String; + From : Positive; + Going : Direction := Forward) return Natural; + pragma Ada_05 (Index_Non_Blank); + function Count (Source : Unbounded_Wide_Wide_String; Pattern : Wide_Wide_String; Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := - Wide_Wide_Maps.Identity) return Natural; + Wide_Wide_Maps.Identity) + return Natural; function Count (Source : Unbounded_Wide_Wide_String; @@ -222,7 +274,7 @@ pragma Preelaborate (Wide_Wide_Unbounded); Last : out Natural); ------------------------------------ - -- Wide_Wide_String Translation Subprograms -- + -- String Translation Subprograms -- ------------------------------------ function Translate @@ -244,7 +296,7 @@ pragma Preelaborate (Wide_Wide_Unbounded); Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function); --------------------------------------- - -- Wide_Wide_String Transformation Subprograms -- + -- String Transformation Subprograms -- --------------------------------------- function Replace_Slice @@ -254,10 +306,10 @@ pragma Preelaborate (Wide_Wide_Unbounded); By : Wide_Wide_String) return Unbounded_Wide_Wide_String; procedure Replace_Slice - (Source : in out Unbounded_Wide_Wide_String; - Low : Positive; - High : Natural; - By : Wide_Wide_String); + (Source : in out Unbounded_Wide_Wide_String; + Low : Positive; + High : Natural; + By : Wide_Wide_String); function Insert (Source : Unbounded_Wide_Wide_String; @@ -275,9 +327,9 @@ pragma Preelaborate (Wide_Wide_Unbounded); New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String; procedure Overwrite - (Source : in out Unbounded_Wide_Wide_String; - Position : Positive; - New_Item : Wide_Wide_String); + (Source : in out Unbounded_Wide_Wide_String; + Position : Positive; + New_Item : Wide_Wide_String); function Delete (Source : Unbounded_Wide_Wide_String; @@ -351,11 +403,11 @@ private function To_Unbounded_Wide (S : Wide_Wide_String) return Unbounded_Wide_Wide_String - renames To_Unbounded_Wide_Wide_String; + renames To_Unbounded_Wide_Wide_String; type Unbounded_Wide_Wide_String is new AF.Controlled with record Reference : Wide_Wide_String_Access := Null_Wide_Wide_String'Access; - Last : Natural := 0; + Last : Natural := 0; end record; -- The Unbounded_Wide_Wide_String is using a buffered implementation to @@ -369,12 +421,29 @@ private (Unbounded_Wide_Wide_String, To_Unbounded_Wide, To_Wide_Wide_String); pragma Finalize_Storage_Only (Unbounded_Wide_Wide_String); + -- Finalization is required only for freeing storage procedure Initialize (Object : in out Unbounded_Wide_Wide_String); procedure Adjust (Object : in out Unbounded_Wide_Wide_String); procedure Finalize (Object : in out Unbounded_Wide_Wide_String); + procedure Realloc_For_Chunk + (Source : in out Unbounded_Wide_Wide_String; + Chunk_Size : Natural); + -- Adjust the size allocated for the string. Add at least Chunk_Size so it + -- is safe to add a string of this size at the end of the current content. + -- The real size allocated for the string is Chunk_Size + x of the current + -- string size. This buffered handling makes the Append unbounded string + -- routines very fast. Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String := - (AF.Controlled with Reference => Null_Wide_Wide_String'Access, Last => 0); + (AF.Controlled with + Reference => + Null_Wide_Wide_String'Access, + Last => 0); + -- Note: this declaration is illegal since library level controlled + -- objects are not allowed in preelaborated units. See AI-161 for a + -- discussion of this issue and an attempt to address it. Meanwhile, + -- what happens in GNAT is that this check is omitted for internal + -- implementation units (see check in sem_cat.adb). end Ada.Strings.Wide_Wide_Unbounded; diff --git a/gcc/ada/a-suteio.adb b/gcc/ada/a-suteio.adb index b1ddff23741..41d5ead70ac 100644 --- a/gcc/ada/a-suteio.adb +++ b/gcc/ada/a-suteio.adb @@ -31,8 +31,7 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux; -with Ada.Text_IO; use Ada.Text_IO; +with Ada.Text_IO; use Ada.Text_IO; package body Ada.Strings.Unbounded.Text_IO is @@ -57,7 +56,8 @@ package body Ada.Strings.Unbounded.Text_IO is Str1 := Str2; end loop; - Set_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; @@ -78,49 +78,52 @@ package body Ada.Strings.Unbounded.Text_IO is Str1 := Str2; end loop; - Set_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; procedure Get_Line (Item : out Unbounded_String) is - Buffer : String (1 .. 1000); - Last : Natural; - Str1 : String_Access; - Str2 : String_Access; - begin - Get_Line (Buffer, Last); - Str1 := new String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; - - Set_String (Item, Str1); + Get_Line (Current_Input, Item); end Get_Line; procedure Get_Line (File : Ada.Text_IO.File_Type; Item : out Unbounded_String) is - Buffer : String (1 .. 1000); - Last : Natural; - Str1 : String_Access; - Str2 : String_Access; - begin - Get_Line (File, Buffer, Last); - Str1 := new String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; + -- We are going to read into the string that is already there and + -- allocated. Hopefully it is big enough now, if not, we will extend + -- it in the usual manner using Realloc_For_Chunk. - Set_String (Item, Str1); + -- Make sure we start with at least 80 characters + + if Item.Reference'Last < 80 then + Realloc_For_Chunk (Item, 80); + end if; + + -- Loop to read data, filling current string as far as possible. + -- Item.Last holds the number of characters read so far. + + Item.Last := 0; + loop + Get_Line + (File, + Item.Reference (Item.Last + 1 .. Item.Reference'Last), + Item.Last); + + -- If we hit the end of the line before the end of the buffer, then + -- we are all done, and the result length is properly set. + + if Item.Last < Item.Reference'Last then + return; + end if; + + -- If not enough room, double it and keep reading + + Realloc_For_Chunk (Item, Item.Last); + end loop; end Get_Line; --------- @@ -129,12 +132,12 @@ package body Ada.Strings.Unbounded.Text_IO is procedure Put (U : Unbounded_String) is begin - Put (Get_String (U).all); + Put (U.Reference (1 .. U.Last)); end Put; procedure Put (File : File_Type; U : Unbounded_String) is begin - Put (File, Get_String (U).all); + Put (File, U.Reference (1 .. U.Last)); end Put; -------------- @@ -143,12 +146,12 @@ package body Ada.Strings.Unbounded.Text_IO is procedure Put_Line (U : Unbounded_String) is begin - Put_Line (Get_String (U).all); + Put_Line (U.Reference (1 .. U.Last)); end Put_Line; procedure Put_Line (File : File_Type; U : Unbounded_String) is begin - Put_Line (File, Get_String (U).all); + Put_Line (File, U.Reference (1 .. U.Last)); end Put_Line; end Ada.Strings.Unbounded.Text_IO; diff --git a/gcc/ada/a-swuwti.adb b/gcc/ada/a-swuwti.adb index 9836ae5b58c..68cba087e7f 100644 --- a/gcc/ada/a-swuwti.adb +++ b/gcc/ada/a-swuwti.adb @@ -31,8 +31,7 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Strings.Wide_Unbounded.Aux; use Ada.Strings.Wide_Unbounded.Aux; -with Ada.Wide_Text_IO; use Ada.Wide_Text_IO; +with Ada.Wide_Text_IO; use Ada.Wide_Text_IO; package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is @@ -57,7 +56,8 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is Str1 := Str2; end loop; - Set_Wide_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; @@ -81,49 +81,52 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is Str1 := Str2; end loop; - Set_Wide_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; procedure Get_Line (Item : out Unbounded_Wide_String) is - Buffer : Wide_String (1 .. 1000); - Last : Natural; - Str1 : Wide_String_Access; - Str2 : Wide_String_Access; - begin - Get_Line (Buffer, Last); - Str1 := new Wide_String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; - - Set_Wide_String (Item, Str1); + Get_Line (Current_Input, Item); end Get_Line; procedure Get_Line (File : Ada.Wide_Text_IO.File_Type; Item : out Unbounded_Wide_String) is - Buffer : Wide_String (1 .. 1000); - Last : Natural; - Str1 : Wide_String_Access; - Str2 : Wide_String_Access; - begin - Get_Line (File, Buffer, Last); - Str1 := new Wide_String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; + -- We are going to read into the string that is already there and + -- allocated. Hopefully it is big enough now, if not, we will extend + -- it in the usual manner using Realloc_For_Chunk. - Set_Wide_String (Item, Str1); + -- Make sure we start with at least 80 characters + + if Item.Reference'Last < 80 then + Realloc_For_Chunk (Item, 80); + end if; + + -- Loop to read data, filling current string as far as possible. + -- Item.Last holds the number of characters read so far. + + Item.Last := 0; + loop + Get_Line + (File, + Item.Reference (Item.Last + 1 .. Item.Reference'Last), + Item.Last); + + -- If we hit the end of the line before the end of the buffer, then + -- we are all done, and the result length is properly set. + + if Item.Last < Item.Reference'Last then + return; + end if; + + -- If not enough room, double it and keep reading + + Realloc_For_Chunk (Item, Item.Last); + end loop; end Get_Line; --------- @@ -132,12 +135,12 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is procedure Put (U : Unbounded_Wide_String) is begin - Put (Get_Wide_String (U).all); + Put (U.Reference (1 .. U.Last)); end Put; procedure Put (File : File_Type; U : Unbounded_Wide_String) is begin - Put (File, Get_Wide_String (U).all); + Put (File, U.Reference (1 .. U.Last)); end Put; -------------- @@ -146,12 +149,12 @@ package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is procedure Put_Line (U : Unbounded_Wide_String) is begin - Put_Line (Get_Wide_String (U).all); + Put_Line (U.Reference (1 .. U.Last)); end Put_Line; procedure Put_Line (File : File_Type; U : Unbounded_Wide_String) is begin - Put_Line (File, Get_Wide_String (U).all); + Put_Line (File, U.Reference (1 .. U.Last)); end Put_Line; end Ada.Strings.Wide_Unbounded.Wide_Text_IO; diff --git a/gcc/ada/a-szuzti.adb b/gcc/ada/a-szuzti.adb index e9af2eb1a88..037a5ed820b 100644 --- a/gcc/ada/a-szuzti.adb +++ b/gcc/ada/a-szuzti.adb @@ -31,10 +31,7 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Strings.Wide_Wide_Unbounded.Aux; -use Ada.Strings.Wide_Wide_Unbounded.Aux; -with Ada.Wide_Wide_Text_IO; -use Ada.Wide_Wide_Text_IO; +with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO; package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is @@ -59,13 +56,13 @@ package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is Str1 := Str2; end loop; - Set_Wide_Wide_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; function Get_Line - (File : Ada.Wide_Wide_Text_IO.File_Type) - return Unbounded_Wide_Wide_String + (File : Ada.Wide_Wide_Text_IO.File_Type) return Unbounded_Wide_Wide_String is Buffer : Wide_Wide_String (1 .. 1000); Last : Natural; @@ -84,49 +81,52 @@ package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is Str1 := Str2; end loop; - Set_Wide_Wide_String (Result, Str1); + Result.Reference := Str1; + Result.Last := Str1'Length; return Result; end Get_Line; procedure Get_Line (Item : out Unbounded_Wide_Wide_String) is - Buffer : Wide_Wide_String (1 .. 1000); - Last : Natural; - Str1 : Wide_Wide_String_Access; - Str2 : Wide_Wide_String_Access; - begin - Get_Line (Buffer, Last); - Str1 := new Wide_Wide_String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; - - Set_Wide_Wide_String (Item, Str1); + Get_Line (Current_Input, Item); end Get_Line; procedure Get_Line (File : Ada.Wide_Wide_Text_IO.File_Type; Item : out Unbounded_Wide_Wide_String) is - Buffer : Wide_Wide_String (1 .. 1000); - Last : Natural; - Str1 : Wide_Wide_String_Access; - Str2 : Wide_Wide_String_Access; - begin - Get_Line (File, Buffer, Last); - Str1 := new Wide_Wide_String'(Buffer (1 .. Last)); - while Last = Buffer'Last loop - Get_Line (Buffer, Last); - Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last)); - Free (Str1); - Str1 := Str2; - end loop; + -- We are going to read into the string that is already there and + -- allocated. Hopefully it is big enough now, if not, we will extend + -- it in the usual manner using Realloc_For_Chunk. - Set_Wide_Wide_String (Item, Str1); + -- Make sure we start with at least 80 characters + + if Item.Reference'Last < 80 then + Realloc_For_Chunk (Item, 80); + end if; + + -- Loop to read data, filling current string as far as possible. + -- Item.Last holds the number of characters read so far. + + Item.Last := 0; + loop + Get_Line + (File, + Item.Reference (Item.Last + 1 .. Item.Reference'Last), + Item.Last); + + -- If we hit the end of the line before the end of the buffer, then + -- we are all done, and the result length is properly set. + + if Item.Last < Item.Reference'Last then + return; + end if; + + -- If not enough room, double it and keep reading + + Realloc_For_Chunk (Item, Item.Last); + end loop; end Get_Line; --------- @@ -135,12 +135,12 @@ package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is procedure Put (U : Unbounded_Wide_Wide_String) is begin - Put (Get_Wide_Wide_String (U).all); + Put (U.Reference (1 .. U.Last)); end Put; procedure Put (File : File_Type; U : Unbounded_Wide_Wide_String) is begin - Put (File, Get_Wide_Wide_String (U).all); + Put (File, U.Reference (1 .. U.Last)); end Put; -------------- @@ -149,12 +149,12 @@ package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is procedure Put_Line (U : Unbounded_Wide_Wide_String) is begin - Put_Line (Get_Wide_Wide_String (U).all); + Put_Line (U.Reference (1 .. U.Last)); end Put_Line; procedure Put_Line (File : File_Type; U : Unbounded_Wide_Wide_String) is begin - Put_Line (File, Get_Wide_Wide_String (U).all); + Put_Line (File, U.Reference (1 .. U.Last)); end Put_Line; end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;