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
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;
(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;
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;
-- 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);
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
-- 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;
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;
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)
is
begin
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
-- 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
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;
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
-- 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
-- --
-- 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- --
(Subject : VString;
Pat : Pattern) return Boolean
is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
-
Start : Natural;
Stop : Natural;
pragma Unreferenced (Stop);
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
(Subject : VString;
Pat : Pattern)
is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
Start : Natural;
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
Pat : PString) return Boolean
is
Pat_Len : constant Natural := Pat'Length;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
(Subject : VString;
Pat : PString)
is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
Start : Natural;
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
is
Start : Natural;
Stop : Natural;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
(Result : in out Match_Result;
Replace : VString)
is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
P : Natural;
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
P : Natural;
when PC_String_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_String_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Any_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Any_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Break_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Break_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_BreakX_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_BreakX_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NotAny_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NotAny_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NSpan_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_NSpan_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_Span_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
P : Natural;
when PC_Span_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
P : Natural;
when PC_String_VF => declare
U : constant VString := Node.VF.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
when PC_String_VP => declare
U : constant VString := Node.VP.all;
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
-------
function N (Str : VString) return Integer is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
Get_String (Str, S, L);
--------------------
function Reverse_String (Str : VString) return VString is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
end Reverse_String;
procedure Reverse_String (Str : in out VString) is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
Result (J) := S (L + 1 - J);
end loop;
- Set_String (Str, Result);
+ Set_Unbounded_String (Str, Result);
end;
end Reverse_String;
Start : Positive;
Len : Natural) return VString
is
- S : String_Access;
+ S : Big_String_Access;
L : Natural;
begin
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;
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);
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);
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);
---------
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);
OSDN Git Service
