From 8b4c5f1d1009d12e69c7a89950cea2625e20abba Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 18 Jun 2010 12:29:49 +0000 Subject: [PATCH] * 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. From-SVN: r160981 --- gcc/ada/ChangeLog | 4 ++ gcc/ada/a-strunb.adb | 21 ++++++++--- gcc/ada/a-stunau.adb | 18 +++------ gcc/ada/a-stunau.ads | 23 ++++++------ gcc/ada/a-swunau.adb | 21 +++-------- gcc/ada/a-swunau.ads | 11 +++--- gcc/ada/a-szunau.adb | 29 +++++---------- gcc/ada/a-szunau.ads | 11 ++++-- gcc/ada/g-spipat.adb | 89 ++++++++++++++++++++++---------------------- gcc/ada/g-spitbo.adb | 20 +++++----- 10 files changed, 118 insertions(+), 129 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c6cc579757a..08c9b6b1f9a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 * i-forbla-darwin.adb: Include -lgnala and -lm in linker options for diff --git a/gcc/ada/a-strunb.adb b/gcc/ada/a-strunb.adb index 7634e65f6d2..cc5b92bfc43 100644 --- a/gcc/ada/a-strunb.adb +++ b/gcc/ada/a-strunb.adb @@ -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; diff --git a/gcc/ada/a-stunau.adb b/gcc/ada/a-stunau.adb index e77f71c12b1..c6d2bc43ac3 100644 --- a/gcc/ada/a-stunau.adb +++ b/gcc/ada/a-stunau.adb @@ -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); diff --git a/gcc/ada/a-stunau.ads b/gcc/ada/a-stunau.ads index c2d0ec855c0..8cff44f7151 100644 --- a/gcc/ada/a-stunau.ads +++ b/gcc/ada/a-stunau.ads @@ -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; diff --git a/gcc/ada/a-swunau.adb b/gcc/ada/a-swunau.adb index 59eb3f6cf22..004a5d4ac1a 100644 --- a/gcc/ada/a-swunau.adb +++ b/gcc/ada/a-swunau.adb @@ -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) diff --git a/gcc/ada/a-swunau.ads b/gcc/ada/a-swunau.ads index 6df205c0293..78fa5dbb865 100644 --- a/gcc/ada/a-swunau.ads +++ b/gcc/ada/a-swunau.ads @@ -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 diff --git a/gcc/ada/a-szunau.adb b/gcc/ada/a-szunau.adb index 64e52507ce7..7ab9cc5acd4 100644 --- a/gcc/ada/a-szunau.adb +++ b/gcc/ada/a-szunau.adb @@ -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; diff --git a/gcc/ada/a-szunau.ads b/gcc/ada/a-szunau.ads index 913c0e136d7..6115330d94b 100644 --- a/gcc/ada/a-szunau.ads +++ b/gcc/ada/a-szunau.ads @@ -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 diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb index c5c07f105e2..a85697507f3 100644 --- a/gcc/ada/g-spipat.adb +++ b/gcc/ada/g-spipat.adb @@ -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 diff --git a/gcc/ada/g-spitbo.adb b/gcc/ada/g-spitbo.adb index 5b5e2a78e04..4769fa3025d 100644 --- a/gcc/ada/g-spitbo.adb +++ b/gcc/ada/g-spitbo.adb @@ -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); -- 2.30.2