* 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

@@ -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

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;
 

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);

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;

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;
 
@@ -51,20 +54,6 @@ package body Ada.Strings.Wide_Unbounded.Aux is
 
    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

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

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;

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

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);