Skip to content

R
riscv-gcc-1
Commit 2f388d2d by Robert Dewar Committed by Arnaud Charlet
Options

re PR ada/13470 (64bits Ada bootstrap failure:xnmake etc. crash generating nmake.adb etc.) 

2005-03-08  Robert Dewar  <dewar@adacore.com>

	PR ada/13470

	* a-stunau.ads, a-stunau.adb:
	Change interface to allow efficient (and correct) implementation
	The previous changes to allow extra space in unbounded strings had
	left this interface a bit broken.

	* a-suteio.adb: Avoid unnecessary use of Get/Set_String

	* g-spipat.ads, g-spipat.adb: New interface for Get_String
	Minor reformatting (function specs)

	* g-spitbo.adb: New interface for Get_String

	* g-spitbo.ads: Minor reformatting

	* a-swunau.ads, a-swunau.adb: New interface for Get_Wide_String

	* a-szunau.ads, a-szunau.adb: New interface for Get_Wide_Wide_String

From-SVN: r96488
parent 798a9055
Showing with 498 additions and 424 deletions
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
......
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);
......
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
......
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;
......
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
......
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;
......
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
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;
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;
......
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;
......
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
raise Index_Error;
Get_String (Str, S, L);
elsif Start + Len - 1 > Length (Str) then
if Start > L then
raise Index_Error;
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
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment