OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* g-spipat.adb, a-swunau.adb, a-swunau.ads, g-spitbo.adb,

Browse Source 
a-szunau.adb, a-szunau.ads, a-stunau.adb, a-stunau.ads,
	a-strunb.adb (Big_String. Big_String_Access): New type.

From-SVN: r160981
This commit is contained in:
Arnaud Charlet 2010-06-18 12:29:49 +00:00 committed by Arnaud Charlet
parent ed2233dc6d
commit 8b4c5f1d10
10 changed files with 118 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/ChangeLog
View File

@ -11,6 +11,10 @@
sem_disp.adb, prepcomp.adb, par-ch7.adb, sem_elab.adb, exp_ch4.adb,
errout.ads: Update comments. Minor reformatting.
* g-spipat.adb, a-swunau.adb, a-swunau.ads, g-spitbo.adb,
a-szunau.adb, a-szunau.ads, a-stunau.adb, a-stunau.ads,
a-strunb.adb (Big_String. Big_String_Access): New type.
2010-06-18 Geert Bosch <bosch@adacore.com>
* i-forbla-darwin.adb: Include -lgnala and -lm in linker options for

21
gcc/ada/a-strunb.adb
View File

@ -914,9 +914,14 @@ package body Ada.Strings.Unbounded is
function To_Unbounded_String (Source : String) return Unbounded_String is
Result : Unbounded_String;
begin
Result.Last := Source'Length;
Result.Reference := new String (1 .. Source'Length);
Result.Reference.all := Source;
-- Do not allocate an empty string: keep the default
if Source'Length > 0 then
Result.Last := Source'Length;
Result.Reference := new String (1 .. Source'Length);
Result.Reference.all := Source;
end if;
return Result;
end To_Unbounded_String;
@ -924,9 +929,15 @@ package body Ada.Strings.Unbounded is
(Length : Natural) return Unbounded_String
is
Result : Unbounded_String;
begin
Result.Last := Length;
Result.Reference := new String (1 .. Length);
-- Do not allocate an empty string: keep the default
if Length > 0 then
Result.Last := Length;
Result.Reference := new String (1 .. Length);
end if;
return Result;
end To_Unbounded_String;

18
gcc/ada/a-stunau.adb
View File

@ -37,11 +37,14 @@ package body Ada.Strings.Unbounded.Aux is
procedure Get_String
(U : Unbounded_String;
S : out String_Access;
S : out Big_String_Access;
L : out Natural)
is
X : aliased Big_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
L := U.Last;
end Get_String;
@ -49,17 +52,6 @@ package body Ada.Strings.Unbounded.Aux is
-- Set_String --
----------------
procedure Set_String (UP : in out Unbounded_String; S : String) is
begin
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
begin
Finalize (UP);

23
gcc/ada/a-stunau.ads
View File

@ -37,9 +37,12 @@
package Ada.Strings.Unbounded.Aux is
pragma Preelaborate;
subtype Big_String is String (1 .. Positive'Last);
type Big_String_Access is access all Big_String;
procedure Get_String
(U : Unbounded_String;
S : out String_Access;
S : out Big_String_Access;
L : out Natural);
pragma Inline (Get_String);
-- This procedure returns the internal string pointer used in the
@ -54,18 +57,16 @@ package Ada.Strings.Unbounded.Aux is
-- 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);
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_String with an assignment, since it
-- avoids the necessity of messing with finalization chains. The lower
-- bound of the string S is not required to be one.
procedure Set_String (UP : out Unbounded_String; S : String)
renames Set_Unbounded_String;
-- This function is simply a renaming of the new Ada 2005 function as shown
-- above. It is provided for historical reasons, but should be removed at
-- this stage???
procedure Set_String (UP : in out Unbounded_String; S : String_Access);
pragma Inline (Set_String);
-- This version of Set_String takes a string access value, rather than a
-- string. The lower bound of the string value is required to be one, and
-- this requirement is not checked.
-- This version of Set_Unbounded_String takes a string access value, rather
-- than a string. The lower bound of the string value is required to be
-- one, and this requirement is not checked.
end Ada.Strings.Unbounded.Aux;

21
gcc/ada/a-swunau.adb
View File

@ -37,11 +37,14 @@ package body Ada.Strings.Wide_Unbounded.Aux is
procedure Get_Wide_String
(U : Unbounded_Wide_String;
S : out Wide_String_Access;
S : out Big_Wide_String_Access;
L : out Natural)
is
X : aliased Big_Wide_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
L := U.Last;
end Get_Wide_String;
@ -49,20 +52,6 @@ package body Ada.Strings.Wide_Unbounded.Aux is
-- Set_Wide_String --
---------------------
procedure Set_Wide_String
(UP : in out Unbounded_Wide_String;
S : Wide_String)
is
begin
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
(UP : in out Unbounded_Wide_String;
S : Wide_String_Access)

11
gcc/ada/a-swunau.ads
View File

@ -37,9 +37,12 @@
package Ada.Strings.Wide_Unbounded.Aux is
pragma Preelaborate;
subtype Big_Wide_String is Wide_String (Positive'Range);
type Big_Wide_String_Access is access all Big_Wide_String;
procedure Get_Wide_String
(U : Unbounded_Wide_String;
S : out Wide_String_Access;
S : out Big_Wide_String_Access;
L : out Natural);
pragma Inline (Get_Wide_String);
-- This procedure returns the internal string pointer used in the
@ -54,10 +57,8 @@ package Ada.Strings.Wide_Unbounded.Aux is
-- 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;
S : Wide_String);
pragma Inline (Set_Wide_String);
procedure Set_Wide_String (UP : out Unbounded_Wide_String; S : Wide_String)
renames Set_Unbounded_Wide_String;
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_Wide_String with an assignment, since it

29
gcc/ada/a-szunau.adb
View File

@ -31,37 +31,26 @@
package body Ada.Strings.Wide_Wide_Unbounded.Aux is
--------------------
--------------------------
-- Get_Wide_Wide_String --
---------------------
--------------------------
procedure Get_Wide_Wide_String
(U : Unbounded_Wide_Wide_String;
S : out Wide_Wide_String_Access;
S : out Big_Wide_Wide_String_Access;
L : out Natural)
is
X : aliased Big_Wide_Wide_String;
for X'Address use U.Reference.all'Address;
begin
S := U.Reference;
S := X'Unchecked_Access;
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 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
(UP : in out Unbounded_Wide_Wide_String;

11
gcc/ada/a-szunau.ads
View File

@ -37,9 +37,12 @@
package Ada.Strings.Wide_Wide_Unbounded.Aux is
pragma Preelaborate;
subtype Big_Wide_Wide_String is Wide_Wide_String (Positive);
type Big_Wide_Wide_String_Access is access all Big_Wide_Wide_String;
procedure Get_Wide_Wide_String
(U : Unbounded_Wide_Wide_String;
S : out Wide_Wide_String_Access;
S : out Big_Wide_Wide_String_Access;
L : out Natural);
pragma Inline (Get_Wide_Wide_String);
-- This procedure returns the internal string pointer used in the
@ -55,9 +58,9 @@ package Ada.Strings.Wide_Wide_Unbounded.Aux is
-- string data is always accessible as S (1 .. L).
procedure Set_Wide_Wide_String
(UP : in out Unbounded_Wide_Wide_String;
S : Wide_Wide_String);
pragma Inline (Set_Wide_Wide_String);
(UP : out Unbounded_Wide_Wide_String;
S : Wide_Wide_String)
renames Set_Unbounded_Wide_Wide_String;
-- This function sets the string contents of the referenced unbounded
-- string to the given string value. It is significantly more efficient
-- than the use of To_Unbounded_Wide_Wide_String with an assignment, since

89
gcc/ada/g-spipat.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2008, AdaCore --
-- Copyright (C) 1998-2009, AdaCore --
-- --
-- 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- --
@ -2793,9 +2793,8 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : Pattern) return Boolean
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
Stop : Natural;
pragma Unreferenced (Stop);
@ -2838,7 +2837,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -2867,7 +2866,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -2892,7 +2891,7 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : Pattern)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
@ -2933,7 +2932,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -2958,7 +2957,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -2980,7 +2979,7 @@ package body GNAT.Spitbol.Patterns is
Pat : PString) return Boolean
is
Pat_Len : constant Natural := Pat'Length;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3038,7 +3037,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3067,7 +3066,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3092,7 +3091,7 @@ package body GNAT.Spitbol.Patterns is
(Subject : VString;
Pat : PString)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
Start : Natural;
@ -3133,7 +3132,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3158,7 +3157,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3182,7 +3181,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3213,7 +3212,7 @@ package body GNAT.Spitbol.Patterns is
is
Start : Natural;
Stop : Natural;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3362,7 +3361,7 @@ package body GNAT.Spitbol.Patterns is
(Result : in out Match_Result;
Replace : VString)
is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3955,7 +3954,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -3975,7 +3974,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4142,7 +4141,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4163,7 +4162,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4210,7 +4209,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4231,7 +4230,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4376,7 +4375,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4397,7 +4396,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4440,7 +4439,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4459,7 +4458,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4682,7 +4681,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
@ -4708,7 +4707,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
@ -4809,7 +4808,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -4829,7 +4828,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5354,7 +5353,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5376,7 +5375,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5563,7 +5562,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5585,7 +5584,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5637,7 +5636,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5659,7 +5658,7 @@ package body GNAT.Spitbol.Patterns is
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5826,7 +5825,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5848,7 +5847,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5896,7 +5895,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -5916,7 +5915,7 @@ package body GNAT.Spitbol.Patterns is
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -6172,7 +6171,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
@ -6199,7 +6198,7 @@ package body GNAT.Spitbol.Patterns is
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
P : Natural;
@ -6314,7 +6313,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VF => declare
U : constant VString := Node.VF.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -6335,7 +6334,7 @@ package body GNAT.Spitbol.Patterns is
when PC_String_VP => declare
U : constant VString := Node.VP.all;
S : String_Access;
S : Big_String_Access;
L : Natural;
begin

20
gcc/ada/g-spitbo.adb
View File

@ -135,7 +135,7 @@ package body GNAT.Spitbol is
-------
function N (Str : VString) return Integer is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Str, S, L);
@ -147,7 +147,7 @@ package body GNAT.Spitbol is
--------------------
function Reverse_String (Str : VString) return VString is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -177,7 +177,7 @@ package body GNAT.Spitbol is
end Reverse_String;
procedure Reverse_String (Str : in out VString) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -191,7 +191,7 @@ package body GNAT.Spitbol is
Result (J) := S (L + 1 - J);
end loop;
Set_String (Str, Result);
Set_Unbounded_String (Str, Result);
end;
end Reverse_String;
@ -284,7 +284,7 @@ package body GNAT.Spitbol is
Start : Positive;
Len : Natural) return VString
is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
@ -413,7 +413,7 @@ package body GNAT.Spitbol is
if Elmt.Name /= null then
loop
Set_String (TA (P).Name, Elmt.Name.all);
Set_Unbounded_String (TA (P).Name, Elmt.Name.all);
TA (P).Value := Elmt.Value;
P := P + 1;
Elmt := Elmt.Next;
@ -458,7 +458,7 @@ package body GNAT.Spitbol is
end Delete;
procedure Delete (T : in out Table; Name : VString) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
@ -584,7 +584,7 @@ package body GNAT.Spitbol is
end Get;
function Get (T : Table; Name : VString) return Value_Type is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
@ -625,7 +625,7 @@ package body GNAT.Spitbol is
end Present;
function Present (T : Table; Name : VString) return Boolean is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);
@ -661,7 +661,7 @@ package body GNAT.Spitbol is
---------
procedure Set (T : in out Table; Name : VString; Value : Value_Type) is
S : String_Access;
S : Big_String_Access;
L : Natural;
begin
Get_String (Name, S, L);