summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-03-15 15:53:10 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2005-03-15 15:53:10 +0000
commit90fd25c58b1661a5ad762daba6800b86eb95485e (patch)
tree5ce32e503ea5e4af6010553a51d8e39be3fbf801 /gcc
parent20e42bc1b770789e9db37f51ca755d305f5b2eec (diff)
downloadgcc-90fd25c58b1661a5ad762daba6800b86eb95485e.tar.gz
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 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@96488 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/a-stunau.adb53
-rw-r--r--gcc/ada/a-stunau.ads23
-rw-r--r--gcc/ada/a-swunau.adb50
-rw-r--r--gcc/ada/a-swunau.ads24
-rw-r--r--gcc/ada/a-szunau.adb59
-rw-r--r--gcc/ada/a-szunau.ads24
-rw-r--r--gcc/ada/g-spipat.adb506
-rw-r--r--gcc/ada/g-spipat.ads29
-rw-r--r--gcc/ada/g-spitbo.adb118
-rw-r--r--gcc/ada/g-spitbo.ads36
10 files changed, 498 insertions, 424 deletions
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
+ 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;
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
- 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
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