diff --git a/gcc/ada/a-stunau.adb b/gcc/ada/a-stunau.adb index 9b23cb2d1f6..0dbd3fd48c7 100644 --- a/gcc/ada/a-stunau.adb +++ b/gcc/ada/a-stunau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -37,31 +37,14 @@ package body Ada.Strings.Unbounded.Aux is -- Get_String -- ---------------- - function Get_String (U : Unbounded_String) return String_Access is + procedure Get_String + (U : Unbounded_String; + S : out String_Access; + L : out Natural) + is begin - if U.Last = U.Reference'Length then - return U.Reference; - - else - declare - type Unbounded_String_Access is access all Unbounded_String; - - U_Ptr : constant Unbounded_String_Access := U'Unrestricted_Access; - -- Unbounded_String is a controlled type which is always passed - -- by reference. It is always safe to take the pointer to such - -- object here. This pointer is used to set the U.Reference - -- value which would not be possible otherwise as U is read-only. - - Old : String_Access := U.Reference; - Ret : String_Access; - - begin - Ret := new String'(U.Reference (1 .. U.Last)); - U_Ptr.Reference := Ret; - Free (Old); - return Ret; - end; - end if; + S := U.Reference; + L := U.Last; end Get_String; ---------------- @@ -70,21 +53,13 @@ package body Ada.Strings.Unbounded.Aux is procedure Set_String (UP : in out Unbounded_String; S : String) is begin - if UP.Last = S'Length then - UP.Reference.all := S; - - else - declare - subtype String_1 is String (1 .. S'Length); - Tmp : String_Access; - - begin - Tmp := new String'(String_1 (S)); - Finalize (UP); - UP.Reference := Tmp; - UP.Last := UP.Reference'Length; - end; + if S'Length > UP.Last then + Finalize (UP); + UP.Reference := new String (1 .. S'Length); end if; + + UP.Reference (1 .. S'Length) := S; + UP.Last := S'Length; end Set_String; procedure Set_String (UP : in out Unbounded_String; S : String_Access) is diff --git a/gcc/ada/a-stunau.ads b/gcc/ada/a-stunau.ads index 6ba3e567140..05fbe126623 100644 --- a/gcc/ada/a-stunau.ads +++ b/gcc/ada/a-stunau.ads @@ -39,19 +39,22 @@ package Ada.Strings.Unbounded.Aux is pragma Preelaborate (Aux); - function Get_String (U : Unbounded_String) return String_Access; + procedure Get_String + (U : Unbounded_String; + S : out String_Access; + L : out Natural); pragma Inline (Get_String); - -- This function returns the internal string pointer used in the - -- representation of an unbounded string. There is no copy involved, - -- so the value obtained references the same string as the original - -- unbounded string. The characters of this string may not be modified - -- via the returned pointer, and are valid only as long as the original - -- unbounded string is not modified. Violating either of these two - -- rules results in erroneous execution. + -- This procedure returns the internal string pointer used in the + -- representation of an unbounded string as well as the actual current + -- length (which may be less than S.all'Length because in general there + -- can be extra space assigned). The characters of this string may be + -- not be modified via the returned pointer, and are valid only as + -- long as the original unbounded string is not accessed or modified. -- - -- This function is much more efficient than the use of To_String + -- This procedure is much more efficient than the use of To_String -- since it avoids the need to copy the string. The lower bound of the - -- referenced string returned by this call is always one. + -- referenced string returned by this call is always one, so the actual + -- string data is always accessible as S (1 .. L). procedure Set_String (UP : in out Unbounded_String; S : String); pragma Inline (Set_String); diff --git a/gcc/ada/a-swunau.adb b/gcc/ada/a-swunau.adb index 2d9a2dd0b1c..2f4c127b71b 100644 --- a/gcc/ada/a-swunau.adb +++ b/gcc/ada/a-swunau.adb @@ -37,33 +37,14 @@ package body Ada.Strings.Wide_Unbounded.Aux is -- Get_Wide_String -- --------------------- - function Get_Wide_String - (U : Unbounded_Wide_String) return Wide_String_Access + procedure Get_Wide_String + (U : Unbounded_Wide_String; + S : out Wide_String_Access; + L : out Natural) is begin - if U.Last = U.Reference'Length then - return U.Reference; - - else - declare - type Unbounded_Wide_String_Access is - access all Unbounded_Wide_String; - - U_Ptr : constant Unbounded_Wide_String_Access := - U'Unrestricted_Access; - -- Unbounded_Wide_String is a controlled type which is always - -- passed by copy it is always safe to take the pointer to such - -- object here. This pointer is used to set the U.Reference value - -- which would not be possible otherwise as U is read-only. - - Old : Wide_String_Access := U.Reference; - - begin - U_Ptr.Reference := new Wide_String'(U.Reference (1 .. U.Last)); - Free (Old); - return U.Reference; - end; - end if; + S := U.Reference; + L := U.Last; end Get_Wide_String; --------------------- @@ -75,20 +56,13 @@ package body Ada.Strings.Wide_Unbounded.Aux is S : Wide_String) is begin - if UP.Last = S'Length then - UP.Reference.all := S; - - else - declare - subtype String_1 is Wide_String (1 .. S'Length); - Tmp : Wide_String_Access; - begin - Tmp := new Wide_String'(String_1 (S)); - Finalize (UP); - UP.Reference := Tmp; - UP.Last := UP.Reference'Length; - end; + if S'Length > UP.Last then + Finalize (UP); + UP.Reference := new Wide_String (1 .. S'Length); end if; + + UP.Reference (1 .. S'Length) := S; + UP.Last := S'Length; end Set_Wide_String; procedure Set_Wide_String diff --git a/gcc/ada/a-swunau.ads b/gcc/ada/a-swunau.ads index dbecd4f0b11..da8bfc02342 100644 --- a/gcc/ada/a-swunau.ads +++ b/gcc/ada/a-swunau.ads @@ -39,20 +39,22 @@ package Ada.Strings.Wide_Unbounded.Aux is pragma Preelaborate (Aux); - function Get_Wide_String - (U : Unbounded_Wide_String) return Wide_String_Access; + procedure Get_Wide_String + (U : Unbounded_Wide_String; + S : out Wide_String_Access; + L : out Natural); pragma Inline (Get_Wide_String); - -- This function returns the internal string pointer used in the - -- representation of an unbounded string. There is no copy involved, - -- so the value obtained references the same string as the original - -- unbounded string. The characters of this string may not be modified - -- via the returned pointer, and are valid only as long as the original - -- unbounded string is not modified. Violating either of these two - -- rules results in erroneous execution. + -- This procedure returns the internal string pointer used in the + -- representation of an unbounded string as well as the actual current + -- length (which may be less than S.all'Length because in general there + -- can be extra space assigned). The characters of this string may be + -- not be modified via the returned pointer, and are valid only as + -- long as the original unbounded string is not accessed or modified. -- - -- This function is much more efficient than the use of To_Wide_String + -- This procedure is much more efficient than the use of To_Wide_String -- since it avoids the need to copy the string. The lower bound of the - -- referenced string returned by this call is always one. + -- referenced string returned by this call is always one, so the actual + -- string data is always accessible as S (1 .. L). procedure Set_Wide_String (UP : in out Unbounded_Wide_String; diff --git a/gcc/ada/a-szunau.adb b/gcc/ada/a-szunau.adb index e0f1acf50a8..c022a5b28e3 100644 --- a/gcc/ada/a-szunau.adb +++ b/gcc/ada/a-szunau.adb @@ -33,63 +33,36 @@ package body Ada.Strings.Wide_Wide_Unbounded.Aux is - -------------------------- + -------------------- -- Get_Wide_Wide_String -- - -------------------------- + --------------------- - function Get_Wide_Wide_String - (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access + procedure Get_Wide_Wide_String + (U : Unbounded_Wide_Wide_String; + S : out Wide_Wide_String_Access; + L : out Natural) is begin - if U.Last = U.Reference'Length then - return U.Reference; - - else - declare - type Unbounded_Wide_Wide_String_Access is - access all Unbounded_Wide_Wide_String; - - U_Ptr : constant Unbounded_Wide_Wide_String_Access := - U'Unrestricted_Access; - -- Unbounded_Wide_Wide_String is a controlled type which is always - -- passed by copy it is always safe to take the pointer to such - -- object here. This pointer is used to set the U.Reference value - -- which would not be possible otherwise as U is read-only. - - Old : Wide_Wide_String_Access := U.Reference; - - begin - U_Ptr.Reference := - new Wide_Wide_String'(U.Reference (1 .. U.Last)); - Free (Old); - return U.Reference; - end; - end if; + S := U.Reference; + L := U.Last; end Get_Wide_Wide_String; - -------------------------- + --------------------- -- Set_Wide_Wide_String -- - -------------------------- + --------------------- procedure Set_Wide_Wide_String (UP : in out Unbounded_Wide_Wide_String; S : Wide_Wide_String) is begin - if UP.Last = S'Length then - UP.Reference.all := S; - - else - declare - subtype String_1 is Wide_Wide_String (1 .. S'Length); - Tmp : Wide_Wide_String_Access; - begin - Tmp := new Wide_Wide_String'(String_1 (S)); - Finalize (UP); - UP.Reference := Tmp; - UP.Last := UP.Reference'Length; - end; + if S'Length > UP.Last then + Finalize (UP); + UP.Reference := new Wide_Wide_String (1 .. S'Length); end if; + + UP.Reference (1 .. S'Length) := S; + UP.Last := S'Length; end Set_Wide_Wide_String; procedure Set_Wide_Wide_String diff --git a/gcc/ada/a-szunau.ads b/gcc/ada/a-szunau.ads index dff8cb8e6c9..6333a1e7459 100644 --- a/gcc/ada/a-szunau.ads +++ b/gcc/ada/a-szunau.ads @@ -39,20 +39,22 @@ package Ada.Strings.Wide_Wide_Unbounded.Aux is pragma Preelaborate (Aux); - function Get_Wide_Wide_String - (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access; + procedure Get_Wide_Wide_String + (U : Unbounded_Wide_Wide_String; + S : out Wide_Wide_String_Access; + L : out Natural); pragma Inline (Get_Wide_Wide_String); - -- This function returns the internal string pointer used in the - -- representation of an unbounded string. There is no copy involved, - -- so the value obtained references the same string as the original - -- unbounded string. The characters of this string may not be modified - -- via the returned pointer, and are valid only as long as the original - -- unbounded string is not modified. Violating either of these two - -- rules results in erroneous execution. + -- This procedure returns the internal string pointer used in the + -- representation of an unbounded string as well as the actual current + -- length (which may be less than S.all'Length because in general there + -- can be extra space assigned). The characters of this string may be + -- not be modified via the returned pointer, and are valid only as + -- long as the original unbounded string is not accessed or modified. -- - -- This function is much more efficient than the use of To_Wide_Wide_String + -- This procedure is more efficient than the use of To_Wide_Wide_String -- since it avoids the need to copy the string. The lower bound of the - -- referenced string returned by this call is always one. + -- referenced string returned by this call is always one, so the actual + -- string data is always accessible as S (1 .. L). procedure Set_Wide_Wide_String (UP : in out Unbounded_Wide_Wide_String; diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb index 06f7542759c..6bc5f2480d9 100644 --- a/gcc/ada/g-spipat.adb +++ b/gcc/ada/g-spipat.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 1998-2005, Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2802,16 +2802,20 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString; - Pat : Pattern) - return Boolean + Pat : Pattern) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; return Start /= 0; @@ -2819,8 +2823,7 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : String; - Pat : Pattern) - return Boolean + Pat : Pattern) return Boolean is Start, Stop : Natural; subtype String1 is String (1 .. Subject'Length); @@ -2838,24 +2841,28 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString_Var; Pat : Pattern; - Replace : VString) - return Boolean + Replace : VString) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start = 0 then return False; else + Get_String (Replace, S, L); Replace_Slice - (Subject'Unrestricted_Access.all, - Start, Stop, Get_String (Replace).all); + (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L)); return True; end if; end Match; @@ -2863,16 +2870,20 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString_Var; Pat : Pattern; - Replace : String) - return Boolean + Replace : String) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start = 0 then @@ -2888,15 +2899,19 @@ package body GNAT.Spitbol.Patterns is (Subject : VString; Pat : Pattern) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin - if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); - else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); - end if; + Get_String (Subject, S, L); + if Debug_Mode then + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); + else + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); + end if; end Match; procedure Match @@ -2918,17 +2933,23 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern; Replace : VString) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start /= 0 then - Replace_Slice (Subject, Start, Stop, Get_String (Replace).all); + Get_String (Replace, S, L); + Replace_Slice (Subject, Start, Stop, S (1 .. L)); end if; end Match; @@ -2937,13 +2958,18 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern; Replace : String) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start /= 0 then @@ -2953,24 +2979,25 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString; - Pat : PString) - return Boolean + Pat : PString) return Boolean is - Pat_Len : constant Natural := Pat'Length; - Sub_Len : constant Natural := Length (Subject); - Sub_Str : constant String_Access := Get_String (Subject); + Pat_Len : constant Natural := Pat'Length; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Anchored_Mode then - if Pat_Len > Sub_Len then + if Pat_Len > L then return False; else - return Pat = Sub_Str.all (1 .. Pat_Len); + return Pat = S (1 .. Pat_Len); end if; else - for J in 1 .. Sub_Len - Pat_Len + 1 loop - if Pat = Sub_Str.all (J .. J + (Pat_Len - 1)) then + for J in 1 .. L - Pat_Len + 1 loop + if Pat = S (J .. J + (Pat_Len - 1)) then return True; end if; end loop; @@ -2981,8 +3008,7 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : String; - Pat : PString) - return Boolean + Pat : PString) return Boolean is Pat_Len : constant Natural := Pat'Length; Sub_Len : constant Natural := Subject'Length; @@ -3010,24 +3036,28 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString_Var; Pat : PString; - Replace : VString) - return Boolean + Replace : VString) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); else - XMatch (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatch (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); end if; if Start = 0 then return False; else + Get_String (Replace, S, L); Replace_Slice - (Subject'Unrestricted_Access.all, - Start, Stop, Get_String (Replace).all); + (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L)); return True; end if; end Match; @@ -3035,16 +3065,20 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString_Var; Pat : PString; - Replace : String) - return Boolean + Replace : String) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); else - XMatch (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatch (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); end if; if Start = 0 then @@ -3060,13 +3094,18 @@ package body GNAT.Spitbol.Patterns is (Subject : VString; Pat : PString) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); else - XMatch (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatch (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); end if; end Match; @@ -3090,17 +3129,23 @@ package body GNAT.Spitbol.Patterns is Pat : PString; Replace : VString) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); else - XMatch (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatch (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); end if; if Start /= 0 then - Replace_Slice (Subject, Start, Stop, Get_String (Replace).all); + Get_String (Replace, S, L); + Replace_Slice (Subject, Start, Stop, S (1 .. L)); end if; end Match; @@ -3109,13 +3154,18 @@ package body GNAT.Spitbol.Patterns is Pat : PString; Replace : String) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); else - XMatch (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop); + XMatch (S (1 .. L), S_To_PE (Pat), 0, Start, Stop); end if; if Start /= 0 then @@ -3126,16 +3176,20 @@ package body GNAT.Spitbol.Patterns is function Match (Subject : VString_Var; Pat : Pattern; - Result : Match_Result_Var) - return Boolean + Result : Match_Result_Var) return Boolean is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start = 0 then @@ -3155,18 +3209,22 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern; Result : out Match_Result) is - Start, Stop : Natural; + Start : Natural; + Stop : Natural; + S : String_Access; + L : Natural; begin + Get_String (Subject, S, L); + if Debug_Mode then - XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); else - XMatch (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop); + XMatch (S (1 .. L), Pat.P, Pat.Stk, Start, Stop); end if; if Start = 0 then Result.Var := null; - else Result.Var := Subject'Unrestricted_Access; Result.Start := Start; @@ -3302,13 +3360,14 @@ package body GNAT.Spitbol.Patterns is (Result : in out Match_Result; Replace : VString) is + S : String_Access; + L : Natural; + begin + Get_String (Replace, S, L); + if Result.Var /= null then - Replace_Slice - (Result.Var.all, - Result.Start, - Result.Stop, - Get_String (Replace).all); + Replace_Slice (Result.Var.all, Result.Start, Result.Stop, S (1 .. L)); Result.Var := null; end if; end Replace; @@ -3487,7 +3546,6 @@ package body GNAT.Spitbol.Patterns is function Str_BF (A : Boolean_Func) return String is function To_A is new Unchecked_Conversion (Boolean_Func, Address); - begin return "BF(" & Image (To_A (A)) & ')'; end Str_BF; @@ -3507,7 +3565,6 @@ package body GNAT.Spitbol.Patterns is function Str_NF (A : Natural_Func) return String is function To_A is new Unchecked_Conversion (Natural_Func, Address); - begin return "NF(" & Image (To_A (A)) & ')'; end Str_NF; @@ -3536,7 +3593,6 @@ package body GNAT.Spitbol.Patterns is function Str_VF (A : VString_Func) return String is function To_A is new Unchecked_Conversion (VString_Func, Address); - begin return "VF(" & Image (To_A (A)) & ')'; end Str_VF; @@ -3897,12 +3953,15 @@ package body GNAT.Spitbol.Patterns is -- Any (string function case) when PC_Any_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + if Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -3914,11 +3973,15 @@ package body GNAT.Spitbol.Patterns is -- Any (string pointer case) when PC_Any_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + if Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -4077,12 +4140,15 @@ package body GNAT.Spitbol.Patterns is -- Break (string function case) when PC_Break_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -4095,11 +4161,15 @@ package body GNAT.Spitbol.Patterns is -- Break (string pointer case) when PC_Break_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -4138,12 +4208,15 @@ package body GNAT.Spitbol.Patterns is -- BreakX (string function case) when PC_BreakX_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -4156,11 +4229,15 @@ package body GNAT.Spitbol.Patterns is -- BreakX (string pointer case) when PC_BreakX_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -4298,13 +4375,16 @@ package body GNAT.Spitbol.Patterns is -- NotAny (string function case) when PC_NotAny_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + if Cursor < Length and then - not Is_In (Subject (Cursor + 1), Str.all) + not Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -4316,12 +4396,16 @@ package body GNAT.Spitbol.Patterns is -- NotAny (string pointer case) when PC_NotAny_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + if Cursor < Length and then - not Is_In (Subject (Cursor + 1), Str.all) + not Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -4355,12 +4439,15 @@ package body GNAT.Spitbol.Patterns is -- NSpan (string function case) when PC_NSpan_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) loop Cursor := Cursor + 1; end loop; @@ -4371,11 +4458,15 @@ package body GNAT.Spitbol.Patterns is -- NSpan (string pointer case) when PC_NSpan_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin + Get_String (U, S, L); + while Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) loop Cursor := Cursor + 1; end loop; @@ -4591,13 +4682,17 @@ package body GNAT.Spitbol.Patterns is -- Span (string function case) when PC_Span_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); - P : Natural := Cursor; + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; + P : Natural; begin + Get_String (U, S, L); + + P := Cursor; while P < Length - and then Is_In (Subject (P + 1), Str.all) + and then Is_In (Subject (P + 1), S (1 .. L)) loop P := P + 1; end loop; @@ -4613,12 +4708,17 @@ package body GNAT.Spitbol.Patterns is -- Span (string pointer case) when PC_Span_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); - P : Natural := Cursor; + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; + P : Natural; begin + Get_String (U, S, L); + + P := Cursor; while P < Length - and then Is_In (Subject (P + 1), Str.all) + and then Is_In (Subject (P + 1), S (1 .. L)) loop P := P + 1; end loop; @@ -4710,15 +4810,17 @@ package body GNAT.Spitbol.Patterns is -- String (function case) when PC_String_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); - Len : constant Natural := Str'Length; + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - if (Length - Cursor) >= Len - and then Str.all = Subject (Cursor + 1 .. Cursor + Len) + Get_String (U, S, L); + + if (Length - Cursor) >= L + and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L) then - Cursor := Cursor + Len; + Cursor := Cursor + L; goto Succeed; else goto Fail; @@ -4728,14 +4830,17 @@ package body GNAT.Spitbol.Patterns is -- String (pointer case) when PC_String_VP => declare - S : constant String_Access := Get_String (Node.VP.all); - Len : constant Natural := S'Length; + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - if (Length - Cursor) >= Len - and then S.all = Subject (Cursor + 1 .. Cursor + Len) + Get_String (U, S, L); + + if (Length - Cursor) >= L + and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L) then - Cursor := Cursor + Len; + Cursor := Cursor + L; goto Succeed; else goto Fail; @@ -5251,14 +5356,17 @@ package body GNAT.Spitbol.Patterns is -- Any (string function case) when PC_Any_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching Any", Str.all); + Get_String (U, S, L); + + Dout (Img (Node) & "matching Any", S (1 .. L)); if Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -5270,13 +5378,16 @@ package body GNAT.Spitbol.Patterns is -- Any (string pointer case) when PC_Any_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching Any", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching Any", S (1 .. L)); if Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -5454,14 +5565,16 @@ package body GNAT.Spitbol.Patterns is -- Break (string function case) when PC_Break_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching Break", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching Break", S (1 .. L)); while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -5474,13 +5587,16 @@ package body GNAT.Spitbol.Patterns is -- Break (string pointer case) when PC_Break_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching Break", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching Break", S (1 .. L)); while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -5523,14 +5639,16 @@ package body GNAT.Spitbol.Patterns is -- BreakX (string function case) when PC_BreakX_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching BreakX", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching BreakX", S (1 .. L)); while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -5543,13 +5661,16 @@ package body GNAT.Spitbol.Patterns is -- BreakX (string pointer case) when PC_BreakX_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching BreakX", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching BreakX", S (1 .. L)); while Cursor < Length loop - if Is_In (Subject (Cursor + 1), Str.all) then + if Is_In (Subject (Cursor + 1), S (1 .. L)) then goto Succeed; else Cursor := Cursor + 1; @@ -5565,7 +5686,6 @@ package body GNAT.Spitbol.Patterns is when PC_BreakX_X => Dout (Img (Node) & "extending BreakX"); - Cursor := Cursor + 1; goto Succeed; @@ -5708,15 +5828,17 @@ package body GNAT.Spitbol.Patterns is -- NotAny (string function case) when PC_NotAny_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching NotAny", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching NotAny", S (1 .. L)); if Cursor < Length and then - not Is_In (Subject (Cursor + 1), Str.all) + not Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -5728,14 +5850,17 @@ package body GNAT.Spitbol.Patterns is -- NotAny (string pointer case) when PC_NotAny_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching NotAny", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching NotAny", S (1 .. L)); if Cursor < Length and then - not Is_In (Subject (Cursor + 1), Str.all) + not Is_In (Subject (Cursor + 1), S (1 .. L)) then Cursor := Cursor + 1; goto Succeed; @@ -5773,14 +5898,16 @@ package body GNAT.Spitbol.Patterns is -- NSpan (string function case) when PC_NSpan_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching NSpan", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching NSpan", S (1 .. L)); while Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) loop Cursor := Cursor + 1; end loop; @@ -5791,13 +5918,16 @@ package body GNAT.Spitbol.Patterns is -- NSpan (string pointer case) when PC_NSpan_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching NSpan", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching NSpan", S (1 .. L)); while Cursor < Length - and then Is_In (Subject (Cursor + 1), Str.all) + and then Is_In (Subject (Cursor + 1), S (1 .. L)) loop Cursor := Cursor + 1; end loop; @@ -6044,15 +6174,18 @@ package body GNAT.Spitbol.Patterns is -- Span (string function case) when PC_Span_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); - P : Natural := Cursor; + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; + P : Natural; begin - Dout (Img (Node) & "matching Span", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching Span", S (1 .. L)); + P := Cursor; while P < Length - and then Is_In (Subject (P + 1), Str.all) + and then Is_In (Subject (P + 1), S (1 .. L)) loop P := P + 1; end loop; @@ -6068,14 +6201,18 @@ package body GNAT.Spitbol.Patterns is -- Span (string pointer case) when PC_Span_VP => declare - Str : constant String_Access := Get_String (Node.VP.all); - P : Natural := Cursor; + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; + P : Natural; begin - Dout (Img (Node) & "matching Span", Str.all); + Get_String (U, S, L); + Dout (Img (Node) & "matching Span", S (1 .. L)); + P := Cursor; while P < Length - and then Is_In (Subject (P + 1), Str.all) + and then Is_In (Subject (P + 1), S (1 .. L)) loop P := P + 1; end loop; @@ -6179,17 +6316,18 @@ package body GNAT.Spitbol.Patterns is -- String (function case) when PC_String_VF => declare - U : constant VString := Node.VF.all; - Str : constant String_Access := Get_String (U); - Len : constant Natural := Str'Length; + U : constant VString := Node.VF.all; + S : String_Access; + L : Natural; begin - Dout (Img (Node) & "matching " & Image (Str.all)); + Get_String (U, S, L); + Dout (Img (Node) & "matching " & Image (S (1 .. L))); - if (Length - Cursor) >= Len - and then Str.all = Subject (Cursor + 1 .. Cursor + Len) + if (Length - Cursor) >= L + and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L) then - Cursor := Cursor + Len; + Cursor := Cursor + L; goto Succeed; else goto Fail; @@ -6199,18 +6337,18 @@ package body GNAT.Spitbol.Patterns is -- String (vstring pointer case) when PC_String_VP => declare - S : constant String_Access := Get_String (Node.VP.all); - Len : constant Natural := - Ada.Strings.Unbounded.Length (Node.VP.all); + U : constant VString := Node.VP.all; + S : String_Access; + L : Natural; begin - Dout - (Img (Node) & "matching " & Image (S.all)); + Get_String (U, S, L); + Dout (Img (Node) & "matching " & Image (S (1 .. L))); - if (Length - Cursor) >= Len - and then S.all = Subject (Cursor + 1 .. Cursor + Len) + if (Length - Cursor) >= L + and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L) then - Cursor := Cursor + Len; + Cursor := Cursor + L; goto Succeed; else goto Fail; diff --git a/gcc/ada/g-spipat.ads b/gcc/ada/g-spipat.ads index 3a62e1c0ec1..4574da1d589 100644 --- a/gcc/ada/g-spipat.ads +++ b/gcc/ada/g-spipat.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2002 Ada Core Technologies, Inc. -- +-- Copyright (C) 1997-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -953,23 +953,19 @@ pragma Elaborate_Body (Patterns); function Match (Subject : VString; - Pat : Pattern) - return Boolean; + Pat : Pattern) return Boolean; function Match (Subject : VString; - Pat : PString) - return Boolean; + Pat : PString) return Boolean; function Match (Subject : String; - Pat : Pattern) - return Boolean; + Pat : Pattern) return Boolean; function Match (Subject : String; - Pat : PString) - return Boolean; + Pat : PString) return Boolean; -- Replacement functions. The subject is matched against the pattern. -- Any immediate or deferred assignments or writes are executed, and @@ -980,26 +976,22 @@ pragma Elaborate_Body (Patterns); function Match (Subject : VString_Var; Pat : Pattern; - Replace : VString) - return Boolean; + Replace : VString) return Boolean; function Match (Subject : VString_Var; Pat : PString; - Replace : VString) - return Boolean; + Replace : VString) return Boolean; function Match (Subject : VString_Var; Pat : Pattern; - Replace : String) - return Boolean; + Replace : String) return Boolean; function Match (Subject : VString_Var; Pat : PString; - Replace : String) - return Boolean; + Replace : String) return Boolean; -- Simple match procedures. The subject is matched against the pattern. -- Any immediate or deferred assignments or writes are executed. No @@ -1063,8 +1055,7 @@ pragma Elaborate_Body (Patterns); function Match (Subject : VString_Var; Pat : Pattern; - Result : Match_Result_Var) - return Boolean; + Result : Match_Result_Var) return Boolean; procedure Match (Subject : in out VString; diff --git a/gcc/ada/g-spitbo.adb b/gcc/ada/g-spitbo.adb index 64613e12687..68eec892842 100644 --- a/gcc/ada/g-spitbo.adb +++ b/gcc/ada/g-spitbo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2002 Ada Core Technologies, Inc. -- +-- Copyright (C) 1998-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -79,10 +79,9 @@ package body GNAT.Spitbol is ---------- function Lpad - (Str : VString; - Len : Natural; - Pad : Character := ' ') - return VString + (Str : VString; + Len : Natural; + Pad : Character := ' ') return VString is begin if Length (Str) >= Len then @@ -93,10 +92,9 @@ package body GNAT.Spitbol is end Lpad; function Lpad - (Str : String; - Len : Natural; - Pad : Character := ' ') - return VString + (Str : String; + Len : Natural; + Pad : Character := ' ') return VString is begin if Str'Length >= Len then @@ -135,8 +133,11 @@ package body GNAT.Spitbol is ------- function N (Str : VString) return Integer is + S : String_Access; + L : Natural; begin - return Integer'Value (Get_String (Str).all); + Get_String (Str, S, L); + return Integer'Value (S (1 .. L)); end N; -------------------- @@ -144,16 +145,22 @@ package body GNAT.Spitbol is -------------------- function Reverse_String (Str : VString) return VString is - Len : constant Natural := Length (Str); - Chars : constant String_Access := Get_String (Str); - Result : String (1 .. Len); + S : String_Access; + L : Natural; begin - for J in 1 .. Len loop - Result (J) := Chars (Len + 1 - J); - end loop; + Get_String (Str, S, L); - return V (Result); + declare + Result : String (1 .. L); + + begin + for J in 1 .. L loop + Result (J) := S (L + 1 - J); + end loop; + + return V (Result); + end; end Reverse_String; function Reverse_String (Str : String) return VString is @@ -168,16 +175,22 @@ package body GNAT.Spitbol is end Reverse_String; procedure Reverse_String (Str : in out VString) is - Len : constant Natural := Length (Str); - Chars : constant String_Access := Get_String (Str); - Temp : Character; + S : String_Access; + L : Natural; begin - for J in 1 .. Len / 2 loop - Temp := Chars (J); - Chars (J) := Chars (Len + 1 - J); - Chars (Len + 1 - J) := Temp; - end loop; + Get_String (Str, S, L); + + declare + Result : String (1 .. L); + + begin + for J in 1 .. L loop + Result (J) := S (L + 1 - J); + end loop; + + Set_String (Str, Result); + end; end Reverse_String; ---------- @@ -185,10 +198,9 @@ package body GNAT.Spitbol is ---------- function Rpad - (Str : VString; - Len : Natural; - Pad : Character := ' ') - return VString + (Str : VString; + Len : Natural; + Pad : Character := ' ') return VString is begin if Length (Str) >= Len then @@ -199,10 +211,9 @@ package body GNAT.Spitbol is end Rpad; function Rpad - (Str : String; - Len : Natural; - Pad : Character := ' ') - return VString + (Str : String; + Len : Natural; + Pad : Character := ' ') return VString is begin if Str'Length >= Len then @@ -269,34 +280,33 @@ package body GNAT.Spitbol is function Substr (Str : VString; Start : Positive; - Len : Natural) - return VString + Len : Natural) return VString is + S : String_Access; + L : Natural; + begin - if Start > Length (Str) then + Get_String (Str, S, L); + + if Start > L then raise Index_Error; - - elsif Start + Len - 1 > Length (Str) then + elsif Start + Len - 1 > L then raise Length_Error; - else - return V (Get_String (Str).all (Start .. Start + Len - 1)); + return V (S (Start .. Start + Len - 1)); end if; end Substr; function Substr (Str : String; Start : Positive; - Len : Natural) - return VString + Len : Natural) return VString is begin if Start > Str'Length then raise Index_Error; - elsif Start + Len > Str'Length then raise Length_Error; - else return V (Str (Str'First + Start - 1 .. Str'First + Start + Len - 2)); @@ -446,8 +456,11 @@ package body GNAT.Spitbol is end Delete; procedure Delete (T : in out Table; Name : VString) is + S : String_Access; + L : Natural; begin - Delete (T, Get_String (Name).all); + Get_String (Name, S, L); + Delete (T, S (1 .. L)); end Delete; procedure Delete (T : in out Table; Name : String) is @@ -569,8 +582,11 @@ package body GNAT.Spitbol is end Get; function Get (T : Table; Name : VString) return Value_Type is + S : String_Access; + L : Natural; begin - return Get (T, Get_String (Name).all); + Get_String (Name, S, L); + return Get (T, S (1 .. L)); end Get; function Get (T : Table; Name : String) return Value_Type is @@ -623,8 +639,11 @@ package body GNAT.Spitbol is end Present; function Present (T : Table; Name : VString) return Boolean is + S : String_Access; + L : Natural; begin - return Present (T, Get_String (Name).all); + Get_String (Name, S, L); + return Present (T, S (1 .. L)); end Present; function Present (T : Table; Name : String) return Boolean is @@ -656,8 +675,11 @@ package body GNAT.Spitbol is --------- procedure Set (T : in out Table; Name : VString; Value : Value_Type) is + S : String_Access; + L : Natural; begin - Set (T, Get_String (Name).all, Value); + Get_String (Name, S, L); + Set (T, S (1 .. L), Value); end Set; procedure Set (T : in out Table; Name : Character; Value : Value_Type) is diff --git a/gcc/ada/g-spitbo.ads b/gcc/ada/g-spitbo.ads index 1bac7f357ee..0a96ca57a6f 100644 --- a/gcc/ada/g-spitbo.ads +++ b/gcc/ada/g-spitbo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-1999 Ada Core Technologies, Inc. -- +-- Copyright (C) 1997-2005 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -120,15 +120,13 @@ pragma Preelaborate (Spitbol); -- Equivalent to Character'Val (Num) function Lpad - (Str : VString; - Len : Natural; - Pad : Character := ' ') - return VString; + (Str : VString; + Len : Natural; + Pad : Character := ' ') return VString; function Lpad - (Str : String; - Len : Natural; - Pad : Character := ' ') - return VString; + (Str : String; + Len : Natural; + Pad : Character := ' ') return VString; -- If the length of Str is greater than or equal to Len, then Str is -- returned unchanged. Otherwise, The value returned is obtained by -- concatenating Length (Str) - Len instances of the Pad character to @@ -151,15 +149,13 @@ pragma Preelaborate (Spitbol); -- result overwrites the input argument Str. function Rpad - (Str : VString; - Len : Natural; - Pad : Character := ' ') - return VString; + (Str : VString; + Len : Natural; + Pad : Character := ' ') return VString; function Rpad - (Str : String; - Len : Natural; - Pad : Character := ' ') - return VString; + (Str : String; + Len : Natural; + Pad : Character := ' ') return VString; -- If the length of Str is greater than or equal to Len, then Str is -- returned unchanged. Otherwise, The value returned is obtained by -- concatenating Length (Str) - Len instances of the Pad character to @@ -178,13 +174,11 @@ pragma Preelaborate (Spitbol); function Substr (Str : VString; Start : Positive; - Len : Natural) - return VString; + Len : Natural) return VString; function Substr (Str : String; Start : Positive; - Len : Natural) - return VString; + Len : Natural) return VString; -- Returns the substring starting at the given character position (which -- is always counted from the start of the string, regardless of bounds, -- e.g. 2 means starting with the second character of the string), and