Skip to content

R
riscv-gcc-1
Commit 4e45e7a9 by Robert Dewar Committed by Arnaud Charlet
Options

a-strunb.ads, [...]: Add missing pragma Ada_05 statements Fix name of Set routine 

2005-02-09  Robert Dewar  <dewar@adacore.com>

        * a-strunb.ads, a-strunb.adb: Add missing pragma Ada_05 statements
        Fix name of Set routine

	* a-strfix.ads, a-strfix.adb: Add new index functions from AI-301 to
	fixed packages.

	* a-stwise.ads, a-stwise.adb, a-stwifi.ads, a-stwifi.adb,
	a-strsea.ads, a-strsea.adb: Add new index functions from AI-301 to
	fixed packages

	* a-witeio.ads, a-witeio.adb, a-textio.ads, a-textio.adb: New function
	forms of Get_Line subprograms for AI-301.

	* a-wtcoau.adb, a-wtcoau.ads, a-wtcoio.adb, a-wtcoio.ads,
	a-wtedit.adb, a-wtedit.adb, a-wtedit.ads, a-wttest.adb,
	a-wttest.ads, a-strmap.ads, a-strmap.adb, a-stwima.adb,
	a-stwima.ads: Minor reformatting.

From-SVN: r94810
parent 82c80734
Showing with 1745 additions and 1313 deletions
gcc/ada/a-strfix.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -50,59 +50,82 @@ package body Ada.Strings.Fixed is ...@@ -50,59 +50,82 @@ package body Ada.Strings.Fixed is
------------------------ ------------------------
function Index function Index
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
return Natural
renames Ada.Strings.Search.Index; renames Ada.Strings.Search.Index;
function Index function Index
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural
return Natural
renames Ada.Strings.Search.Index; renames Ada.Strings.Search.Index;
function Index function Index
(Source : in String; (Source : String;
Set : in Maps.Character_Set; Set : Maps.Character_Set;
Test : in Membership := Inside; Test : Membership := Inside;
Going : in Direction := Forward) Going : Direction := Forward) return Natural
return Natural
renames Ada.Strings.Search.Index; renames Ada.Strings.Search.Index;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
renames Ada.Strings.Search.Index;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural
renames Ada.Strings.Search.Index;
function Index
(Source : String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural
renames Ada.Strings.Search.Index;
function Index_Non_Blank
(Source : String;
Going : Direction := Forward) return Natural
renames Ada.Strings.Search.Index_Non_Blank;
function Index_Non_Blank function Index_Non_Blank
(Source : in String; (Source : String;
Going : in Direction := Forward) From : Positive;
return Natural Going : Direction := Forward) return Natural
renames Ada.Strings.Search.Index_Non_Blank; renames Ada.Strings.Search.Index_Non_Blank;
function Count function Count
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
return Natural
renames Ada.Strings.Search.Count; renames Ada.Strings.Search.Count;
function Count function Count
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural
return Natural
renames Ada.Strings.Search.Count; renames Ada.Strings.Search.Count;
function Count function Count
(Source : in String; (Source : String;
Set : in Maps.Character_Set) Set : Maps.Character_Set) return Natural
return Natural
renames Ada.Strings.Search.Count; renames Ada.Strings.Search.Count;
procedure Find_Token procedure Find_Token
(Source : in String; (Source : String;
Set : in Maps.Character_Set; Set : Maps.Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural) Last : out Natural)
renames Ada.Strings.Search.Find_Token; renames Ada.Strings.Search.Find_Token;
...@@ -112,9 +135,8 @@ package body Ada.Strings.Fixed is ...@@ -112,9 +135,8 @@ package body Ada.Strings.Fixed is
--------- ---------
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Character) Right : Character) return String
return String
is is
Result : String (1 .. Left); Result : String (1 .. Left);
...@@ -127,9 +149,8 @@ package body Ada.Strings.Fixed is ...@@ -127,9 +149,8 @@ package body Ada.Strings.Fixed is
end "*"; end "*";
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in String) Right : String) return String
return String
is is
Result : String (1 .. Left * Right'Length); Result : String (1 .. Left * Right'Length);
Ptr : Integer := 1; Ptr : Integer := 1;
...@@ -148,10 +169,9 @@ package body Ada.Strings.Fixed is ...@@ -148,10 +169,9 @@ package body Ada.Strings.Fixed is
------------ ------------
function Delete function Delete
(Source : in String; (Source : String;
From : in Positive; From : Positive;
Through : in Natural) Through : Natural) return String
return String
is is
begin begin
if From > Through then if From > Through then
...@@ -185,10 +205,10 @@ package body Ada.Strings.Fixed is ...@@ -185,10 +205,10 @@ package body Ada.Strings.Fixed is
procedure Delete procedure Delete
(Source : in out String; (Source : in out String;
From : in Positive; From : Positive;
Through : in Natural; Through : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Source => Delete (Source, From, Through), Move (Source => Delete (Source, From, Through),
...@@ -202,10 +222,9 @@ package body Ada.Strings.Fixed is ...@@ -202,10 +222,9 @@ package body Ada.Strings.Fixed is
---------- ----------
function Head function Head
(Source : in String; (Source : String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return String
return String
is is
subtype Result_Type is String (1 .. Count); subtype Result_Type is String (1 .. Count);
...@@ -232,9 +251,9 @@ package body Ada.Strings.Fixed is ...@@ -232,9 +251,9 @@ package body Ada.Strings.Fixed is
procedure Head procedure Head
(Source : in out String; (Source : in out String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Source => Head (Source, Count, Pad), Move (Source => Head (Source, Count, Pad),
...@@ -249,10 +268,9 @@ package body Ada.Strings.Fixed is ...@@ -249,10 +268,9 @@ package body Ada.Strings.Fixed is
------------ ------------
function Insert function Insert
(Source : in String; (Source : String;
Before : in Positive; Before : Positive;
New_Item : in String) New_Item : String) return String
return String
is is
Result : String (1 .. Source'Length + New_Item'Length); Result : String (1 .. Source'Length + New_Item'Length);
Front : constant Integer := Before - Source'First; Front : constant Integer := Before - Source'First;
...@@ -274,9 +292,9 @@ package body Ada.Strings.Fixed is ...@@ -274,9 +292,9 @@ package body Ada.Strings.Fixed is
procedure Insert procedure Insert
(Source : in out String; (Source : in out String;
Before : in Positive; Before : Positive;
New_Item : in String; New_Item : String;
Drop : in Truncation := Error) Drop : Truncation := Error)
is is
begin begin
Move (Source => Insert (Source, Before, New_Item), Move (Source => Insert (Source, Before, New_Item),
...@@ -289,11 +307,11 @@ package body Ada.Strings.Fixed is ...@@ -289,11 +307,11 @@ package body Ada.Strings.Fixed is
---------- ----------
procedure Move procedure Move
(Source : in String; (Source : String;
Target : out String; Target : out String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
Sfirst : constant Integer := Source'First; Sfirst : constant Integer := Source'First;
Slast : constant Integer := Source'Last; Slast : constant Integer := Source'Last;
...@@ -398,10 +416,9 @@ package body Ada.Strings.Fixed is ...@@ -398,10 +416,9 @@ package body Ada.Strings.Fixed is
--------------- ---------------
function Overwrite function Overwrite
(Source : in String; (Source : String;
Position : in Positive; Position : Positive;
New_Item : in String) New_Item : String) return String
return String
is is
begin begin
if Position not in Source'First .. Source'Last + 1 then if Position not in Source'First .. Source'Last + 1 then
...@@ -430,9 +447,9 @@ package body Ada.Strings.Fixed is ...@@ -430,9 +447,9 @@ package body Ada.Strings.Fixed is
procedure Overwrite procedure Overwrite
(Source : in out String; (Source : in out String;
Position : in Positive; Position : Positive;
New_Item : in String; New_Item : String;
Drop : in Truncation := Right) Drop : Truncation := Right)
is is
begin begin
Move (Source => Overwrite (Source, Position, New_Item), Move (Source => Overwrite (Source, Position, New_Item),
...@@ -445,11 +462,10 @@ package body Ada.Strings.Fixed is ...@@ -445,11 +462,10 @@ package body Ada.Strings.Fixed is
------------------- -------------------
function Replace_Slice function Replace_Slice
(Source : in String; (Source : String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String) By : String) return String
return String
is is
begin begin
if Low > Source'Last + 1 or High < Source'First - 1 then if Low > Source'Last + 1 or High < Source'First - 1 then
...@@ -490,12 +506,12 @@ package body Ada.Strings.Fixed is ...@@ -490,12 +506,12 @@ package body Ada.Strings.Fixed is
procedure Replace_Slice procedure Replace_Slice
(Source : in out String; (Source : in out String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String; By : String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
...@@ -506,10 +522,9 @@ package body Ada.Strings.Fixed is ...@@ -506,10 +522,9 @@ package body Ada.Strings.Fixed is
---------- ----------
function Tail function Tail
(Source : in String; (Source : String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return String
return String
is is
subtype Result_Type is String (1 .. Count); subtype Result_Type is String (1 .. Count);
...@@ -536,9 +551,9 @@ package body Ada.Strings.Fixed is ...@@ -536,9 +551,9 @@ package body Ada.Strings.Fixed is
procedure Tail procedure Tail
(Source : in out String; (Source : in out String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Source => Tail (Source, Count, Pad), Move (Source => Tail (Source, Count, Pad),
...@@ -553,9 +568,8 @@ package body Ada.Strings.Fixed is ...@@ -553,9 +568,8 @@ package body Ada.Strings.Fixed is
--------------- ---------------
function Translate function Translate
(Source : in String; (Source : String;
Mapping : in Maps.Character_Mapping) Mapping : Maps.Character_Mapping) return String
return String
is is
Result : String (1 .. Source'Length); Result : String (1 .. Source'Length);
...@@ -569,7 +583,7 @@ package body Ada.Strings.Fixed is ...@@ -569,7 +583,7 @@ package body Ada.Strings.Fixed is
procedure Translate procedure Translate
(Source : in out String; (Source : in out String;
Mapping : in Maps.Character_Mapping) Mapping : Maps.Character_Mapping)
is is
begin begin
for J in Source'Range loop for J in Source'Range loop
...@@ -578,9 +592,8 @@ package body Ada.Strings.Fixed is ...@@ -578,9 +592,8 @@ package body Ada.Strings.Fixed is
end Translate; end Translate;
function Translate function Translate
(Source : in String; (Source : String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return String
return String
is is
Result : String (1 .. Source'Length); Result : String (1 .. Source'Length);
pragma Unsuppress (Access_Check); pragma Unsuppress (Access_Check);
...@@ -595,7 +608,7 @@ package body Ada.Strings.Fixed is ...@@ -595,7 +608,7 @@ package body Ada.Strings.Fixed is
procedure Translate procedure Translate
(Source : in out String; (Source : in out String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function)
is is
pragma Unsuppress (Access_Check); pragma Unsuppress (Access_Check);
begin begin
...@@ -609,9 +622,8 @@ package body Ada.Strings.Fixed is ...@@ -609,9 +622,8 @@ package body Ada.Strings.Fixed is
---------- ----------
function Trim function Trim
(Source : in String; (Source : String;
Side : in Trim_End) Side : Trim_End) return String
return String
is is
Low, High : Integer; Low, High : Integer;
...@@ -658,9 +670,9 @@ package body Ada.Strings.Fixed is ...@@ -658,9 +670,9 @@ package body Ada.Strings.Fixed is
procedure Trim procedure Trim
(Source : in out String; (Source : in out String;
Side : in Trim_End; Side : Trim_End;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Trim (Source, Side), Move (Trim (Source, Side),
...@@ -670,10 +682,9 @@ package body Ada.Strings.Fixed is ...@@ -670,10 +682,9 @@ package body Ada.Strings.Fixed is
end Trim; end Trim;
function Trim function Trim
(Source : in String; (Source : String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set) Right : Maps.Character_Set) return String
return String
is is
High, Low : Integer; High, Low : Integer;
...@@ -705,10 +716,10 @@ package body Ada.Strings.Fixed is ...@@ -705,10 +716,10 @@ package body Ada.Strings.Fixed is
procedure Trim procedure Trim
(Source : in out String; (Source : in out String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set; Right : Maps.Character_Set;
Justify : in Alignment := Strings.Left; Justify : Alignment := Strings.Left;
Pad : in Character := Space) Pad : Character := Space)
is is
begin begin
Move (Source => Trim (Source, Left, Right), Move (Source => Trim (Source, Left, Right),
......
gcc/ada/a-strfix.ads
...@@ -6,32 +6,10 @@ ...@@ -6,32 +6,10 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-1997 Free Software Foundation, Inc. -- -- This specification is adapted from the Ada Reference Manual for use with --
-- -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- This specification is derived from the Ada Reference Manual for use with -- -- copy and modify this specification, provided that if you redistribute a --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- modified version, any changes that you have made are clearly indicated. --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -46,63 +24,86 @@ pragma Preelaborate (Fixed); ...@@ -46,63 +24,86 @@ pragma Preelaborate (Fixed);
-------------------------------------------------------------- --------------------------------------------------------------
procedure Move procedure Move
(Source : in String; (Source : String;
Target : out String; Target : out String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
------------------------ ------------------------
-- Search Subprograms -- -- Search Subprograms --
------------------------ ------------------------
function Index function Index
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
return Natural;
function Index
(Source : String;
Pattern : String;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural;
function Index function Index
(Source : in String; (Source : String;
Pattern : in String; Set : Maps.Character_Set;
Going : in Direction := Forward; Test : Membership := Inside;
Mapping : in Maps.Character_Mapping_Function) Going : Direction := Forward) return Natural;
return Natural;
function Index function Index
(Source : in String; (Source : String;
Set : in Maps.Character_Set; Pattern : String;
Test : in Membership := Inside; From : Positive;
Going : in Direction := Forward) Going : Direction := Forward;
return Natural; Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
pragma Ada_05 (Index);
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural;
pragma Ada_05 (Index);
function Index
(Source : String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
pragma Ada_05 (Index);
function Index_Non_Blank
(Source : String;
Going : Direction := Forward) return Natural;
function Index_Non_Blank function Index_Non_Blank
(Source : in String; (Source : String;
Going : in Direction := Forward) From : Positive;
return Natural; Going : Direction := Forward) return Natural;
pragma Ada_05 (Index_Non_Blank);
function Count function Count
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
return Natural;
function Count function Count
(Source : in String; (Source : String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural;
return Natural;
function Count function Count
(Source : in String; (Source : String;
Set : in Maps.Character_Set) Set : Maps.Character_Set) return Natural;
return Natural;
procedure Find_Token procedure Find_Token
(Source : in String; (Source : String;
Set : in Maps.Character_Set; Set : Maps.Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural); Last : out Natural);
...@@ -111,144 +112,132 @@ pragma Preelaborate (Fixed); ...@@ -111,144 +112,132 @@ pragma Preelaborate (Fixed);
------------------------------------ ------------------------------------
function Translate function Translate
(Source : in String; (Source : String;
Mapping : in Maps.Character_Mapping) Mapping : Maps.Character_Mapping) return String;
return String;
procedure Translate procedure Translate
(Source : in out String; (Source : in out String;
Mapping : in Maps.Character_Mapping); Mapping : Maps.Character_Mapping);
function Translate function Translate
(Source : in String; (Source : String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return String;
return String;
procedure Translate procedure Translate
(Source : in out String; (Source : in out String;
Mapping : in Maps.Character_Mapping_Function); Mapping : Maps.Character_Mapping_Function);
--------------------------------------- ---------------------------------------
-- String Transformation Subprograms -- -- String Transformation Subprograms --
--------------------------------------- ---------------------------------------
function Replace_Slice function Replace_Slice
(Source : in String; (Source : String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String) By : String) return String;
return String;
procedure Replace_Slice procedure Replace_Slice
(Source : in out String; (Source : in out String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String; By : String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
function Insert function Insert
(Source : in String; (Source : String;
Before : in Positive; Before : Positive;
New_Item : in String) New_Item : String) return String;
return String;
procedure Insert procedure Insert
(Source : in out String; (Source : in out String;
Before : in Positive; Before : Positive;
New_Item : in String; New_Item : String;
Drop : in Truncation := Error); Drop : Truncation := Error);
function Overwrite function Overwrite
(Source : in String; (Source : String;
Position : in Positive; Position : Positive;
New_Item : in String) New_Item : String) return String;
return String;
procedure Overwrite procedure Overwrite
(Source : in out String; (Source : in out String;
Position : in Positive; Position : Positive;
New_Item : in String; New_Item : String;
Drop : in Truncation := Right); Drop : Truncation := Right);
function Delete function Delete
(Source : in String; (Source : String;
From : in Positive; From : Positive;
Through : in Natural) Through : Natural) return String;
return String;
procedure Delete procedure Delete
(Source : in out String; (Source : in out String;
From : in Positive; From : Positive;
Through : in Natural; Through : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
--------------------------------- ---------------------------------
-- String Selector Subprograms -- -- String Selector Subprograms --
--------------------------------- ---------------------------------
function Trim function Trim
(Source : in String; (Source : String;
Side : in Trim_End) Side : Trim_End) return String;
return String;
procedure Trim procedure Trim
(Source : in out String; (Source : in out String;
Side : in Trim_End; Side : Trim_End;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
function Trim function Trim
(Source : in String; (Source : String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set) Right : Maps.Character_Set) return String;
return String;
procedure Trim procedure Trim
(Source : in out String; (Source : in out String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set; Right : Maps.Character_Set;
Justify : in Alignment := Strings.Left; Justify : Alignment := Strings.Left;
Pad : in Character := Space); Pad : Character := Space);
function Head function Head
(Source : in String; (Source : String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return String;
return String;
procedure Head procedure Head
(Source : in out String; (Source : in out String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
function Tail function Tail
(Source : in String; (Source : String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return String;
return String;
procedure Tail procedure Tail
(Source : in out String; (Source : in out String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Character := Space); Pad : Character := Space);
---------------------------------- ----------------------------------
-- String Constructor Functions -- -- String Constructor Functions --
---------------------------------- ----------------------------------
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Character) Right : Character) return String;
return String;
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in String) Right : String) return String;
return String;
end Ada.Strings.Fixed; end Ada.Strings.Fixed;
gcc/ada/a-strmap.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2004 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/a-strmap.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
......
gcc/ada/a-strsea.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2004 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -76,9 +76,9 @@ package body Ada.Strings.Search is ...@@ -76,9 +76,9 @@ package body Ada.Strings.Search is
----------- -----------
function Count function Count
(Source : String; (Source : String;
Pattern : String; Pattern : String;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
is is
N : Natural; N : Natural;
J : Natural; J : Natural;
...@@ -110,9 +110,9 @@ package body Ada.Strings.Search is ...@@ -110,9 +110,9 @@ package body Ada.Strings.Search is
end Count; end Count;
function Count function Count
(Source : String; (Source : String;
Pattern : String; Pattern : String;
Mapping : Maps.Character_Mapping_Function) return Natural Mapping : Maps.Character_Mapping_Function) return Natural
is is
Mapped_Source : String (Source'Range); Mapped_Source : String (Source'Range);
N : Natural; N : Natural;
...@@ -280,7 +280,6 @@ package body Ada.Strings.Search is ...@@ -280,7 +280,6 @@ package body Ada.Strings.Search is
declare declare
pragma Unsuppress (Access_Check); pragma Unsuppress (Access_Check);
begin begin
for J in Source'Range loop for J in Source'Range loop
Mapped_Source (J) := Mapping.all (Source (J)); Mapped_Source (J) := Mapping.all (Source (J));
...@@ -348,6 +347,84 @@ package body Ada.Strings.Search is ...@@ -348,6 +347,84 @@ package body Ada.Strings.Search is
return 0; return 0;
end Index; end Index;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index (Source (Source'First .. From), Pattern, Backward, Mapping);
end if;
end Index;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return Index
(Source (From .. Source'Last), Pattern, Forward, Mapping);
else
if From > Source'Last then
raise Index_Error;
end if;
return Index
(Source (Source'First .. From), Pattern, Backward, Mapping);
end if;
end Index;
function Index
(Source : String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index (Source (From .. Source'Last), Set, Test, Forward);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index (Source (Source'First .. From), Set, Test, Backward);
end if;
end Index;
--------------------- ---------------------
-- Index_Non_Blank -- -- Index_Non_Blank --
--------------------- ---------------------
...@@ -375,7 +452,30 @@ package body Ada.Strings.Search is ...@@ -375,7 +452,30 @@ package body Ada.Strings.Search is
-- Fall through if no match -- Fall through if no match
return 0; return 0;
end Index_Non_Blank;
function Index_Non_Blank
(Source : String;
From : Positive;
Going : Direction := Forward) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index_Non_Blank (Source (From .. Source'Last), Forward);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index_Non_Blank (Source (Source'First .. From), Backward);
end if;
end Index_Non_Blank; end Index_Non_Blank;
end Ada.Strings.Search; end Ada.Strings.Search;
gcc/ada/a-strsea.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2004 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -61,8 +61,34 @@ pragma Preelaborate (Search); ...@@ -61,8 +61,34 @@ pragma Preelaborate (Search);
Test : Membership := Inside; Test : Membership := Inside;
Going : Direction := Forward) return Natural; Going : Direction := Forward) return Natural;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
function Index
(Source : String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural;
function Index
(Source : String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
function Index_Non_Blank
(Source : String;
Going : Direction := Forward) return Natural;
function Index_Non_Blank function Index_Non_Blank
(Source : String; (Source : String;
From : Positive;
Going : Direction := Forward) return Natural; Going : Direction := Forward) return Natural;
function Count function Count
......
gcc/ada/a-strunb.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,16 +44,19 @@ package body Ada.Strings.Unbounded is ...@@ -44,16 +44,19 @@ package body Ada.Strings.Unbounded is
Chunk_Size : Natural); Chunk_Size : Natural);
pragma Inline (Realloc_For_Chunk); pragma Inline (Realloc_For_Chunk);
-- Adjust the size allocated for the string. Add at least Chunk_Size so it -- Adjust the size allocated for the string. Add at least Chunk_Size so it
-- is safe to add a string of this size at the end of the current -- is safe to add a string of this size at the end of the current content.
-- content. The real size allocated for the string is Chunk_Size + x % -- The real size allocated for the string is Chunk_Size + x of the current
-- of the current string size. This buffered handling makes the Append -- string size. This buffered handling makes the Append unbounded string
-- unbounded string routines very fast. -- routines very fast.
--------- ---------
-- "&" -- -- "&" --
--------- ---------
function "&" (Left, Right : Unbounded_String) return Unbounded_String is function "&"
(Left : Unbounded_String;
Right : Unbounded_String) return Unbounded_String
is
L_Length : constant Natural := Left.Last; L_Length : constant Natural := Left.Last;
R_Length : constant Natural := Right.Last; R_Length : constant Natural := Right.Last;
Result : Unbounded_String; Result : Unbounded_String;
...@@ -73,8 +76,7 @@ package body Ada.Strings.Unbounded is ...@@ -73,8 +76,7 @@ package body Ada.Strings.Unbounded is
function "&" function "&"
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Unbounded_String
return Unbounded_String
is is
L_Length : constant Natural := Left.Last; L_Length : constant Natural := Left.Last;
Result : Unbounded_String; Result : Unbounded_String;
...@@ -92,8 +94,7 @@ package body Ada.Strings.Unbounded is ...@@ -92,8 +94,7 @@ package body Ada.Strings.Unbounded is
function "&" function "&"
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Unbounded_String
return Unbounded_String
is is
R_Length : constant Natural := Right.Last; R_Length : constant Natural := Right.Last;
Result : Unbounded_String; Result : Unbounded_String;
...@@ -112,8 +113,7 @@ package body Ada.Strings.Unbounded is ...@@ -112,8 +113,7 @@ package body Ada.Strings.Unbounded is
function "&" function "&"
(Left : Unbounded_String; (Left : Unbounded_String;
Right : Character) Right : Character) return Unbounded_String
return Unbounded_String
is is
Result : Unbounded_String; Result : Unbounded_String;
...@@ -131,8 +131,7 @@ package body Ada.Strings.Unbounded is ...@@ -131,8 +131,7 @@ package body Ada.Strings.Unbounded is
function "&" function "&"
(Left : Character; (Left : Character;
Right : Unbounded_String) Right : Unbounded_String) return Unbounded_String
return Unbounded_String
is is
Result : Unbounded_String; Result : Unbounded_String;
...@@ -152,8 +151,7 @@ package body Ada.Strings.Unbounded is ...@@ -152,8 +151,7 @@ package body Ada.Strings.Unbounded is
function "*" function "*"
(Left : Natural; (Left : Natural;
Right : Character) Right : Character) return Unbounded_String
return Unbounded_String
is is
Result : Unbounded_String; Result : Unbounded_String;
...@@ -170,8 +168,7 @@ package body Ada.Strings.Unbounded is ...@@ -170,8 +168,7 @@ package body Ada.Strings.Unbounded is
function "*" function "*"
(Left : Natural; (Left : Natural;
Right : String) Right : String) return Unbounded_String
return Unbounded_String
is is
Len : constant Natural := Right'Length; Len : constant Natural := Right'Length;
K : Positive; K : Positive;
...@@ -193,8 +190,7 @@ package body Ada.Strings.Unbounded is ...@@ -193,8 +190,7 @@ package body Ada.Strings.Unbounded is
function "*" function "*"
(Left : Natural; (Left : Natural;
Right : Unbounded_String) Right : Unbounded_String) return Unbounded_String
return Unbounded_String
is is
Len : constant Natural := Right.Last; Len : constant Natural := Right.Last;
K : Positive; K : Positive;
...@@ -219,7 +215,10 @@ package body Ada.Strings.Unbounded is ...@@ -219,7 +215,10 @@ package body Ada.Strings.Unbounded is
-- "<" -- -- "<" --
--------- ---------
function "<" (Left, Right : Unbounded_String) return Boolean is function "<"
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean
is
begin begin
return return
Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last); Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
...@@ -227,8 +226,7 @@ package body Ada.Strings.Unbounded is ...@@ -227,8 +226,7 @@ package body Ada.Strings.Unbounded is
function "<" function "<"
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Boolean
return Boolean
is is
begin begin
return Left.Reference (1 .. Left.Last) < Right; return Left.Reference (1 .. Left.Last) < Right;
...@@ -236,8 +234,7 @@ package body Ada.Strings.Unbounded is ...@@ -236,8 +234,7 @@ package body Ada.Strings.Unbounded is
function "<" function "<"
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Boolean
return Boolean
is is
begin begin
return Left < Right.Reference (1 .. Right.Last); return Left < Right.Reference (1 .. Right.Last);
...@@ -247,7 +244,10 @@ package body Ada.Strings.Unbounded is ...@@ -247,7 +244,10 @@ package body Ada.Strings.Unbounded is
-- "<=" -- -- "<=" --
---------- ----------
function "<=" (Left, Right : Unbounded_String) return Boolean is function "<="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean
is
begin begin
return return
Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last); Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
...@@ -255,8 +255,7 @@ package body Ada.Strings.Unbounded is ...@@ -255,8 +255,7 @@ package body Ada.Strings.Unbounded is
function "<=" function "<="
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Boolean
return Boolean
is is
begin begin
return Left.Reference (1 .. Left.Last) <= Right; return Left.Reference (1 .. Left.Last) <= Right;
...@@ -264,8 +263,7 @@ package body Ada.Strings.Unbounded is ...@@ -264,8 +263,7 @@ package body Ada.Strings.Unbounded is
function "<=" function "<="
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Boolean
return Boolean
is is
begin begin
return Left <= Right.Reference (1 .. Right.Last); return Left <= Right.Reference (1 .. Right.Last);
...@@ -275,7 +273,10 @@ package body Ada.Strings.Unbounded is ...@@ -275,7 +273,10 @@ package body Ada.Strings.Unbounded is
-- "=" -- -- "=" --
--------- ---------
function "=" (Left, Right : Unbounded_String) return Boolean is function "="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean
is
begin begin
return return
Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last); Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
...@@ -283,8 +284,7 @@ package body Ada.Strings.Unbounded is ...@@ -283,8 +284,7 @@ package body Ada.Strings.Unbounded is
function "=" function "="
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Boolean
return Boolean
is is
begin begin
return Left.Reference (1 .. Left.Last) = Right; return Left.Reference (1 .. Left.Last) = Right;
...@@ -292,8 +292,7 @@ package body Ada.Strings.Unbounded is ...@@ -292,8 +292,7 @@ package body Ada.Strings.Unbounded is
function "=" function "="
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Boolean
return Boolean
is is
begin begin
return Left = Right.Reference (1 .. Right.Last); return Left = Right.Reference (1 .. Right.Last);
...@@ -303,7 +302,10 @@ package body Ada.Strings.Unbounded is ...@@ -303,7 +302,10 @@ package body Ada.Strings.Unbounded is
-- ">" -- -- ">" --
--------- ---------
function ">" (Left, Right : Unbounded_String) return Boolean is function ">"
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean
is
begin begin
return return
Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last); Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
...@@ -311,8 +313,7 @@ package body Ada.Strings.Unbounded is ...@@ -311,8 +313,7 @@ package body Ada.Strings.Unbounded is
function ">" function ">"
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Boolean
return Boolean
is is
begin begin
return Left.Reference (1 .. Left.Last) > Right; return Left.Reference (1 .. Left.Last) > Right;
...@@ -320,8 +321,7 @@ package body Ada.Strings.Unbounded is ...@@ -320,8 +321,7 @@ package body Ada.Strings.Unbounded is
function ">" function ">"
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Boolean
return Boolean
is is
begin begin
return Left > Right.Reference (1 .. Right.Last); return Left > Right.Reference (1 .. Right.Last);
...@@ -331,7 +331,10 @@ package body Ada.Strings.Unbounded is ...@@ -331,7 +331,10 @@ package body Ada.Strings.Unbounded is
-- ">=" -- -- ">=" --
---------- ----------
function ">=" (Left, Right : Unbounded_String) return Boolean is function ">="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean
is
begin begin
return return
Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last); Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
...@@ -339,8 +342,7 @@ package body Ada.Strings.Unbounded is ...@@ -339,8 +342,7 @@ package body Ada.Strings.Unbounded is
function ">=" function ">="
(Left : Unbounded_String; (Left : Unbounded_String;
Right : String) Right : String) return Boolean
return Boolean
is is
begin begin
return Left.Reference (1 .. Left.Last) >= Right; return Left.Reference (1 .. Left.Last) >= Right;
...@@ -348,8 +350,7 @@ package body Ada.Strings.Unbounded is ...@@ -348,8 +350,7 @@ package body Ada.Strings.Unbounded is
function ">=" function ">="
(Left : String; (Left : String;
Right : Unbounded_String) Right : Unbounded_String) return Boolean
return Boolean
is is
begin begin
return Left >= Right.Reference (1 .. Right.Last); return Left >= Right.Reference (1 .. Right.Last);
...@@ -362,9 +363,8 @@ package body Ada.Strings.Unbounded is ...@@ -362,9 +363,8 @@ package body Ada.Strings.Unbounded is
procedure Adjust (Object : in out Unbounded_String) is procedure Adjust (Object : in out Unbounded_String) is
begin begin
-- Copy string, except we do not copy the statically allocated null -- Copy string, except we do not copy the statically allocated null
-- string, since it can never be deallocated. -- string, since it can never be deallocated. Note that we do not copy
-- Note that we do not copy extra string room here to avoid dragging -- extra string room here to avoid dragging unused allocated memory.
-- unused allocated memory.
if Object.Reference /= Null_String'Access then if Object.Reference /= Null_String'Access then
Object.Reference := new String'(Object.Reference (1 .. Object.Last)); Object.Reference := new String'(Object.Reference (1 .. Object.Last));
...@@ -412,10 +412,9 @@ package body Ada.Strings.Unbounded is ...@@ -412,10 +412,9 @@ package body Ada.Strings.Unbounded is
----------- -----------
function Count function Count
(Source : Unbounded_String; (Source : Unbounded_String;
Pattern : String; Pattern : String;
Mapping : Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
return Natural
is is
begin begin
return return
...@@ -423,10 +422,9 @@ package body Ada.Strings.Unbounded is ...@@ -423,10 +422,9 @@ package body Ada.Strings.Unbounded is
end Count; end Count;
function Count function Count
(Source : Unbounded_String; (Source : Unbounded_String;
Pattern : String; Pattern : String;
Mapping : Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural
return Natural
is is
begin begin
return return
...@@ -434,9 +432,8 @@ package body Ada.Strings.Unbounded is ...@@ -434,9 +432,8 @@ package body Ada.Strings.Unbounded is
end Count; end Count;
function Count function Count
(Source : Unbounded_String; (Source : Unbounded_String;
Set : Maps.Character_Set) Set : Maps.Character_Set) return Natural
return Natural
is is
begin begin
return Search.Count (Source.Reference (1 .. Source.Last), Set); return Search.Count (Source.Reference (1 .. Source.Last), Set);
...@@ -449,8 +446,7 @@ package body Ada.Strings.Unbounded is ...@@ -449,8 +446,7 @@ package body Ada.Strings.Unbounded is
function Delete function Delete
(Source : Unbounded_String; (Source : Unbounded_String;
From : Positive; From : Positive;
Through : Natural) Through : Natural) return Unbounded_String
return Unbounded_String
is is
begin begin
return return
...@@ -488,8 +484,7 @@ package body Ada.Strings.Unbounded is ...@@ -488,8 +484,7 @@ package body Ada.Strings.Unbounded is
function Element function Element
(Source : Unbounded_String; (Source : Unbounded_String;
Index : Positive) Index : Positive) return Character
return Character
is is
begin begin
if Index <= Source.Last then if Index <= Source.Last then
...@@ -556,8 +551,7 @@ package body Ada.Strings.Unbounded is ...@@ -556,8 +551,7 @@ package body Ada.Strings.Unbounded is
function Head function Head
(Source : Unbounded_String; (Source : Unbounded_String;
Count : Natural; Count : Natural;
Pad : Character := Space) Pad : Character := Space) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -570,7 +564,6 @@ package body Ada.Strings.Unbounded is ...@@ -570,7 +564,6 @@ package body Ada.Strings.Unbounded is
Pad : Character := Space) Pad : Character := Space)
is is
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := Source.Reference :=
new String'(Fixed.Head (Source.Reference (1 .. Source.Last), new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
...@@ -584,11 +577,10 @@ package body Ada.Strings.Unbounded is ...@@ -584,11 +577,10 @@ package body Ada.Strings.Unbounded is
----------- -----------
function Index function Index
(Source : Unbounded_String; (Source : Unbounded_String;
Pattern : String; Pattern : String;
Going : Strings.Direction := Strings.Forward; Going : Strings.Direction := Strings.Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
return Natural
is is
begin begin
return Search.Index return Search.Index
...@@ -596,11 +588,10 @@ package body Ada.Strings.Unbounded is ...@@ -596,11 +588,10 @@ package body Ada.Strings.Unbounded is
end Index; end Index;
function Index function Index
(Source : Unbounded_String; (Source : Unbounded_String;
Pattern : String; Pattern : String;
Going : Direction := Forward; Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural
return Natural
is is
begin begin
return Search.Index return Search.Index
...@@ -611,22 +602,69 @@ package body Ada.Strings.Unbounded is ...@@ -611,22 +602,69 @@ package body Ada.Strings.Unbounded is
(Source : Unbounded_String; (Source : Unbounded_String;
Set : Maps.Character_Set; Set : Maps.Character_Set;
Test : Strings.Membership := Strings.Inside; Test : Strings.Membership := Strings.Inside;
Going : Strings.Direction := Strings.Forward) Going : Strings.Direction := Strings.Forward) return Natural
return Natural
is is
begin begin
return Search.Index return Search.Index
(Source.Reference (1 .. Source.Last), Set, Test, Going); (Source.Reference (1 .. Source.Last), Set, Test, Going);
end Index; end Index;
function Index
(Source : Unbounded_String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
is
begin
return Search.Index
(Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
end Index;
function Index
(Source : Unbounded_String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural
is
begin
return Search.Index
(Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
end Index;
function Index
(Source : Unbounded_String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural
is
begin
return Search.Index
(Source.Reference (1 .. Source.Last), Set, From, Test, Going);
end Index;
function Index_Non_Blank
(Source : Unbounded_String;
Going : Strings.Direction := Strings.Forward) return Natural
is
begin
return
Search.Index_Non_Blank
(Source.Reference (1 .. Source.Last), Going);
end Index_Non_Blank;
function Index_Non_Blank function Index_Non_Blank
(Source : Unbounded_String; (Source : Unbounded_String;
Going : Strings.Direction := Strings.Forward) From : Positive;
return Natural Going : Direction := Forward) return Natural
is is
begin begin
return return
Search.Index_Non_Blank (Source.Reference (1 .. Source.Last), Going); Search.Index_Non_Blank
(Source.Reference (1 .. Source.Last), From, Going);
end Index_Non_Blank; end Index_Non_Blank;
---------------- ----------------
...@@ -646,8 +684,7 @@ package body Ada.Strings.Unbounded is ...@@ -646,8 +684,7 @@ package body Ada.Strings.Unbounded is
function Insert function Insert
(Source : Unbounded_String; (Source : Unbounded_String;
Before : Positive; Before : Positive;
New_Item : String) New_Item : String) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -688,11 +725,10 @@ package body Ada.Strings.Unbounded is ...@@ -688,11 +725,10 @@ package body Ada.Strings.Unbounded is
--------------- ---------------
function Overwrite function Overwrite
(Source : Unbounded_String; (Source : Unbounded_String;
Position : Positive; Position : Positive;
New_Item : String) New_Item : String) return Unbounded_String
return Unbounded_String is is
begin begin
return To_Unbounded_String return To_Unbounded_String
(Fixed.Overwrite (Fixed.Overwrite
...@@ -705,15 +741,12 @@ package body Ada.Strings.Unbounded is ...@@ -705,15 +741,12 @@ package body Ada.Strings.Unbounded is
New_Item : String) New_Item : String)
is is
NL : constant Natural := New_Item'Length; NL : constant Natural := New_Item'Length;
begin begin
if Position <= Source.Last - NL + 1 then if Position <= Source.Last - NL + 1 then
Source.Reference (Position .. Position + NL - 1) := New_Item; Source.Reference (Position .. Position + NL - 1) := New_Item;
else else
declare declare
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := new String' Source.Reference := new String'
(Fixed.Overwrite (Fixed.Overwrite
...@@ -741,7 +774,6 @@ package body Ada.Strings.Unbounded is ...@@ -741,7 +774,6 @@ package body Ada.Strings.Unbounded is
Alloc_Chunk_Size : constant Positive := Alloc_Chunk_Size : constant Positive :=
Chunk_Size + (S_Length / Growth_Factor); Chunk_Size + (S_Length / Growth_Factor);
Tmp : String_Access; Tmp : String_Access;
begin begin
Tmp := new String (1 .. S_Length + Alloc_Chunk_Size); Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last); Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
...@@ -773,11 +805,10 @@ package body Ada.Strings.Unbounded is ...@@ -773,11 +805,10 @@ package body Ada.Strings.Unbounded is
------------------- -------------------
function Replace_Slice function Replace_Slice
(Source : Unbounded_String; (Source : Unbounded_String;
Low : Positive; Low : Positive;
High : Natural; High : Natural;
By : String) By : String) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -786,13 +817,12 @@ package body Ada.Strings.Unbounded is ...@@ -786,13 +817,12 @@ package body Ada.Strings.Unbounded is
end Replace_Slice; end Replace_Slice;
procedure Replace_Slice procedure Replace_Slice
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Low : Positive; Low : Positive;
High : Natural; High : Natural;
By : String) By : String)
is is
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := new String' Source.Reference := new String'
(Fixed.Replace_Slice (Fixed.Replace_Slice
...@@ -801,6 +831,20 @@ package body Ada.Strings.Unbounded is ...@@ -801,6 +831,20 @@ package body Ada.Strings.Unbounded is
Free (Old); Free (Old);
end Replace_Slice; end Replace_Slice;
--------------------------
-- Set_Unbounded_String --
--------------------------
procedure Set_Unbounded_String
(Target : out Unbounded_String;
Source : String)
is
begin
Target.Last := Source'Length;
Target.Reference := new String (1 .. Source'Length);
Target.Reference.all := Source;
end Set_Unbounded_String;
----------- -----------
-- Slice -- -- Slice --
----------- -----------
...@@ -808,8 +852,7 @@ package body Ada.Strings.Unbounded is ...@@ -808,8 +852,7 @@ package body Ada.Strings.Unbounded is
function Slice function Slice
(Source : Unbounded_String; (Source : Unbounded_String;
Low : Positive; Low : Positive;
High : Natural) High : Natural) return String
return String
is is
begin begin
-- Note: test of High > Length is in accordance with AI95-00128 -- Note: test of High > Length is in accordance with AI95-00128
...@@ -828,9 +871,7 @@ package body Ada.Strings.Unbounded is ...@@ -828,9 +871,7 @@ package body Ada.Strings.Unbounded is
function Tail function Tail
(Source : Unbounded_String; (Source : Unbounded_String;
Count : Natural; Count : Natural;
Pad : Character := Space) Pad : Character := Space) return Unbounded_String is
return Unbounded_String is
begin begin
return To_Unbounded_String return To_Unbounded_String
(Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
...@@ -842,7 +883,6 @@ package body Ada.Strings.Unbounded is ...@@ -842,7 +883,6 @@ package body Ada.Strings.Unbounded is
Pad : Character := Space) Pad : Character := Space)
is is
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := new String' Source.Reference := new String'
(Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad)); (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
...@@ -865,7 +905,6 @@ package body Ada.Strings.Unbounded is ...@@ -865,7 +905,6 @@ package body Ada.Strings.Unbounded is
function To_Unbounded_String (Source : String) return Unbounded_String is function To_Unbounded_String (Source : String) return Unbounded_String is
Result : Unbounded_String; Result : Unbounded_String;
begin begin
Result.Last := Source'Length; Result.Last := Source'Length;
Result.Reference := new String (1 .. Source'Length); Result.Reference := new String (1 .. Source'Length);
...@@ -874,11 +913,9 @@ package body Ada.Strings.Unbounded is ...@@ -874,11 +913,9 @@ package body Ada.Strings.Unbounded is
end To_Unbounded_String; end To_Unbounded_String;
function To_Unbounded_String function To_Unbounded_String
(Length : Natural) (Length : Natural) return Unbounded_String
return Unbounded_String
is is
Result : Unbounded_String; Result : Unbounded_String;
begin begin
Result.Last := Length; Result.Last := Length;
Result.Reference := new String (1 .. Length); Result.Reference := new String (1 .. Length);
...@@ -891,8 +928,7 @@ package body Ada.Strings.Unbounded is ...@@ -891,8 +928,7 @@ package body Ada.Strings.Unbounded is
function Translate function Translate
(Source : Unbounded_String; (Source : Unbounded_String;
Mapping : Maps.Character_Mapping) Mapping : Maps.Character_Mapping) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -909,8 +945,7 @@ package body Ada.Strings.Unbounded is ...@@ -909,8 +945,7 @@ package body Ada.Strings.Unbounded is
function Translate function Translate
(Source : Unbounded_String; (Source : Unbounded_String;
Mapping : Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -931,8 +966,7 @@ package body Ada.Strings.Unbounded is ...@@ -931,8 +966,7 @@ package body Ada.Strings.Unbounded is
function Trim function Trim
(Source : Unbounded_String; (Source : Unbounded_String;
Side : Trim_End) Side : Trim_End) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -944,7 +978,6 @@ package body Ada.Strings.Unbounded is ...@@ -944,7 +978,6 @@ package body Ada.Strings.Unbounded is
Side : Trim_End) Side : Trim_End)
is is
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := new String' Source.Reference := new String'
(Fixed.Trim (Source.Reference (1 .. Source.Last), Side)); (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
...@@ -955,8 +988,7 @@ package body Ada.Strings.Unbounded is ...@@ -955,8 +988,7 @@ package body Ada.Strings.Unbounded is
function Trim function Trim
(Source : Unbounded_String; (Source : Unbounded_String;
Left : Maps.Character_Set; Left : Maps.Character_Set;
Right : Maps.Character_Set) Right : Maps.Character_Set) return Unbounded_String
return Unbounded_String
is is
begin begin
return To_Unbounded_String return To_Unbounded_String
...@@ -969,7 +1001,6 @@ package body Ada.Strings.Unbounded is ...@@ -969,7 +1001,6 @@ package body Ada.Strings.Unbounded is
Right : Maps.Character_Set) Right : Maps.Character_Set)
is is
Old : String_Access := Source.Reference; Old : String_Access := Source.Reference;
begin begin
Source.Reference := new String' Source.Reference := new String'
(Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right)); (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
...@@ -977,4 +1008,35 @@ package body Ada.Strings.Unbounded is ...@@ -977,4 +1008,35 @@ package body Ada.Strings.Unbounded is
Free (Old); Free (Old);
end Trim; end Trim;
---------------------
-- Unbounded_Slice --
---------------------
function Unbounded_Slice
(Source : Unbounded_String;
Low : Positive;
High : Natural) return Unbounded_String
is
begin
if Low > Source.Last + 1 or else High > Source.Last then
raise Index_Error;
else
return To_Unbounded_String (Source.Reference.all (Low .. High));
end if;
end Unbounded_Slice;
procedure Unbounded_Slice
(Source : Unbounded_String;
Target : out Unbounded_String;
Low : Positive;
High : Natural)
is
begin
if Low > Source.Last + 1 or else High > Source.Last then
raise Index_Error;
else
Target := To_Unbounded_String (Source.Reference.all (Low .. High));
end if;
end Unbounded_Slice;
end Ada.Strings.Unbounded; end Ada.Strings.Unbounded;
gcc/ada/a-strunb.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -55,172 +55,212 @@ pragma Preelaborate (Unbounded); ...@@ -55,172 +55,212 @@ pragma Preelaborate (Unbounded);
-- Conversion, Concatenation, and Selection Functions -- -- Conversion, Concatenation, and Selection Functions --
-------------------------------------------------------- --------------------------------------------------------
function To_Unbounded_String (Source : String) return Unbounded_String; function To_Unbounded_String
function To_Unbounded_String (Length : in Natural) return Unbounded_String; (Source : String) return Unbounded_String;
function To_Unbounded_String
(Length : Natural) return Unbounded_String;
function To_String (Source : Unbounded_String) return String; function To_String (Source : Unbounded_String) return String;
procedure Set_Unbounded_String
(Target : out Unbounded_String;
Source : String);
pragma Ada_05 (Set_Unbounded_String);
procedure Append procedure Append
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
New_Item : in Unbounded_String); New_Item : Unbounded_String);
procedure Append procedure Append
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
New_Item : in String); New_Item : String);
procedure Append procedure Append
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
New_Item : in Character); New_Item : Character);
function "&" (Left, Right : Unbounded_String) return Unbounded_String; function "&"
(Left : Unbounded_String;
Right : Unbounded_String) return Unbounded_String;
function "&" function "&"
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Unbounded_String;
return Unbounded_String;
function "&" function "&"
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Unbounded_String;
return Unbounded_String;
function "&" function "&"
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in Character) Right : Character) return Unbounded_String;
return Unbounded_String;
function "&" function "&"
(Left : in Character; (Left : Character;
Right : in Unbounded_String) Right : Unbounded_String) return Unbounded_String;
return Unbounded_String;
function Element function Element
(Source : in Unbounded_String; (Source : Unbounded_String;
Index : in Positive) Index : Positive) return Character;
return Character;
procedure Replace_Element procedure Replace_Element
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Index : in Positive; Index : Positive;
By : Character); By : Character);
function Slice function Slice
(Source : in Unbounded_String; (Source : Unbounded_String;
Low : in Positive; Low : Positive;
High : in Natural) High : Natural) return String;
return String;
function Unbounded_Slice
(Source : Unbounded_String;
Low : Positive;
High : Natural) return Unbounded_String;
pragma Ada_05 (Unbounded_Slice);
procedure Unbounded_Slice
(Source : Unbounded_String;
Target : out Unbounded_String;
Low : Positive;
High : Natural);
pragma Ada_05 (Unbounded_Slice);
function "=" (Left, Right : in Unbounded_String) return Boolean; function "="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean;
function "=" function "="
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Boolean;
return Boolean;
function "=" function "="
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Boolean;
return Boolean;
function "<" (Left, Right : in Unbounded_String) return Boolean; function "<"
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean;
function "<" function "<"
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Boolean;
return Boolean;
function "<" function "<"
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Boolean;
return Boolean;
function "<=" (Left, Right : in Unbounded_String) return Boolean; function "<="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean;
function "<=" function "<="
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Boolean;
return Boolean;
function "<=" function "<="
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Boolean;
return Boolean;
function ">" (Left, Right : in Unbounded_String) return Boolean; function ">"
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean;
function ">" function ">"
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Boolean;
return Boolean;
function ">" function ">"
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Boolean;
return Boolean;
function ">=" (Left, Right : in Unbounded_String) return Boolean; function ">="
(Left : Unbounded_String;
Right : Unbounded_String) return Boolean;
function ">=" function ">="
(Left : in Unbounded_String; (Left : Unbounded_String;
Right : in String) Right : String) return Boolean;
return Boolean;
function ">=" function ">="
(Left : in String; (Left : String;
Right : in Unbounded_String) Right : Unbounded_String) return Boolean;
return Boolean;
------------------------ ------------------------
-- Search Subprograms -- -- Search Subprograms --
------------------------ ------------------------
function Index function Index
(Source : in Unbounded_String; (Source : Unbounded_String;
Pattern : in String; Pattern : String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
return Natural;
function Index
(Source : Unbounded_String;
Pattern : String;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural;
function Index function Index
(Source : in Unbounded_String; (Source : Unbounded_String;
Pattern : in String; Set : Maps.Character_Set;
Going : in Direction := Forward; Test : Membership := Inside;
Mapping : in Maps.Character_Mapping_Function) Going : Direction := Forward) return Natural;
return Natural;
function Index function Index
(Source : in Unbounded_String; (Source : Unbounded_String;
Set : in Maps.Character_Set; Pattern : String;
Test : in Membership := Inside; From : Positive;
Going : in Direction := Forward) Going : Direction := Forward;
return Natural; Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
pragma Ada_05 (Index);
function Index
(Source : Unbounded_String;
Pattern : String;
From : Positive;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural;
pragma Ada_05 (Index);
function Index
(Source : Unbounded_String;
Set : Maps.Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
pragma Ada_05 (Index);
function Index_Non_Blank function Index_Non_Blank
(Source : in Unbounded_String; (Source : Unbounded_String;
Going : in Direction := Forward) Going : Direction := Forward) return Natural;
return Natural;
function Index_Non_Blank
(Source : Unbounded_String;
From : Positive;
Going : Direction := Forward) return Natural;
pragma Ada_05 (Index_Non_Blank);
function Count function Count
(Source : in Unbounded_String; (Source : Unbounded_String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping := Maps.Identity) Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
return Natural;
function Count function Count
(Source : in Unbounded_String; (Source : Unbounded_String;
Pattern : in String; Pattern : String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Natural;
return Natural;
function Count function Count
(Source : in Unbounded_String; (Source : Unbounded_String;
Set : in Maps.Character_Set) Set : Maps.Character_Set) return Natural;
return Natural;
procedure Find_Token procedure Find_Token
(Source : in Unbounded_String; (Source : Unbounded_String;
Set : in Maps.Character_Set; Set : Maps.Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural); Last : out Natural);
...@@ -229,129 +269,116 @@ pragma Preelaborate (Unbounded); ...@@ -229,129 +269,116 @@ pragma Preelaborate (Unbounded);
------------------------------------ ------------------------------------
function Translate function Translate
(Source : in Unbounded_String; (Source : Unbounded_String;
Mapping : in Maps.Character_Mapping) Mapping : Maps.Character_Mapping) return Unbounded_String;
return Unbounded_String;
procedure Translate procedure Translate
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Mapping : Maps.Character_Mapping); Mapping : Maps.Character_Mapping);
function Translate function Translate
(Source : in Unbounded_String; (Source : Unbounded_String;
Mapping : in Maps.Character_Mapping_Function) Mapping : Maps.Character_Mapping_Function) return Unbounded_String;
return Unbounded_String;
procedure Translate procedure Translate
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Mapping : in Maps.Character_Mapping_Function); Mapping : Maps.Character_Mapping_Function);
--------------------------------------- ---------------------------------------
-- String Transformation Subprograms -- -- String Transformation Subprograms --
--------------------------------------- ---------------------------------------
function Replace_Slice function Replace_Slice
(Source : in Unbounded_String; (Source : Unbounded_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String) By : String) return Unbounded_String;
return Unbounded_String;
procedure Replace_Slice procedure Replace_Slice
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in String); By : String);
function Insert function Insert
(Source : in Unbounded_String; (Source : Unbounded_String;
Before : in Positive; Before : Positive;
New_Item : in String) New_Item : String) return Unbounded_String;
return Unbounded_String;
procedure Insert procedure Insert
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Before : in Positive; Before : Positive;
New_Item : in String); New_Item : String);
function Overwrite function Overwrite
(Source : in Unbounded_String; (Source : Unbounded_String;
Position : in Positive; Position : Positive;
New_Item : in String) New_Item : String) return Unbounded_String;
return Unbounded_String;
procedure Overwrite procedure Overwrite
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Position : in Positive; Position : Positive;
New_Item : in String); New_Item : String);
function Delete function Delete
(Source : in Unbounded_String; (Source : Unbounded_String;
From : in Positive; From : Positive;
Through : in Natural) Through : Natural) return Unbounded_String;
return Unbounded_String;
procedure Delete procedure Delete
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
From : in Positive; From : Positive;
Through : in Natural); Through : Natural);
function Trim function Trim
(Source : in Unbounded_String; (Source : Unbounded_String;
Side : in Trim_End) Side : Trim_End) return Unbounded_String;
return Unbounded_String;
procedure Trim procedure Trim
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Side : in Trim_End); Side : Trim_End);
function Trim function Trim
(Source : in Unbounded_String; (Source : Unbounded_String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set) Right : Maps.Character_Set) return Unbounded_String;
return Unbounded_String;
procedure Trim procedure Trim
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Left : in Maps.Character_Set; Left : Maps.Character_Set;
Right : in Maps.Character_Set); Right : Maps.Character_Set);
function Head function Head
(Source : in Unbounded_String; (Source : Unbounded_String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return Unbounded_String;
return Unbounded_String;
procedure Head procedure Head
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Count : in Natural; Count : Natural;
Pad : in Character := Space); Pad : Character := Space);
function Tail function Tail
(Source : in Unbounded_String; (Source : Unbounded_String;
Count : in Natural; Count : Natural;
Pad : in Character := Space) Pad : Character := Space) return Unbounded_String;
return Unbounded_String;
procedure Tail procedure Tail
(Source : in out Unbounded_String; (Source : in out Unbounded_String;
Count : in Natural; Count : Natural;
Pad : in Character := Space); Pad : Character := Space);
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Character) Right : Character) return Unbounded_String;
return Unbounded_String;
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in String) Right : String) return Unbounded_String;
return Unbounded_String;
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Unbounded_String) Right : Unbounded_String) return Unbounded_String;
return Unbounded_String;
private private
pragma Inline (Length); pragma Inline (Length);
......
gcc/ada/a-stwifi.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -41,59 +41,85 @@ package body Ada.Strings.Wide_Fixed is ...@@ -41,59 +41,85 @@ package body Ada.Strings.Wide_Fixed is
------------------------ ------------------------
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural return Natural
renames Ada.Strings.Wide_Search.Index; renames Ada.Strings.Wide_Search.Index;
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
return Natural
renames Ada.Strings.Wide_Search.Index; renames Ada.Strings.Wide_Search.Index;
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership := Inside; Test : Membership := Inside;
Going : in Direction := Forward) Going : Direction := Forward) return Natural
return Natural
renames Ada.Strings.Wide_Search.Index; renames Ada.Strings.Wide_Search.Index;
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural
renames Ada.Strings.Wide_Search.Index;
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
renames Ada.Strings.Wide_Search.Index;
function Index
(Source : Wide_String;
Set : Wide_Maps.Wide_Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural
renames Ada.Strings.Wide_Search.Index;
function Index_Non_Blank
(Source : Wide_String;
Going : Direction := Forward) return Natural
renames Ada.Strings.Wide_Search.Index_Non_Blank;
function Index_Non_Blank function Index_Non_Blank
(Source : in Wide_String; (Source : Wide_String;
Going : in Direction := Forward) From : Positive;
return Natural Going : Direction := Forward) return Natural
renames Ada.Strings.Wide_Search.Index_Non_Blank; renames Ada.Strings.Wide_Search.Index_Non_Blank;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural return Natural
renames Ada.Strings.Wide_Search.Count; renames Ada.Strings.Wide_Search.Count;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
return Natural
renames Ada.Strings.Wide_Search.Count; renames Ada.Strings.Wide_Search.Count;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set) Set : Wide_Maps.Wide_Character_Set) return Natural
return Natural
renames Ada.Strings.Wide_Search.Count; renames Ada.Strings.Wide_Search.Count;
procedure Find_Token procedure Find_Token
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural) Last : out Natural)
renames Ada.Strings.Wide_Search.Find_Token; renames Ada.Strings.Wide_Search.Find_Token;
...@@ -103,9 +129,8 @@ package body Ada.Strings.Wide_Fixed is ...@@ -103,9 +129,8 @@ package body Ada.Strings.Wide_Fixed is
--------- ---------
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Wide_Character) Right : Wide_Character) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Left); Result : Wide_String (1 .. Left);
...@@ -118,9 +143,8 @@ package body Ada.Strings.Wide_Fixed is ...@@ -118,9 +143,8 @@ package body Ada.Strings.Wide_Fixed is
end "*"; end "*";
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Wide_String) Right : Wide_String) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Left * Right'Length); Result : Wide_String (1 .. Left * Right'Length);
Ptr : Integer := 1; Ptr : Integer := 1;
...@@ -139,10 +163,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -139,10 +163,9 @@ package body Ada.Strings.Wide_Fixed is
------------ ------------
function Delete function Delete
(Source : in Wide_String; (Source : Wide_String;
From : in Positive; From : Positive;
Through : in Natural) Through : Natural) return Wide_String
return Wide_String
is is
begin begin
if From not in Source'Range if From not in Source'Range
...@@ -168,10 +191,10 @@ package body Ada.Strings.Wide_Fixed is ...@@ -168,10 +191,10 @@ package body Ada.Strings.Wide_Fixed is
procedure Delete procedure Delete
(Source : in out Wide_String; (Source : in out Wide_String;
From : in Positive; From : Positive;
Through : in Natural; Through : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space)
is is
begin begin
Move (Source => Delete (Source, From, Through), Move (Source => Delete (Source, From, Through),
...@@ -185,10 +208,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -185,10 +208,9 @@ package body Ada.Strings.Wide_Fixed is
---------- ----------
function Head function Head
(Source : in Wide_String; (Source : Wide_String;
Count : in Natural; Count : Natural;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Count); Result : Wide_String (1 .. Count);
...@@ -209,9 +231,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -209,9 +231,9 @@ package body Ada.Strings.Wide_Fixed is
procedure Head procedure Head
(Source : in out Wide_String; (Source : in out Wide_String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space) Pad : Wide_Character := Ada.Strings.Wide_Space)
is is
begin begin
Move (Source => Head (Source, Count, Pad), Move (Source => Head (Source, Count, Pad),
...@@ -226,10 +248,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -226,10 +248,9 @@ package body Ada.Strings.Wide_Fixed is
------------ ------------
function Insert function Insert
(Source : in Wide_String; (Source : Wide_String;
Before : in Positive; Before : Positive;
New_Item : in Wide_String) New_Item : Wide_String) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Source'Length + New_Item'Length); Result : Wide_String (1 .. Source'Length + New_Item'Length);
...@@ -245,9 +266,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -245,9 +266,9 @@ package body Ada.Strings.Wide_Fixed is
procedure Insert procedure Insert
(Source : in out Wide_String; (Source : in out Wide_String;
Before : in Positive; Before : Positive;
New_Item : in Wide_String; New_Item : Wide_String;
Drop : in Truncation := Error) Drop : Truncation := Error)
is is
begin begin
Move (Source => Insert (Source, Before, New_Item), Move (Source => Insert (Source, Before, New_Item),
...@@ -260,11 +281,11 @@ package body Ada.Strings.Wide_Fixed is ...@@ -260,11 +281,11 @@ package body Ada.Strings.Wide_Fixed is
---------- ----------
procedure Move procedure Move
(Source : in Wide_String; (Source : Wide_String;
Target : out Wide_String; Target : out Wide_String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space)
is is
Sfirst : constant Integer := Source'First; Sfirst : constant Integer := Source'First;
Slast : constant Integer := Source'Last; Slast : constant Integer := Source'Last;
...@@ -369,10 +390,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -369,10 +390,9 @@ package body Ada.Strings.Wide_Fixed is
--------------- ---------------
function Overwrite function Overwrite
(Source : in Wide_String; (Source : Wide_String;
Position : in Positive; Position : Positive;
New_Item : in Wide_String) New_Item : Wide_String) return Wide_String
return Wide_String
is is
begin begin
if Position not in Source'First .. Source'Last + 1 then if Position not in Source'First .. Source'Last + 1 then
...@@ -396,9 +416,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -396,9 +416,9 @@ package body Ada.Strings.Wide_Fixed is
procedure Overwrite procedure Overwrite
(Source : in out Wide_String; (Source : in out Wide_String;
Position : in Positive; Position : Positive;
New_Item : in Wide_String; New_Item : Wide_String;
Drop : in Truncation := Right) Drop : Truncation := Right)
is is
begin begin
Move (Source => Overwrite (Source, Position, New_Item), Move (Source => Overwrite (Source, Position, New_Item),
...@@ -411,11 +431,10 @@ package body Ada.Strings.Wide_Fixed is ...@@ -411,11 +431,10 @@ package body Ada.Strings.Wide_Fixed is
------------------- -------------------
function Replace_Slice function Replace_Slice
(Source : in Wide_String; (Source : Wide_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in Wide_String) By : Wide_String) return Wide_String
return Wide_String
is is
Result_Length : Natural; Result_Length : Natural;
...@@ -446,12 +465,12 @@ package body Ada.Strings.Wide_Fixed is ...@@ -446,12 +465,12 @@ package body Ada.Strings.Wide_Fixed is
procedure Replace_Slice procedure Replace_Slice
(Source : in out Wide_String; (Source : in out Wide_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in Wide_String; By : Wide_String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space)
is is
begin begin
Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
...@@ -462,10 +481,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -462,10 +481,9 @@ package body Ada.Strings.Wide_Fixed is
---------- ----------
function Tail function Tail
(Source : in Wide_String; (Source : Wide_String;
Count : in Natural; Count : Natural;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Count); Result : Wide_String (1 .. Count);
...@@ -488,9 +506,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -488,9 +506,9 @@ package body Ada.Strings.Wide_Fixed is
procedure Tail procedure Tail
(Source : in out Wide_String; (Source : in out Wide_String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space) Pad : Wide_Character := Ada.Strings.Wide_Space)
is is
begin begin
Move (Source => Tail (Source, Count, Pad), Move (Source => Tail (Source, Count, Pad),
...@@ -505,9 +523,8 @@ package body Ada.Strings.Wide_Fixed is ...@@ -505,9 +523,8 @@ package body Ada.Strings.Wide_Fixed is
--------------- ---------------
function Translate function Translate
(Source : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping) Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Source'Length); Result : Wide_String (1 .. Source'Length);
...@@ -521,7 +538,7 @@ package body Ada.Strings.Wide_Fixed is ...@@ -521,7 +538,7 @@ package body Ada.Strings.Wide_Fixed is
procedure Translate procedure Translate
(Source : in out Wide_String; (Source : in out Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping) Mapping : Wide_Maps.Wide_Character_Mapping)
is is
begin begin
for J in Source'Range loop for J in Source'Range loop
...@@ -530,9 +547,8 @@ package body Ada.Strings.Wide_Fixed is ...@@ -530,9 +547,8 @@ package body Ada.Strings.Wide_Fixed is
end Translate; end Translate;
function Translate function Translate
(Source : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String
return Wide_String
is is
Result : Wide_String (1 .. Source'Length); Result : Wide_String (1 .. Source'Length);
...@@ -546,7 +562,7 @@ package body Ada.Strings.Wide_Fixed is ...@@ -546,7 +562,7 @@ package body Ada.Strings.Wide_Fixed is
procedure Translate procedure Translate
(Source : in out Wide_String; (Source : in out Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function)
is is
begin begin
for J in Source'Range loop for J in Source'Range loop
...@@ -559,9 +575,8 @@ package body Ada.Strings.Wide_Fixed is ...@@ -559,9 +575,8 @@ package body Ada.Strings.Wide_Fixed is
---------- ----------
function Trim function Trim
(Source : in Wide_String; (Source : Wide_String;
Side : in Trim_End) Side : Trim_End) return Wide_String
return Wide_String
is is
Low : Natural := Source'First; Low : Natural := Source'First;
High : Natural := Source'Last; High : Natural := Source'Last;
...@@ -599,9 +614,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -599,9 +614,9 @@ package body Ada.Strings.Wide_Fixed is
procedure Trim procedure Trim
(Source : in out Wide_String; (Source : in out Wide_String;
Side : in Trim_End; Side : Trim_End;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space)
is is
begin begin
Move (Source => Trim (Source, Side), Move (Source => Trim (Source, Side),
...@@ -611,10 +626,9 @@ package body Ada.Strings.Wide_Fixed is ...@@ -611,10 +626,9 @@ package body Ada.Strings.Wide_Fixed is
end Trim; end Trim;
function Trim function Trim
(Source : in Wide_String; (Source : Wide_String;
Left : in Wide_Maps.Wide_Character_Set; Left : Wide_Maps.Wide_Character_Set;
Right : in Wide_Maps.Wide_Character_Set) Right : Wide_Maps.Wide_Character_Set) return Wide_String
return Wide_String
is is
Low : Natural := Source'First; Low : Natural := Source'First;
High : Natural := Source'Last; High : Natural := Source'Last;
...@@ -644,10 +658,10 @@ package body Ada.Strings.Wide_Fixed is ...@@ -644,10 +658,10 @@ package body Ada.Strings.Wide_Fixed is
procedure Trim procedure Trim
(Source : in out Wide_String; (Source : in out Wide_String;
Left : in Wide_Maps.Wide_Character_Set; Left : Wide_Maps.Wide_Character_Set;
Right : in Wide_Maps.Wide_Character_Set; Right : Wide_Maps.Wide_Character_Set;
Justify : in Alignment := Strings.Left; Justify : Alignment := Strings.Left;
Pad : in Wide_Character := Wide_Space) Pad : Wide_Character := Wide_Space)
is is
begin begin
Move (Source => Trim (Source, Left, Right), Move (Source => Trim (Source, Left, Right),
......
gcc/ada/a-stwifi.ads
...@@ -24,63 +24,89 @@ pragma Preelaborate (Wide_Fixed); ...@@ -24,63 +24,89 @@ pragma Preelaborate (Wide_Fixed);
------------------------------------------------------------------- -------------------------------------------------------------------
procedure Move procedure Move
(Source : in Wide_String; (Source : Wide_String;
Target : out Wide_String; Target : out Wide_String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
------------------------ ------------------------
-- Search Subprograms -- -- Search Subprograms --
------------------------ ------------------------
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural; return Natural;
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
return Natural;
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership := Inside; Test : Membership := Inside;
Going : in Direction := Forward) Going : Direction := Forward) return Natural;
return Natural;
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural;
pragma Ada_05 (Index);
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
pragma Ada_05 (Index);
function Index
(Source : Wide_String;
Set : Wide_Maps.Wide_Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
pragma Ada_05 (Index);
function Index_Non_Blank
(Source : Wide_String;
Going : Direction := Forward) return Natural;
function Index_Non_Blank function Index_Non_Blank
(Source : in Wide_String; (Source : Wide_String;
Going : in Direction := Forward) From : Positive;
return Natural; Going : Direction := Forward) return Natural;
pragma Ada_05 (Index_Non_Blank);
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural; return Natural;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
return Natural;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set) Set : Wide_Maps.Wide_Character_Set) return Natural;
return Natural;
procedure Find_Token procedure Find_Token
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural); Last : out Natural);
...@@ -89,144 +115,132 @@ pragma Preelaborate (Wide_Fixed); ...@@ -89,144 +115,132 @@ pragma Preelaborate (Wide_Fixed);
----------------------------------------- -----------------------------------------
function Translate function Translate
(Source : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping) Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String;
return Wide_String;
procedure Translate procedure Translate
(Source : in out Wide_String; (Source : in out Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping); Mapping : Wide_Maps.Wide_Character_Mapping);
function Translate function Translate
(Source : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String;
return Wide_String;
procedure Translate procedure Translate
(Source : in out Wide_String; (Source : in out Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function); Mapping : Wide_Maps.Wide_Character_Mapping_Function);
-------------------------------------------- --------------------------------------------
-- Wide_String Transformation Subprograms -- -- Wide_String Transformation Subprograms --
-------------------------------------------- --------------------------------------------
function Replace_Slice function Replace_Slice
(Source : in Wide_String; (Source : Wide_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in Wide_String) By : Wide_String) return Wide_String;
return Wide_String;
procedure Replace_Slice procedure Replace_Slice
(Source : in out Wide_String; (Source : in out Wide_String;
Low : in Positive; Low : Positive;
High : in Natural; High : Natural;
By : in Wide_String; By : Wide_String;
Drop : in Truncation := Error; Drop : Truncation := Error;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
function Insert function Insert
(Source : in Wide_String; (Source : Wide_String;
Before : in Positive; Before : Positive;
New_Item : in Wide_String) New_Item : Wide_String) return Wide_String;
return Wide_String;
procedure Insert procedure Insert
(Source : in out Wide_String; (Source : in out Wide_String;
Before : in Positive; Before : Positive;
New_Item : in Wide_String; New_Item : Wide_String;
Drop : in Truncation := Error); Drop : Truncation := Error);
function Overwrite function Overwrite
(Source : in Wide_String; (Source : Wide_String;
Position : in Positive; Position : Positive;
New_Item : in Wide_String) New_Item : Wide_String) return Wide_String;
return Wide_String;
procedure Overwrite procedure Overwrite
(Source : in out Wide_String; (Source : in out Wide_String;
Position : in Positive; Position : Positive;
New_Item : in Wide_String; New_Item : Wide_String;
Drop : in Truncation := Right); Drop : Truncation := Right);
function Delete function Delete
(Source : in Wide_String; (Source : Wide_String;
From : in Positive; From : Positive;
Through : in Natural) Through : Natural) return Wide_String;
return Wide_String;
procedure Delete procedure Delete
(Source : in out Wide_String; (Source : in out Wide_String;
From : in Positive; From : Positive;
Through : in Natural; Through : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
-------------------------------------- --------------------------------------
-- Wide_String Selector Subprograms -- -- Wide_String Selector Subprograms --
-------------------------------------- --------------------------------------
function Trim function Trim
(Source : in Wide_String; (Source : Wide_String;
Side : in Trim_End) Side : Trim_End) return Wide_String;
return Wide_String;
procedure Trim procedure Trim
(Source : in out Wide_String; (Source : in out Wide_String;
Side : in Trim_End; Side : Trim_End;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Wide_Space); Pad : Wide_Character := Wide_Space);
function Trim function Trim
(Source : in Wide_String; (Source : Wide_String;
Left : in Wide_Maps.Wide_Character_Set; Left : Wide_Maps.Wide_Character_Set;
Right : in Wide_Maps.Wide_Character_Set) Right : Wide_Maps.Wide_Character_Set) return Wide_String;
return Wide_String;
procedure Trim procedure Trim
(Source : in out Wide_String; (Source : in out Wide_String;
Left : in Wide_Maps.Wide_Character_Set; Left : Wide_Maps.Wide_Character_Set;
Right : in Wide_Maps.Wide_Character_Set; Right : Wide_Maps.Wide_Character_Set;
Justify : in Alignment := Ada.Strings.Left; Justify : Alignment := Ada.Strings.Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
function Head function Head
(Source : in Wide_String; (Source : Wide_String;
Count : in Natural; Count : Natural;
Pad : in Wide_Character := Ada.Strings.Wide_Space) Pad : Wide_Character := Ada.Strings.Wide_Space) return Wide_String;
return Wide_String;
procedure Head procedure Head
(Source : in out Wide_String; (Source : in out Wide_String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
function Tail function Tail
(Source : in Wide_String; (Source : Wide_String;
Count : in Natural; Count : Natural;
Pad : in Wide_Character := Ada.Strings.Wide_Space) Pad : Wide_Character := Ada.Strings.Wide_Space) return Wide_String;
return Wide_String;
procedure Tail procedure Tail
(Source : in out Wide_String; (Source : in out Wide_String;
Count : in Natural; Count : Natural;
Justify : in Alignment := Left; Justify : Alignment := Left;
Pad : in Wide_Character := Ada.Strings.Wide_Space); Pad : Wide_Character := Ada.Strings.Wide_Space);
--------------------------------------- ---------------------------------------
-- Wide_String Constructor Functions -- -- Wide_String Constructor Functions --
--------------------------------------- ---------------------------------------
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Wide_Character) Right : Wide_Character) return Wide_String;
return Wide_String;
function "*" function "*"
(Left : in Natural; (Left : Natural;
Right : in Wide_String) Right : Wide_String) return Wide_String;
return Wide_String;
end Ada.Strings.Wide_Fixed; end Ada.Strings.Wide_Fixed;
gcc/ada/a-stwima.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,8 +40,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -40,8 +40,7 @@ package body Ada.Strings.Wide_Maps is
--------- ---------
function "-" function "-"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set
return Wide_Character_Set
is is
LS : constant Wide_Character_Ranges_Access := Left.Set; LS : constant Wide_Character_Ranges_Access := Left.Set;
RS : constant Wide_Character_Ranges_Access := Right.Set; RS : constant Wide_Character_Ranges_Access := Right.Set;
...@@ -159,8 +158,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -159,8 +158,7 @@ package body Ada.Strings.Wide_Maps is
----------- -----------
function "and" function "and"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set
return Wide_Character_Set
is is
LS : constant Wide_Character_Ranges_Access := Left.Set; LS : constant Wide_Character_Ranges_Access := Left.Set;
RS : constant Wide_Character_Ranges_Access := Right.Set; RS : constant Wide_Character_Ranges_Access := Right.Set;
...@@ -210,8 +208,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -210,8 +208,7 @@ package body Ada.Strings.Wide_Maps is
----------- -----------
function "not" function "not"
(Right : in Wide_Character_Set) (Right : Wide_Character_Set) return Wide_Character_Set
return Wide_Character_Set
is is
RS : constant Wide_Character_Ranges_Access := Right.Set; RS : constant Wide_Character_Ranges_Access := Right.Set;
...@@ -253,8 +250,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -253,8 +250,7 @@ package body Ada.Strings.Wide_Maps is
---------- ----------
function "or" function "or"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set
return Wide_Character_Set
is is
LS : constant Wide_Character_Ranges_Access := Left.Set; LS : constant Wide_Character_Ranges_Access := Left.Set;
RS : constant Wide_Character_Ranges_Access := Right.Set; RS : constant Wide_Character_Ranges_Access := Right.Set;
...@@ -341,8 +337,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -341,8 +337,7 @@ package body Ada.Strings.Wide_Maps is
----------- -----------
function "xor" function "xor"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set
return Wide_Character_Set
is is
begin begin
return (Left or Right) - (Left and Right); return (Left or Right) - (Left and Right);
...@@ -409,9 +404,8 @@ package body Ada.Strings.Wide_Maps is ...@@ -409,9 +404,8 @@ package body Ada.Strings.Wide_Maps is
----------- -----------
function Is_In function Is_In
(Element : in Wide_Character; (Element : Wide_Character;
Set : in Wide_Character_Set) Set : Wide_Character_Set) return Boolean
return Boolean
is is
L, R, M : Natural; L, R, M : Natural;
SS : constant Wide_Character_Ranges_Access := Set.Set; SS : constant Wide_Character_Ranges_Access := Set.Set;
...@@ -446,9 +440,8 @@ package body Ada.Strings.Wide_Maps is ...@@ -446,9 +440,8 @@ package body Ada.Strings.Wide_Maps is
--------------- ---------------
function Is_Subset function Is_Subset
(Elements : in Wide_Character_Set; (Elements : Wide_Character_Set;
Set : in Wide_Character_Set) Set : Wide_Character_Set) return Boolean
return Boolean
is is
ES : constant Wide_Character_Ranges_Access := Elements.Set; ES : constant Wide_Character_Ranges_Access := Elements.Set;
SS : constant Wide_Character_Ranges_Access := Set.Set; SS : constant Wide_Character_Ranges_Access := Set.Set;
...@@ -493,8 +486,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -493,8 +486,7 @@ package body Ada.Strings.Wide_Maps is
--------------- ---------------
function To_Domain function To_Domain
(Map : in Wide_Character_Mapping) (Map : Wide_Character_Mapping) return Wide_Character_Sequence
return Wide_Character_Sequence
is is
begin begin
return Map.Map.Domain; return Map.Map.Domain;
...@@ -505,8 +497,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -505,8 +497,7 @@ package body Ada.Strings.Wide_Maps is
---------------- ----------------
function To_Mapping function To_Mapping
(From, To : in Wide_Character_Sequence) (From, To : Wide_Character_Sequence) return Wide_Character_Mapping
return Wide_Character_Mapping
is is
Domain : Wide_Character_Sequence (1 .. From'Length); Domain : Wide_Character_Sequence (1 .. From'Length);
Rangev : Wide_Character_Sequence (1 .. To'Length); Rangev : Wide_Character_Sequence (1 .. To'Length);
...@@ -554,8 +545,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -554,8 +545,7 @@ package body Ada.Strings.Wide_Maps is
-------------- --------------
function To_Range function To_Range
(Map : in Wide_Character_Mapping) (Map : Wide_Character_Mapping) return Wide_Character_Sequence
return Wide_Character_Sequence
is is
begin begin
return Map.Map.Rangev; return Map.Map.Rangev;
...@@ -566,8 +556,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -566,8 +556,7 @@ package body Ada.Strings.Wide_Maps is
--------------- ---------------
function To_Ranges function To_Ranges
(Set : in Wide_Character_Set) (Set : in Wide_Character_Set) return Wide_Character_Ranges
return Wide_Character_Ranges
is is
begin begin
return Set.Set.all; return Set.Set.all;
...@@ -578,8 +567,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -578,8 +567,7 @@ package body Ada.Strings.Wide_Maps is
----------------- -----------------
function To_Sequence function To_Sequence
(Set : in Wide_Character_Set) (Set : Wide_Character_Set) return Wide_Character_Sequence
return Wide_Character_Sequence
is is
SS : constant Wide_Character_Ranges_Access := Set.Set; SS : constant Wide_Character_Ranges_Access := Set.Set;
...@@ -604,8 +592,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -604,8 +592,7 @@ package body Ada.Strings.Wide_Maps is
-- Case of multiple range input -- Case of multiple range input
function To_Set function To_Set
(Ranges : in Wide_Character_Ranges) (Ranges : Wide_Character_Ranges) return Wide_Character_Set
return Wide_Character_Set
is is
Result : Wide_Character_Ranges (Ranges'Range); Result : Wide_Character_Ranges (Ranges'Range);
N : Natural := 0; N : Natural := 0;
...@@ -667,8 +654,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -667,8 +654,7 @@ package body Ada.Strings.Wide_Maps is
-- Case of single range input -- Case of single range input
function To_Set function To_Set
(Span : in Wide_Character_Range) (Span : Wide_Character_Range) return Wide_Character_Set
return Wide_Character_Set
is is
begin begin
if Span.Low > Span.High then if Span.Low > Span.High then
...@@ -685,8 +671,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -685,8 +671,7 @@ package body Ada.Strings.Wide_Maps is
-- Case of wide string input -- Case of wide string input
function To_Set function To_Set
(Sequence : in Wide_Character_Sequence) (Sequence : Wide_Character_Sequence) return Wide_Character_Set
return Wide_Character_Set
is is
R : Wide_Character_Ranges (1 .. Sequence'Length); R : Wide_Character_Ranges (1 .. Sequence'Length);
...@@ -701,8 +686,7 @@ package body Ada.Strings.Wide_Maps is ...@@ -701,8 +686,7 @@ package body Ada.Strings.Wide_Maps is
-- Case of single wide character input -- Case of single wide character input
function To_Set function To_Set
(Singleton : in Wide_Character) (Singleton : Wide_Character) return Wide_Character_Set
return Wide_Character_Set
is is
begin begin
return return
...@@ -715,9 +699,8 @@ package body Ada.Strings.Wide_Maps is ...@@ -715,9 +699,8 @@ package body Ada.Strings.Wide_Maps is
----------- -----------
function Value function Value
(Map : in Wide_Character_Mapping; (Map : Wide_Character_Mapping;
Element : in Wide_Character) Element : Wide_Character) return Wide_Character
return Wide_Character
is is
L, R, M : Natural; L, R, M : Natural;
......
gcc/ada/a-stwima.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-1998 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -63,16 +63,13 @@ package Ada.Strings.Wide_Maps is ...@@ -63,16 +63,13 @@ package Ada.Strings.Wide_Maps is
array (Positive range <>) of Wide_Character_Range; array (Positive range <>) of Wide_Character_Range;
function To_Set function To_Set
(Ranges : in Wide_Character_Ranges) (Ranges : Wide_Character_Ranges) return Wide_Character_Set;
return Wide_Character_Set;
function To_Set function To_Set
(Span : in Wide_Character_Range) (Span : Wide_Character_Range) return Wide_Character_Set;
return Wide_Character_Set;
function To_Ranges function To_Ranges
(Set : in Wide_Character_Set) (Set : in Wide_Character_Set) return Wide_Character_Ranges;
return Wide_Character_Ranges;
--------------------------------------- ---------------------------------------
-- Operations on Wide Character Sets -- -- Operations on Wide Character Sets --
...@@ -81,55 +78,44 @@ package Ada.Strings.Wide_Maps is ...@@ -81,55 +78,44 @@ package Ada.Strings.Wide_Maps is
function "=" (Left, Right : in Wide_Character_Set) return Boolean; function "=" (Left, Right : in Wide_Character_Set) return Boolean;
function "not" function "not"
(Right : in Wide_Character_Set) (Right : Wide_Character_Set) return Wide_Character_Set;
return Wide_Character_Set;
function "and" function "and"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set;
return Wide_Character_Set;
function "or" function "or"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set;
return Wide_Character_Set;
function "xor" function "xor"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set;
return Wide_Character_Set;
function "-" function "-"
(Left, Right : in Wide_Character_Set) (Left, Right : Wide_Character_Set) return Wide_Character_Set;
return Wide_Character_Set;
function Is_In function Is_In
(Element : in Wide_Character; (Element : Wide_Character;
Set : in Wide_Character_Set) Set : Wide_Character_Set) return Boolean;
return Boolean;
function Is_Subset function Is_Subset
(Elements : in Wide_Character_Set; (Elements : Wide_Character_Set;
Set : in Wide_Character_Set) Set : Wide_Character_Set) return Boolean;
return Boolean;
function "<=" function "<="
(Left : in Wide_Character_Set; (Left : Wide_Character_Set;
Right : in Wide_Character_Set) Right : Wide_Character_Set) return Boolean
return Boolean
renames Is_Subset; renames Is_Subset;
subtype Wide_Character_Sequence is Wide_String; subtype Wide_Character_Sequence is Wide_String;
-- Alternative representation for a set of character values -- Alternative representation for a set of character values
function To_Set function To_Set
(Sequence : in Wide_Character_Sequence) (Sequence : Wide_Character_Sequence) return Wide_Character_Set;
return Wide_Character_Set;
function To_Set function To_Set
(Singleton : in Wide_Character) (Singleton : Wide_Character) return Wide_Character_Set;
return Wide_Character_Set;
function To_Sequence function To_Sequence
(Set : in Wide_Character_Set) (Set : Wide_Character_Set) return Wide_Character_Sequence;
return Wide_Character_Sequence;
----------------------------------------- -----------------------------------------
-- Wide Character Mapping Declarations -- -- Wide Character Mapping Declarations --
...@@ -139,9 +125,8 @@ package Ada.Strings.Wide_Maps is ...@@ -139,9 +125,8 @@ package Ada.Strings.Wide_Maps is
-- Representation for a wide character to wide character mapping: -- Representation for a wide character to wide character mapping:
function Value function Value
(Map : in Wide_Character_Mapping; (Map : Wide_Character_Mapping;
Element : in Wide_Character) Element : Wide_Character) return Wide_Character;
return Wide_Character;
Identity : constant Wide_Character_Mapping; Identity : constant Wide_Character_Mapping;
...@@ -150,19 +135,16 @@ package Ada.Strings.Wide_Maps is ...@@ -150,19 +135,16 @@ package Ada.Strings.Wide_Maps is
--------------------------------- ---------------------------------
function To_Mapping function To_Mapping
(From, To : in Wide_Character_Sequence) (From, To : Wide_Character_Sequence) return Wide_Character_Mapping;
return Wide_Character_Mapping;
function To_Domain function To_Domain
(Map : in Wide_Character_Mapping) (Map : Wide_Character_Mapping) return Wide_Character_Sequence;
return Wide_Character_Sequence;
function To_Range function To_Range
(Map : in Wide_Character_Mapping) (Map : Wide_Character_Mapping) return Wide_Character_Sequence;
return Wide_Character_Sequence;
type Wide_Character_Mapping_Function is type Wide_Character_Mapping_Function is
access function (From : in Wide_Character) return Wide_Character; access function (From : Wide_Character) return Wide_Character;
private private
package AF renames Ada.Finalization; package AF renames Ada.Finalization;
......
gcc/ada/a-stwise.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992,1993,1994 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,8 +42,7 @@ package body Ada.Strings.Wide_Search is ...@@ -42,8 +42,7 @@ package body Ada.Strings.Wide_Search is
function Belongs function Belongs
(Element : Wide_Character; (Element : Wide_Character;
Set : Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : Membership) Test : Membership) return Boolean;
return Boolean;
pragma Inline (Belongs); pragma Inline (Belongs);
-- Determines if the given element is in (Test = Inside) or not in -- Determines if the given element is in (Test = Inside) or not in
-- (Test = Outside) the given character set. -- (Test = Outside) the given character set.
...@@ -55,9 +54,8 @@ package body Ada.Strings.Wide_Search is ...@@ -55,9 +54,8 @@ package body Ada.Strings.Wide_Search is
function Belongs function Belongs
(Element : Wide_Character; (Element : Wide_Character;
Set : Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : Membership) Test : Membership) return Boolean
return Boolean is is
begin begin
if Test = Inside then if Test = Inside then
return Is_In (Element, Set); return Is_In (Element, Set);
...@@ -71,10 +69,10 @@ package body Ada.Strings.Wide_Search is ...@@ -71,10 +69,10 @@ package body Ada.Strings.Wide_Search is
----------- -----------
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural return Natural
is is
N : Natural; N : Natural;
J : Natural; J : Natural;
...@@ -117,10 +115,9 @@ package body Ada.Strings.Wide_Search is ...@@ -117,10 +115,9 @@ package body Ada.Strings.Wide_Search is
end Count; end Count;
function Count function Count
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
return Natural
is is
Mapped_Source : Wide_String (Source'Range); Mapped_Source : Wide_String (Source'Range);
...@@ -132,9 +129,9 @@ package body Ada.Strings.Wide_Search is ...@@ -132,9 +129,9 @@ package body Ada.Strings.Wide_Search is
return Count (Mapped_Source, Pattern); return Count (Mapped_Source, Pattern);
end Count; end Count;
function Count (Source : in Wide_String; function Count
Set : in Wide_Maps.Wide_Character_Set) (Source : in Wide_String;
return Natural Set : Wide_Maps.Wide_Character_Set) return Natural
is is
N : Natural := 0; N : Natural := 0;
...@@ -153,9 +150,9 @@ package body Ada.Strings.Wide_Search is ...@@ -153,9 +150,9 @@ package body Ada.Strings.Wide_Search is
---------------- ----------------
procedure Find_Token procedure Find_Token
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership; Test : Membership;
First : out Positive; First : out Positive;
Last : out Natural) Last : out Natural)
is is
...@@ -190,11 +187,11 @@ package body Ada.Strings.Wide_Search is ...@@ -190,11 +187,11 @@ package body Ada.Strings.Wide_Search is
----------- -----------
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural return Natural
is is
begin begin
if Pattern = "" then if Pattern = "" then
...@@ -239,16 +236,11 @@ package body Ada.Strings.Wide_Search is ...@@ -239,16 +236,11 @@ package body Ada.Strings.Wide_Search is
return 0; return 0;
end Index; end Index;
-----------
-- Index --
-----------
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Pattern : in Wide_String; Pattern : Wide_String;
Going : in Direction := Forward; Going : Direction := Forward;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
return Natural
is is
Mapped_Source : Wide_String (Source'Range); Mapped_Source : Wide_String (Source'Range);
...@@ -261,11 +253,10 @@ package body Ada.Strings.Wide_Search is ...@@ -261,11 +253,10 @@ package body Ada.Strings.Wide_Search is
end Index; end Index;
function Index function Index
(Source : in Wide_String; (Source : Wide_String;
Set : in Wide_Maps.Wide_Character_Set; Set : Wide_Maps.Wide_Character_Set;
Test : in Membership := Inside; Test : Membership := Inside;
Going : in Direction := Forward) Going : Direction := Forward) return Natural
return Natural
is is
begin begin
if Going = Forward then if Going = Forward then
...@@ -288,14 +279,92 @@ package body Ada.Strings.Wide_Search is ...@@ -288,14 +279,92 @@ package body Ada.Strings.Wide_Search is
return 0; return 0;
end Index; end Index;
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index (Source (Source'First .. From), Pattern, Backward, Mapping);
end if;
end Index;
function Index
(Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return Index
(Source (From .. Source'Last), Pattern, Forward, Mapping);
else
if From > Source'Last then
raise Index_Error;
end if;
return Index
(Source (Source'First .. From), Pattern, Backward, Mapping);
end if;
end Index;
function Index
(Source : Wide_String;
Set : Wide_Maps.Wide_Character_Set;
From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index (Source (From .. Source'Last), Set, Test, Forward);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index (Source (Source'First .. From), Set, Test, Backward);
end if;
end Index;
--------------------- ---------------------
-- Index_Non_Blank -- -- Index_Non_Blank --
--------------------- ---------------------
function Index_Non_Blank function Index_Non_Blank
(Source : in Wide_String; (Source : Wide_String;
Going : in Direction := Forward) Going : Direction := Forward) return Natural
return Natural
is is
begin begin
if Going = Forward then if Going = Forward then
...@@ -316,7 +385,30 @@ package body Ada.Strings.Wide_Search is ...@@ -316,7 +385,30 @@ package body Ada.Strings.Wide_Search is
-- Fall through if no match -- Fall through if no match
return 0; return 0;
end Index_Non_Blank;
function Index_Non_Blank
(Source : Wide_String;
From : Positive;
Going : Direction := Forward) return Natural
is
begin
if Going = Forward then
if From < Source'First then
raise Index_Error;
end if;
return
Index_Non_Blank (Source (From .. Source'Last), Forward);
else
if From > Source'Last then
raise Index_Error;
end if;
return
Index_Non_Blank (Source (Source'First .. From), Backward);
end if;
end Index_Non_Blank; end Index_Non_Blank;
end Ada.Strings.Wide_Search; end Ada.Strings.Wide_Search;
gcc/ada/a-stwise.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-1997 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,49 +43,76 @@ with Ada.Strings.Wide_Maps; ...@@ -43,49 +43,76 @@ with Ada.Strings.Wide_Maps;
private package Ada.Strings.Wide_Search is private package Ada.Strings.Wide_Search is
pragma Preelaborate (Wide_Search); pragma Preelaborate (Wide_Search);
function Index (Source : in Wide_String; function Index
Pattern : in Wide_String; (Source : Wide_String;
Going : in Direction := Forward; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping := Going : Direction := Forward;
Wide_Maps.Identity) Mapping : Wide_Maps.Wide_Character_Mapping :=
return Natural; Wide_Maps.Identity) return Natural;
function Index (Source : in Wide_String; function Index
Pattern : in Wide_String; (Source : Wide_String;
Going : in Direction := Forward; Pattern : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Going : Direction := Forward;
return Natural; Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
function Index (Source : in Wide_String; function Index
Set : in Wide_Maps.Wide_Character_Set; (Source : Wide_String;
Test : in Membership := Inside; Set : Wide_Maps.Wide_Character_Set;
Going : in Direction := Forward) Test : Membership := Inside;
return Natural; Going : Direction := Forward) return Natural;
function Index_Non_Blank (Source : in Wide_String; function Index
Going : in Direction := Forward) (Source : Wide_String;
Pattern : Wide_String;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural; return Natural;
function Count (Source : in Wide_String; function Index
Pattern : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping := Pattern : Wide_String;
Wide_Maps.Identity) From : Positive;
return Natural; Going : Direction := Forward;
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
function Count (Source : in Wide_String; function Index
Pattern : in Wide_String; (Source : Wide_String;
Mapping : in Wide_Maps.Wide_Character_Mapping_Function) Set : Wide_Maps.Wide_Character_Set;
return Natural; From : Positive;
Test : Membership := Inside;
Going : Direction := Forward) return Natural;
function Index_Non_Blank
(Source : Wide_String;
Going : Direction := Forward) return Natural;
function Count (Source : in Wide_String; function Index_Non_Blank
Set : in Wide_Maps.Wide_Character_Set) (Source : Wide_String;
From : Positive;
Going : Direction := Forward) return Natural;
function Count
(Source : Wide_String;
Pattern : Wide_String;
Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
return Natural; return Natural;
function Count
(Source : Wide_String;
Pattern : Wide_String;
Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
function Count
(Source : Wide_String;
Set : Wide_Maps.Wide_Character_Set) return Natural;
procedure Find_Token (Source : in Wide_String; procedure Find_Token
Set : in Wide_Maps.Wide_Character_Set; (Source : Wide_String;
Test : in Membership; Set : Wide_Maps.Wide_Character_Set;
First : out Positive; Test : Membership;
Last : out Natural); First : out Positive;
Last : out Natural);
end Ada.Strings.Wide_Search; end Ada.Strings.Wide_Search;
gcc/ada/a-textio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2004 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -60,7 +60,6 @@ package body Ada.Text_IO is ...@@ -60,7 +60,6 @@ package body Ada.Text_IO is
function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is
pragma Unreferenced (Control_Block); pragma Unreferenced (Control_Block);
begin begin
return new Text_AFCB; return new Text_AFCB;
end AFCB_Allocate; end AFCB_Allocate;
...@@ -118,7 +117,7 @@ package body Ada.Text_IO is ...@@ -118,7 +117,7 @@ package body Ada.Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Col (File : in File_Type) return Positive_Count is function Col (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Col; return File.Col;
...@@ -135,9 +134,9 @@ package body Ada.Text_IO is ...@@ -135,9 +134,9 @@ package body Ada.Text_IO is
procedure Create procedure Create
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode := Out_File; Mode : File_Mode := Out_File;
Name : in String := ""; Name : String := "";
Form : in String := "") Form : String := "")
is is
Dummy_File_Control_Block : Text_AFCB; Dummy_File_Control_Block : Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block); pragma Warnings (Off, Dummy_File_Control_Block);
...@@ -212,8 +211,8 @@ package body Ada.Text_IO is ...@@ -212,8 +211,8 @@ package body Ada.Text_IO is
-- End_Of_File -- -- End_Of_File --
----------------- -----------------
function End_Of_File (File : in File_Type) return Boolean is function End_Of_File (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
FIO.Check_Read_Status (AP (File)); FIO.Check_Read_Status (AP (File));
...@@ -270,7 +269,7 @@ package body Ada.Text_IO is ...@@ -270,7 +269,7 @@ package body Ada.Text_IO is
-- End_Of_Line -- -- End_Of_Line --
----------------- -----------------
function End_Of_Line (File : in File_Type) return Boolean is function End_Of_Line (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
...@@ -301,7 +300,7 @@ package body Ada.Text_IO is ...@@ -301,7 +300,7 @@ package body Ada.Text_IO is
-- End_Of_Page -- -- End_Of_Page --
----------------- -----------------
function End_Of_Page (File : in File_Type) return Boolean is function End_Of_Page (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
...@@ -357,7 +356,7 @@ package body Ada.Text_IO is ...@@ -357,7 +356,7 @@ package body Ada.Text_IO is
-- Flush -- -- Flush --
----------- -----------
procedure Flush (File : in File_Type) is procedure Flush (File : File_Type) is
begin begin
FIO.Flush (AP (File)); FIO.Flush (AP (File));
end Flush; end Flush;
...@@ -371,7 +370,7 @@ package body Ada.Text_IO is ...@@ -371,7 +370,7 @@ package body Ada.Text_IO is
-- Form -- -- Form --
---------- ----------
function Form (File : in File_Type) return String is function Form (File : File_Type) return String is
begin begin
return FIO.Form (AP (File)); return FIO.Form (AP (File));
end Form; end Form;
...@@ -381,7 +380,7 @@ package body Ada.Text_IO is ...@@ -381,7 +380,7 @@ package body Ada.Text_IO is
--------- ---------
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out Character) Item : out Character)
is is
ch : int; ch : int;
...@@ -430,7 +429,7 @@ package body Ada.Text_IO is ...@@ -430,7 +429,7 @@ package body Ada.Text_IO is
end Get; end Get;
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out String) Item : out String)
is is
ch : int; ch : int;
...@@ -489,7 +488,7 @@ package body Ada.Text_IO is ...@@ -489,7 +488,7 @@ package body Ada.Text_IO is
-- More work required here ??? -- More work required here ???
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Character) Item : out Character)
is is
ch : int; ch : int;
...@@ -530,7 +529,7 @@ package body Ada.Text_IO is ...@@ -530,7 +529,7 @@ package body Ada.Text_IO is
end Get_Immediate; end Get_Immediate;
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Character; Item : out Character;
Available : out Boolean) Available : out Boolean)
is is
...@@ -594,7 +593,7 @@ package body Ada.Text_IO is ...@@ -594,7 +593,7 @@ package body Ada.Text_IO is
-------------- --------------
procedure Get_Line procedure Get_Line
(File : in File_Type; (File : File_Type;
Item : out String; Item : out String;
Last : out Natural) Last : out Natural)
is is
...@@ -712,6 +711,58 @@ package body Ada.Text_IO is ...@@ -712,6 +711,58 @@ package body Ada.Text_IO is
Get_Line (Current_In, Item, Last); Get_Line (Current_In, Item, Last);
end Get_Line; end Get_Line;
function Get_Line (File : File_Type) return String is
Buffer : String (1 .. 500);
Last : Natural;
function Get_Rest (S : String) return String;
-- This is a recursive function that reads the rest of the line and
-- returns it. S is the part read so far.
--------------
-- Get_Rest --
--------------
function Get_Rest (S : String) return String is
-- Each time we allocate a buffer the same size as what we have
-- read so far. This limits us to a logarithmic number of calls
-- to Get_Rest and also ensures only a linear use of stack space.
Buffer : String (1 .. S'Length);
Last : Natural;
begin
Get_Line (File, Buffer, Last);
declare
R : constant String := S & Buffer (1 .. Last);
begin
if Last < Buffer'Last then
return R;
else
return Get_Rest (R);
end if;
end;
end Get_Rest;
-- Start of processing for Get_Line
begin
Get_Line (File, Buffer, Last);
if Last < Buffer'Last then
return Buffer (1 .. Last);
else
return Get_Rest (Buffer (1 .. Last));
end if;
end Get_Line;
function Get_Line return String is
begin
return Get_Line (Current_In);
end Get_Line;
---------- ----------
-- Getc -- -- Getc --
---------- ----------
...@@ -733,7 +784,7 @@ package body Ada.Text_IO is ...@@ -733,7 +784,7 @@ package body Ada.Text_IO is
-- Is_Open -- -- Is_Open --
------------- -------------
function Is_Open (File : in File_Type) return Boolean is function Is_Open (File : File_Type) return Boolean is
begin begin
return FIO.Is_Open (AP (File)); return FIO.Is_Open (AP (File));
end Is_Open; end Is_Open;
...@@ -746,7 +797,7 @@ package body Ada.Text_IO is ...@@ -746,7 +797,7 @@ package body Ada.Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Line (File : in File_Type) return Positive_Count is function Line (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Line; return File.Line;
...@@ -761,7 +812,7 @@ package body Ada.Text_IO is ...@@ -761,7 +812,7 @@ package body Ada.Text_IO is
-- Line_Length -- -- Line_Length --
----------------- -----------------
function Line_Length (File : in File_Type) return Count is function Line_Length (File : File_Type) return Count is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
return File.Line_Length; return File.Line_Length;
...@@ -777,7 +828,7 @@ package body Ada.Text_IO is ...@@ -777,7 +828,7 @@ package body Ada.Text_IO is
---------------- ----------------
procedure Look_Ahead procedure Look_Ahead
(File : in File_Type; (File : File_Type;
Item : out Character; Item : out Character;
End_Of_Line : out Boolean) End_Of_Line : out Boolean)
is is
...@@ -818,7 +869,7 @@ package body Ada.Text_IO is ...@@ -818,7 +869,7 @@ package body Ada.Text_IO is
-- Mode -- -- Mode --
---------- ----------
function Mode (File : in File_Type) return File_Mode is function Mode (File : File_Type) return File_Mode is
begin begin
return To_TIO (FIO.Mode (AP (File))); return To_TIO (FIO.Mode (AP (File)));
end Mode; end Mode;
...@@ -827,7 +878,7 @@ package body Ada.Text_IO is ...@@ -827,7 +878,7 @@ package body Ada.Text_IO is
-- Name -- -- Name --
---------- ----------
function Name (File : in File_Type) return String is function Name (File : File_Type) return String is
begin begin
return FIO.Name (AP (File)); return FIO.Name (AP (File));
end Name; end Name;
...@@ -837,8 +888,8 @@ package body Ada.Text_IO is ...@@ -837,8 +888,8 @@ package body Ada.Text_IO is
-------------- --------------
procedure New_Line procedure New_Line
(File : in File_Type; (File : File_Type;
Spacing : in Positive_Count := 1) Spacing : Positive_Count := 1)
is is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
...@@ -867,7 +918,7 @@ package body Ada.Text_IO is ...@@ -867,7 +918,7 @@ package body Ada.Text_IO is
File.Col := 1; File.Col := 1;
end New_Line; end New_Line;
procedure New_Line (Spacing : in Positive_Count := 1) is procedure New_Line (Spacing : Positive_Count := 1) is
begin begin
New_Line (Current_Out, Spacing); New_Line (Current_Out, Spacing);
end New_Line; end New_Line;
...@@ -876,7 +927,7 @@ package body Ada.Text_IO is ...@@ -876,7 +927,7 @@ package body Ada.Text_IO is
-- New_Page -- -- New_Page --
-------------- --------------
procedure New_Page (File : in File_Type) is procedure New_Page (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
...@@ -925,9 +976,9 @@ package body Ada.Text_IO is ...@@ -925,9 +976,9 @@ package body Ada.Text_IO is
procedure Open procedure Open
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode; Mode : File_Mode;
Name : in String; Name : String;
Form : in String := "") Form : String := "")
is is
Dummy_File_Control_Block : Text_AFCB; Dummy_File_Control_Block : Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block); pragma Warnings (Off, Dummy_File_Control_Block);
...@@ -955,7 +1006,7 @@ package body Ada.Text_IO is ...@@ -955,7 +1006,7 @@ package body Ada.Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Page (File : in File_Type) return Positive_Count is function Page (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Page; return File.Page;
...@@ -970,7 +1021,7 @@ package body Ada.Text_IO is ...@@ -970,7 +1021,7 @@ package body Ada.Text_IO is
-- Page_Length -- -- Page_Length --
----------------- -----------------
function Page_Length (File : in File_Type) return Count is function Page_Length (File : File_Type) return Count is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
return File.Page_Length; return File.Page_Length;
...@@ -986,8 +1037,8 @@ package body Ada.Text_IO is ...@@ -986,8 +1037,8 @@ package body Ada.Text_IO is
--------- ---------
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in Character) Item : Character)
is is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
...@@ -1003,7 +1054,7 @@ package body Ada.Text_IO is ...@@ -1003,7 +1054,7 @@ package body Ada.Text_IO is
File.Col := File.Col + 1; File.Col := File.Col + 1;
end Put; end Put;
procedure Put (Item : in Character) is procedure Put (Item : Character) is
begin begin
FIO.Check_Write_Status (AP (Current_Out)); FIO.Check_Write_Status (AP (Current_Out));
...@@ -1025,8 +1076,8 @@ package body Ada.Text_IO is ...@@ -1025,8 +1076,8 @@ package body Ada.Text_IO is
--------- ---------
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in String) Item : String)
is is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
...@@ -1052,7 +1103,7 @@ package body Ada.Text_IO is ...@@ -1052,7 +1103,7 @@ package body Ada.Text_IO is
end if; end if;
end Put; end Put;
procedure Put (Item : in String) is procedure Put (Item : String) is
begin begin
Put (Current_Out, Item); Put (Current_Out, Item);
end Put; end Put;
...@@ -1062,8 +1113,8 @@ package body Ada.Text_IO is ...@@ -1062,8 +1113,8 @@ package body Ada.Text_IO is
-------------- --------------
procedure Put_Line procedure Put_Line
(File : in File_Type; (File : File_Type;
Item : in String) Item : String)
is is
Ilen : Natural := Item'Length; Ilen : Natural := Item'Length;
Istart : Natural := Item'First; Istart : Natural := Item'First;
...@@ -1127,7 +1178,7 @@ package body Ada.Text_IO is ...@@ -1127,7 +1178,7 @@ package body Ada.Text_IO is
end; end;
end Put_Line; end Put_Line;
procedure Put_Line (Item : in String) is procedure Put_Line (Item : String) is
begin begin
Put_Line (Current_Out, Item); Put_Line (Current_Out, Item);
end Put_Line; end Put_Line;
...@@ -1231,7 +1282,7 @@ package body Ada.Text_IO is ...@@ -1231,7 +1282,7 @@ package body Ada.Text_IO is
procedure Reset procedure Reset
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode) Mode : File_Mode)
is is
begin begin
-- Don't allow change of mode for current file (RM A.10.2(5)) -- Don't allow change of mode for current file (RM A.10.2(5))
...@@ -1273,8 +1324,8 @@ package body Ada.Text_IO is ...@@ -1273,8 +1324,8 @@ package body Ada.Text_IO is
------------- -------------
procedure Set_Col procedure Set_Col
(File : in File_Type; (File : File_Type;
To : in Positive_Count) To : Positive_Count)
is is
ch : int; ch : int;
...@@ -1333,7 +1384,7 @@ package body Ada.Text_IO is ...@@ -1333,7 +1384,7 @@ package body Ada.Text_IO is
end if; end if;
end Set_Col; end Set_Col;
procedure Set_Col (To : in Positive_Count) is procedure Set_Col (To : Positive_Count) is
begin begin
Set_Col (Current_Out, To); Set_Col (Current_Out, To);
end Set_Col; end Set_Col;
...@@ -1342,7 +1393,7 @@ package body Ada.Text_IO is ...@@ -1342,7 +1393,7 @@ package body Ada.Text_IO is
-- Set_Error -- -- Set_Error --
--------------- ---------------
procedure Set_Error (File : in File_Type) is procedure Set_Error (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
Current_Err := File; Current_Err := File;
...@@ -1352,7 +1403,7 @@ package body Ada.Text_IO is ...@@ -1352,7 +1403,7 @@ package body Ada.Text_IO is
-- Set_Input -- -- Set_Input --
--------------- ---------------
procedure Set_Input (File : in File_Type) is procedure Set_Input (File : File_Type) is
begin begin
FIO.Check_Read_Status (AP (File)); FIO.Check_Read_Status (AP (File));
Current_In := File; Current_In := File;
...@@ -1363,8 +1414,8 @@ package body Ada.Text_IO is ...@@ -1363,8 +1414,8 @@ package body Ada.Text_IO is
-------------- --------------
procedure Set_Line procedure Set_Line
(File : in File_Type; (File : File_Type;
To : in Positive_Count) To : Positive_Count)
is is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
...@@ -1401,7 +1452,7 @@ package body Ada.Text_IO is ...@@ -1401,7 +1452,7 @@ package body Ada.Text_IO is
end if; end if;
end Set_Line; end Set_Line;
procedure Set_Line (To : in Positive_Count) is procedure Set_Line (To : Positive_Count) is
begin begin
Set_Line (Current_Out, To); Set_Line (Current_Out, To);
end Set_Line; end Set_Line;
...@@ -1410,7 +1461,7 @@ package body Ada.Text_IO is ...@@ -1410,7 +1461,7 @@ package body Ada.Text_IO is
-- Set_Line_Length -- -- Set_Line_Length --
--------------------- ---------------------
procedure Set_Line_Length (File : in File_Type; To : in Count) is procedure Set_Line_Length (File : File_Type; To : Count) is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
-- explicit test is that we don't want junk values around, even if -- explicit test is that we don't want junk values around, even if
...@@ -1424,7 +1475,7 @@ package body Ada.Text_IO is ...@@ -1424,7 +1475,7 @@ package body Ada.Text_IO is
File.Line_Length := To; File.Line_Length := To;
end Set_Line_Length; end Set_Line_Length;
procedure Set_Line_Length (To : in Count) is procedure Set_Line_Length (To : Count) is
begin begin
Set_Line_Length (Current_Out, To); Set_Line_Length (Current_Out, To);
end Set_Line_Length; end Set_Line_Length;
...@@ -1433,7 +1484,7 @@ package body Ada.Text_IO is ...@@ -1433,7 +1484,7 @@ package body Ada.Text_IO is
-- Set_Output -- -- Set_Output --
---------------- ----------------
procedure Set_Output (File : in File_Type) is procedure Set_Output (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
Current_Out := File; Current_Out := File;
...@@ -1443,7 +1494,7 @@ package body Ada.Text_IO is ...@@ -1443,7 +1494,7 @@ package body Ada.Text_IO is
-- Set_Page_Length -- -- Set_Page_Length --
--------------------- ---------------------
procedure Set_Page_Length (File : in File_Type; To : in Count) is procedure Set_Page_Length (File : File_Type; To : Count) is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
-- explicit test is that we don't want junk values around, even if -- explicit test is that we don't want junk values around, even if
...@@ -1457,7 +1508,7 @@ package body Ada.Text_IO is ...@@ -1457,7 +1508,7 @@ package body Ada.Text_IO is
File.Page_Length := To; File.Page_Length := To;
end Set_Page_Length; end Set_Page_Length;
procedure Set_Page_Length (To : in Count) is procedure Set_Page_Length (To : Count) is
begin begin
Set_Page_Length (Current_Out, To); Set_Page_Length (Current_Out, To);
end Set_Page_Length; end Set_Page_Length;
...@@ -1467,8 +1518,8 @@ package body Ada.Text_IO is ...@@ -1467,8 +1518,8 @@ package body Ada.Text_IO is
--------------- ---------------
procedure Skip_Line procedure Skip_Line
(File : in File_Type; (File : File_Type;
Spacing : in Positive_Count := 1) Spacing : Positive_Count := 1)
is is
ch : int; ch : int;
...@@ -1548,7 +1599,7 @@ package body Ada.Text_IO is ...@@ -1548,7 +1599,7 @@ package body Ada.Text_IO is
end loop; end loop;
end Skip_Line; end Skip_Line;
procedure Skip_Line (Spacing : in Positive_Count := 1) is procedure Skip_Line (Spacing : Positive_Count := 1) is
begin begin
Skip_Line (Current_In, Spacing); Skip_Line (Current_In, Spacing);
end Skip_Line; end Skip_Line;
...@@ -1557,7 +1608,7 @@ package body Ada.Text_IO is ...@@ -1557,7 +1608,7 @@ package body Ada.Text_IO is
-- Skip_Page -- -- Skip_Page --
--------------- ---------------
procedure Skip_Page (File : in File_Type) is procedure Skip_Page (File : File_Type) is
ch : int; ch : int;
begin begin
...@@ -1712,7 +1763,7 @@ package body Ada.Text_IO is ...@@ -1712,7 +1763,7 @@ package body Ada.Text_IO is
procedure Write procedure Write
(File : in out Text_AFCB; (File : in out Text_AFCB;
Item : in Stream_Element_Array) Item : Stream_Element_Array)
is is
function Has_Translated_Characters return Boolean; function Has_Translated_Characters return Boolean;
......
gcc/ada/a-textio.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -86,34 +86,34 @@ pragma Elaborate_Body (Text_IO); ...@@ -86,34 +86,34 @@ pragma Elaborate_Body (Text_IO);
procedure Create procedure Create
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode := Out_File; Mode : File_Mode := Out_File;
Name : in String := ""; Name : String := "";
Form : in String := ""); Form : String := "");
procedure Open procedure Open
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode; Mode : File_Mode;
Name : in String; Name : String;
Form : in String := ""); Form : String := "");
procedure Close (File : in out File_Type); procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type); procedure Delete (File : in out File_Type);
procedure Reset (File : in out File_Type; Mode : in File_Mode); procedure Reset (File : in out File_Type; Mode : File_Mode);
procedure Reset (File : in out File_Type); procedure Reset (File : in out File_Type);
function Mode (File : in File_Type) return File_Mode; function Mode (File : File_Type) return File_Mode;
function Name (File : in File_Type) return String; function Name (File : File_Type) return String;
function Form (File : in File_Type) return String; function Form (File : File_Type) return String;
function Is_Open (File : in File_Type) return Boolean; function Is_Open (File : File_Type) return Boolean;
------------------------------------------------------ ------------------------------------------------------
-- Control of default input, output and error files -- -- Control of default input, output and error files --
------------------------------------------------------ ------------------------------------------------------
procedure Set_Input (File : in File_Type); procedure Set_Input (File : File_Type);
procedure Set_Output (File : in File_Type); procedure Set_Output (File : File_Type);
procedure Set_Error (File : in File_Type); procedure Set_Error (File : File_Type);
function Standard_Input return File_Type; function Standard_Input return File_Type;
function Standard_Output return File_Type; function Standard_Output return File_Type;
...@@ -140,76 +140,76 @@ pragma Elaborate_Body (Text_IO); ...@@ -140,76 +140,76 @@ pragma Elaborate_Body (Text_IO);
-- Note: The parameter file is IN OUT in the RM, but this is clearly -- Note: The parameter file is IN OUT in the RM, but this is clearly
-- an oversight, and was intended to be IN, see AI95-00057. -- an oversight, and was intended to be IN, see AI95-00057.
procedure Flush (File : in File_Type); procedure Flush (File : File_Type);
procedure Flush; procedure Flush;
-------------------------------------------- --------------------------------------------
-- Specification of line and page lengths -- -- Specification of line and page lengths --
-------------------------------------------- --------------------------------------------
procedure Set_Line_Length (File : in File_Type; To : in Count); procedure Set_Line_Length (File : File_Type; To : Count);
procedure Set_Line_Length (To : in Count); procedure Set_Line_Length (To : Count);
procedure Set_Page_Length (File : in File_Type; To : in Count); procedure Set_Page_Length (File : File_Type; To : Count);
procedure Set_Page_Length (To : in Count); procedure Set_Page_Length (To : Count);
function Line_Length (File : in File_Type) return Count; function Line_Length (File : File_Type) return Count;
function Line_Length return Count; function Line_Length return Count;
function Page_Length (File : in File_Type) return Count; function Page_Length (File : File_Type) return Count;
function Page_Length return Count; function Page_Length return Count;
------------------------------------ ------------------------------------
-- Column, Line, and Page Control -- -- Column, Line, and Page Control --
------------------------------------ ------------------------------------
procedure New_Line (File : in File_Type; Spacing : in Positive_Count := 1); procedure New_Line (File : File_Type; Spacing : Positive_Count := 1);
procedure New_Line (Spacing : in Positive_Count := 1); procedure New_Line (Spacing : Positive_Count := 1);
procedure Skip_Line (File : in File_Type; Spacing : in Positive_Count := 1); procedure Skip_Line (File : File_Type; Spacing : Positive_Count := 1);
procedure Skip_Line (Spacing : in Positive_Count := 1); procedure Skip_Line (Spacing : Positive_Count := 1);
function End_Of_Line (File : in File_Type) return Boolean; function End_Of_Line (File : File_Type) return Boolean;
function End_Of_Line return Boolean; function End_Of_Line return Boolean;
procedure New_Page (File : in File_Type); procedure New_Page (File : File_Type);
procedure New_Page; procedure New_Page;
procedure Skip_Page (File : in File_Type); procedure Skip_Page (File : File_Type);
procedure Skip_Page; procedure Skip_Page;
function End_Of_Page (File : in File_Type) return Boolean; function End_Of_Page (File : File_Type) return Boolean;
function End_Of_Page return Boolean; function End_Of_Page return Boolean;
function End_Of_File (File : in File_Type) return Boolean; function End_Of_File (File : File_Type) return Boolean;
function End_Of_File return Boolean; function End_Of_File return Boolean;
procedure Set_Col (File : in File_Type; To : in Positive_Count); procedure Set_Col (File : File_Type; To : Positive_Count);
procedure Set_Col (To : in Positive_Count); procedure Set_Col (To : Positive_Count);
procedure Set_Line (File : in File_Type; To : in Positive_Count); procedure Set_Line (File : File_Type; To : Positive_Count);
procedure Set_Line (To : in Positive_Count); procedure Set_Line (To : Positive_Count);
function Col (File : in File_Type) return Positive_Count; function Col (File : File_Type) return Positive_Count;
function Col return Positive_Count; function Col return Positive_Count;
function Line (File : in File_Type) return Positive_Count; function Line (File : File_Type) return Positive_Count;
function Line return Positive_Count; function Line return Positive_Count;
function Page (File : in File_Type) return Positive_Count; function Page (File : File_Type) return Positive_Count;
function Page return Positive_Count; function Page return Positive_Count;
---------------------------- ----------------------------
-- Character Input-Output -- -- Character Input-Output --
---------------------------- ----------------------------
procedure Get (File : in File_Type; Item : out Character); procedure Get (File : File_Type; Item : out Character);
procedure Get (Item : out Character); procedure Get (Item : out Character);
procedure Put (File : in File_Type; Item : in Character); procedure Put (File : File_Type; Item : Character);
procedure Put (Item : in Character); procedure Put (Item : Character);
procedure Look_Ahead procedure Look_Ahead
(File : in File_Type; (File : File_Type;
Item : out Character; Item : out Character;
End_Of_Line : out Boolean); End_Of_Line : out Boolean);
...@@ -218,14 +218,14 @@ pragma Elaborate_Body (Text_IO); ...@@ -218,14 +218,14 @@ pragma Elaborate_Body (Text_IO);
End_Of_Line : out Boolean); End_Of_Line : out Boolean);
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Character); Item : out Character);
procedure Get_Immediate procedure Get_Immediate
(Item : out Character); (Item : out Character);
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Character; Item : out Character;
Available : out Boolean); Available : out Boolean);
...@@ -237,13 +237,13 @@ pragma Elaborate_Body (Text_IO); ...@@ -237,13 +237,13 @@ pragma Elaborate_Body (Text_IO);
-- String Input-Output -- -- String Input-Output --
------------------------- -------------------------
procedure Get (File : in File_Type; Item : out String); procedure Get (File : File_Type; Item : out String);
procedure Get (Item : out String); procedure Get (Item : out String);
procedure Put (File : in File_Type; Item : in String); procedure Put (File : File_Type; Item : String);
procedure Put (Item : in String); procedure Put (Item : String);
procedure Get_Line procedure Get_Line
(File : in File_Type; (File : File_Type;
Item : out String; Item : out String;
Last : out Natural); Last : out Natural);
...@@ -251,12 +251,18 @@ pragma Elaborate_Body (Text_IO); ...@@ -251,12 +251,18 @@ pragma Elaborate_Body (Text_IO);
(Item : out String; (Item : out String;
Last : out Natural); Last : out Natural);
function Get_Line (File : File_Type) return String;
pragma Ada_05 (Get_Line);
function Get_Line return String;
pragma Ada_05 (Get_Line);
procedure Put_Line procedure Put_Line
(File : in File_Type; (File : File_Type;
Item : in String); Item : String);
procedure Put_Line procedure Put_Line
(Item : in String); (Item : String);
--------------------------------------- ---------------------------------------
-- Generic packages for Input-Output -- -- Generic packages for Input-Output --
...@@ -375,7 +381,7 @@ private ...@@ -375,7 +381,7 @@ private
procedure Write procedure Write
(File : in out Text_AFCB; (File : in out Text_AFCB;
Item : in Ada.Streams.Stream_Element_Array); Item : Ada.Streams.Stream_Element_Array);
-- Write operation used when Text_IO file is treated directly as Stream -- Write operation used when Text_IO file is treated directly as Stream
------------------------ ------------------------
......
gcc/ada/a-witeio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2003 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,6 +40,7 @@ with System.CRTL; ...@@ -40,6 +40,7 @@ with System.CRTL;
with System.File_IO; with System.File_IO;
with System.WCh_Cnv; use System.WCh_Cnv; with System.WCh_Cnv; use System.WCh_Cnv;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
with Unchecked_Conversion; with Unchecked_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -65,14 +66,13 @@ package body Ada.Wide_Text_IO is ...@@ -65,14 +66,13 @@ package body Ada.Wide_Text_IO is
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
function Getc_Immed (File : in File_Type) return int; function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in -- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return). -- Get_Immediate mode (i.e. without waiting for a line return).
function Get_Wide_Char_Immed function Get_Wide_Char_Immed
(C : Character; (C : Character;
File : File_Type) File : File_Type) return Wide_Character;
return Wide_Character;
-- This routine is identical to Get_Wide_Char, except that the reads are -- This routine is identical to Get_Wide_Char, except that the reads are
-- done in Get_Immediate mode (i.e. without waiting for a line return). -- done in Get_Immediate mode (i.e. without waiting for a line return).
...@@ -86,11 +86,9 @@ package body Ada.Wide_Text_IO is ...@@ -86,11 +86,9 @@ package body Ada.Wide_Text_IO is
------------------- -------------------
function AFCB_Allocate function AFCB_Allocate
(Control_Block : Wide_Text_AFCB) (Control_Block : Wide_Text_AFCB) return FCB.AFCB_Ptr
return FCB.AFCB_Ptr
is is
pragma Unreferenced (Control_Block); pragma Unreferenced (Control_Block);
begin begin
return new Wide_Text_AFCB; return new Wide_Text_AFCB;
end AFCB_Allocate; end AFCB_Allocate;
...@@ -148,7 +146,7 @@ package body Ada.Wide_Text_IO is ...@@ -148,7 +146,7 @@ package body Ada.Wide_Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Col (File : in File_Type) return Positive_Count is function Col (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Col; return File.Col;
...@@ -165,9 +163,9 @@ package body Ada.Wide_Text_IO is ...@@ -165,9 +163,9 @@ package body Ada.Wide_Text_IO is
procedure Create procedure Create
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode := Out_File; Mode : File_Mode := Out_File;
Name : in String := ""; Name : String := "";
Form : in String := "") Form : String := "")
is is
Dummy_File_Control_Block : Wide_Text_AFCB; Dummy_File_Control_Block : Wide_Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block); pragma Warnings (Off, Dummy_File_Control_Block);
...@@ -241,7 +239,7 @@ package body Ada.Wide_Text_IO is ...@@ -241,7 +239,7 @@ package body Ada.Wide_Text_IO is
-- End_Of_File -- -- End_Of_File --
----------------- -----------------
function End_Of_File (File : in File_Type) return Boolean is function End_Of_File (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
...@@ -302,7 +300,7 @@ package body Ada.Wide_Text_IO is ...@@ -302,7 +300,7 @@ package body Ada.Wide_Text_IO is
-- End_Of_Line -- -- End_Of_Line --
----------------- -----------------
function End_Of_Line (File : in File_Type) return Boolean is function End_Of_Line (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
...@@ -336,7 +334,7 @@ package body Ada.Wide_Text_IO is ...@@ -336,7 +334,7 @@ package body Ada.Wide_Text_IO is
-- End_Of_Page -- -- End_Of_Page --
----------------- -----------------
function End_Of_Page (File : in File_Type) return Boolean is function End_Of_Page (File : File_Type) return Boolean is
ch : int; ch : int;
begin begin
...@@ -386,7 +384,7 @@ package body Ada.Wide_Text_IO is ...@@ -386,7 +384,7 @@ package body Ada.Wide_Text_IO is
-- Flush -- -- Flush --
----------- -----------
procedure Flush (File : in File_Type) is procedure Flush (File : File_Type) is
begin begin
FIO.Flush (AP (File)); FIO.Flush (AP (File));
end Flush; end Flush;
...@@ -400,7 +398,7 @@ package body Ada.Wide_Text_IO is ...@@ -400,7 +398,7 @@ package body Ada.Wide_Text_IO is
-- Form -- -- Form --
---------- ----------
function Form (File : in File_Type) return String is function Form (File : File_Type) return String is
begin begin
return FIO.Form (AP (File)); return FIO.Form (AP (File));
end Form; end Form;
...@@ -410,7 +408,7 @@ package body Ada.Wide_Text_IO is ...@@ -410,7 +408,7 @@ package body Ada.Wide_Text_IO is
--------- ---------
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out Wide_Character) Item : out Wide_Character)
is is
C : Character; C : Character;
...@@ -434,7 +432,7 @@ package body Ada.Wide_Text_IO is ...@@ -434,7 +432,7 @@ package body Ada.Wide_Text_IO is
end Get; end Get;
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out Wide_String) Item : out Wide_String)
is is
begin begin
...@@ -453,7 +451,7 @@ package body Ada.Wide_Text_IO is ...@@ -453,7 +451,7 @@ package body Ada.Wide_Text_IO is
------------------- -------------------
procedure Get_Character procedure Get_Character
(File : in File_Type; (File : File_Type;
Item : out Character) Item : out Character)
is is
ch : int; ch : int;
...@@ -501,7 +499,7 @@ package body Ada.Wide_Text_IO is ...@@ -501,7 +499,7 @@ package body Ada.Wide_Text_IO is
------------------- -------------------
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Wide_Character) Item : out Wide_Character)
is is
ch : int; ch : int;
...@@ -537,7 +535,7 @@ package body Ada.Wide_Text_IO is ...@@ -537,7 +535,7 @@ package body Ada.Wide_Text_IO is
end Get_Immediate; end Get_Immediate;
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Wide_Character; Item : out Wide_Character;
Available : out Boolean) Available : out Boolean)
is is
...@@ -580,7 +578,7 @@ package body Ada.Wide_Text_IO is ...@@ -580,7 +578,7 @@ package body Ada.Wide_Text_IO is
-------------- --------------
procedure Get_Line procedure Get_Line
(File : in File_Type; (File : File_Type;
Item : out Wide_String; Item : out Wide_String;
Last : out Natural) Last : out Natural)
is is
...@@ -671,22 +669,78 @@ package body Ada.Wide_Text_IO is ...@@ -671,22 +669,78 @@ package body Ada.Wide_Text_IO is
Get_Line (Current_In, Item, Last); Get_Line (Current_In, Item, Last);
end Get_Line; end Get_Line;
function Get_Line (File : File_Type) return Wide_String is
Buffer : Wide_String (1 .. 500);
Last : Natural;
function Get_Rest (S : Wide_String) return Wide_String;
-- This is a recursive function that reads the rest of the line and
-- returns it. S is the part read so far.
--------------
-- Get_Rest --
--------------
function Get_Rest (S : Wide_String) return Wide_String is
-- Each time we allocate a buffer the same size as what we have
-- read so far. This limits us to a logarithmic number of calls
-- to Get_Rest and also ensures only a linear use of stack space.
Buffer : Wide_String (1 .. S'Length);
Last : Natural;
begin
Get_Line (File, Buffer, Last);
declare
R : constant Wide_String := S & Buffer (1 .. Last);
begin
if Last < Buffer'Last then
return R;
else
return Get_Rest (R);
end if;
end;
end Get_Rest;
-- Start of processing for Get_Line
begin
Get_Line (File, Buffer, Last);
if Last < Buffer'Last then
return Buffer (1 .. Last);
else
return Get_Rest (Buffer (1 .. Last));
end if;
end Get_Line;
function Get_Line return Wide_String is
begin
return Get_Line (Current_In);
end Get_Line;
------------------- -------------------
-- Get_Wide_Char -- -- Get_Wide_Char --
------------------- -------------------
function Get_Wide_Char function Get_Wide_Char
(C : Character; (C : Character;
File : File_Type) File : File_Type) return Wide_Character
return Wide_Character
is is
function In_Char return Character; function In_Char return Character;
-- Function used to obtain additional characters it the wide character -- Function used to obtain additional characters it the wide character
-- sequence is more than one character long. -- sequence is more than one character long.
function WC_In is new Char_Sequence_To_Wide_Char (In_Char);
-------------
-- In_Char --
-------------
function In_Char return Character is function In_Char return Character is
ch : constant Integer := Getc (File); ch : constant Integer := Getc (File);
begin begin
if ch = EOF then if ch = EOF then
raise End_Error; raise End_Error;
...@@ -695,7 +749,7 @@ package body Ada.Wide_Text_IO is ...@@ -695,7 +749,7 @@ package body Ada.Wide_Text_IO is
end if; end if;
end In_Char; end In_Char;
function WC_In is new Char_Sequence_To_Wide_Char (In_Char); -- Start of processing for In_Char
begin begin
return WC_In (C, File.WC_Method); return WC_In (C, File.WC_Method);
...@@ -707,16 +761,20 @@ package body Ada.Wide_Text_IO is ...@@ -707,16 +761,20 @@ package body Ada.Wide_Text_IO is
function Get_Wide_Char_Immed function Get_Wide_Char_Immed
(C : Character; (C : Character;
File : File_Type) File : File_Type) return Wide_Character
return Wide_Character
is is
function In_Char return Character; function In_Char return Character;
-- Function used to obtain additional characters it the wide character -- Function used to obtain additional characters it the wide character
-- sequence is more than one character long. -- sequence is more than one character long.
function WC_In is new Char_Sequence_To_Wide_Char (In_Char);
-------------
-- In_Char --
-------------
function In_Char return Character is function In_Char return Character is
ch : constant Integer := Getc_Immed (File); ch : constant Integer := Getc_Immed (File);
begin begin
if ch = EOF then if ch = EOF then
raise End_Error; raise End_Error;
...@@ -725,7 +783,7 @@ package body Ada.Wide_Text_IO is ...@@ -725,7 +783,7 @@ package body Ada.Wide_Text_IO is
end if; end if;
end In_Char; end In_Char;
function WC_In is new Char_Sequence_To_Wide_Char (In_Char); -- Start of processing for Get_Wide_Char_Immed
begin begin
return WC_In (C, File.WC_Method); return WC_In (C, File.WC_Method);
...@@ -752,7 +810,7 @@ package body Ada.Wide_Text_IO is ...@@ -752,7 +810,7 @@ package body Ada.Wide_Text_IO is
-- Getc_Immed -- -- Getc_Immed --
---------------- ----------------
function Getc_Immed (File : in File_Type) return int is function Getc_Immed (File : File_Type) return int is
ch : int; ch : int;
end_of_file : int; end_of_file : int;
...@@ -785,7 +843,7 @@ package body Ada.Wide_Text_IO is ...@@ -785,7 +843,7 @@ package body Ada.Wide_Text_IO is
-- Is_Open -- -- Is_Open --
------------- -------------
function Is_Open (File : in File_Type) return Boolean is function Is_Open (File : File_Type) return Boolean is
begin begin
return FIO.Is_Open (AP (File)); return FIO.Is_Open (AP (File));
end Is_Open; end Is_Open;
...@@ -798,7 +856,7 @@ package body Ada.Wide_Text_IO is ...@@ -798,7 +856,7 @@ package body Ada.Wide_Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Line (File : in File_Type) return Positive_Count is function Line (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Line; return File.Line;
...@@ -813,7 +871,7 @@ package body Ada.Wide_Text_IO is ...@@ -813,7 +871,7 @@ package body Ada.Wide_Text_IO is
-- Line_Length -- -- Line_Length --
----------------- -----------------
function Line_Length (File : in File_Type) return Count is function Line_Length (File : File_Type) return Count is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
return File.Line_Length; return File.Line_Length;
...@@ -829,7 +887,7 @@ package body Ada.Wide_Text_IO is ...@@ -829,7 +887,7 @@ package body Ada.Wide_Text_IO is
---------------- ----------------
procedure Look_Ahead procedure Look_Ahead
(File : in File_Type; (File : File_Type;
Item : out Wide_Character; Item : out Wide_Character;
End_Of_Line : out Boolean) End_Of_Line : out Boolean)
is is
...@@ -902,7 +960,7 @@ package body Ada.Wide_Text_IO is ...@@ -902,7 +960,7 @@ package body Ada.Wide_Text_IO is
-- Mode -- -- Mode --
---------- ----------
function Mode (File : in File_Type) return File_Mode is function Mode (File : File_Type) return File_Mode is
begin begin
return To_TIO (FIO.Mode (AP (File))); return To_TIO (FIO.Mode (AP (File)));
end Mode; end Mode;
...@@ -911,7 +969,7 @@ package body Ada.Wide_Text_IO is ...@@ -911,7 +969,7 @@ package body Ada.Wide_Text_IO is
-- Name -- -- Name --
---------- ----------
function Name (File : in File_Type) return String is function Name (File : File_Type) return String is
begin begin
return FIO.Name (AP (File)); return FIO.Name (AP (File));
end Name; end Name;
...@@ -921,8 +979,8 @@ package body Ada.Wide_Text_IO is ...@@ -921,8 +979,8 @@ package body Ada.Wide_Text_IO is
-------------- --------------
procedure New_Line procedure New_Line
(File : in File_Type; (File : File_Type;
Spacing : in Positive_Count := 1) Spacing : Positive_Count := 1)
is is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
...@@ -951,7 +1009,7 @@ package body Ada.Wide_Text_IO is ...@@ -951,7 +1009,7 @@ package body Ada.Wide_Text_IO is
File.Col := 1; File.Col := 1;
end New_Line; end New_Line;
procedure New_Line (Spacing : in Positive_Count := 1) is procedure New_Line (Spacing : Positive_Count := 1) is
begin begin
New_Line (Current_Out, Spacing); New_Line (Current_Out, Spacing);
end New_Line; end New_Line;
...@@ -960,7 +1018,7 @@ package body Ada.Wide_Text_IO is ...@@ -960,7 +1018,7 @@ package body Ada.Wide_Text_IO is
-- New_Page -- -- New_Page --
-------------- --------------
procedure New_Page (File : in File_Type) is procedure New_Page (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
...@@ -1009,9 +1067,9 @@ package body Ada.Wide_Text_IO is ...@@ -1009,9 +1067,9 @@ package body Ada.Wide_Text_IO is
procedure Open procedure Open
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode; Mode : File_Mode;
Name : in String; Name : String;
Form : in String := "") Form : String := "")
is is
Dummy_File_Control_Block : Wide_Text_AFCB; Dummy_File_Control_Block : Wide_Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block); pragma Warnings (Off, Dummy_File_Control_Block);
...@@ -1038,7 +1096,7 @@ package body Ada.Wide_Text_IO is ...@@ -1038,7 +1096,7 @@ package body Ada.Wide_Text_IO is
-- to exceed the value of Count'Last, i.e. no check is required for -- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error. -- overflow raising layout error.
function Page (File : in File_Type) return Positive_Count is function Page (File : File_Type) return Positive_Count is
begin begin
FIO.Check_File_Open (AP (File)); FIO.Check_File_Open (AP (File));
return File.Page; return File.Page;
...@@ -1053,7 +1111,7 @@ package body Ada.Wide_Text_IO is ...@@ -1053,7 +1111,7 @@ package body Ada.Wide_Text_IO is
-- Page_Length -- -- Page_Length --
----------------- -----------------
function Page_Length (File : in File_Type) return Count is function Page_Length (File : File_Type) return Count is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
return File.Page_Length; return File.Page_Length;
...@@ -1069,25 +1127,30 @@ package body Ada.Wide_Text_IO is ...@@ -1069,25 +1127,30 @@ package body Ada.Wide_Text_IO is
--------- ---------
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in Wide_Character) Item : Wide_Character)
is is
procedure Out_Char (C : Character); procedure Out_Char (C : Character);
-- Procedure to output one character of a wide character sequence -- Procedure to output one character of a wide character sequence
procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char);
--------------
-- Out_Char --
--------------
procedure Out_Char (C : Character) is procedure Out_Char (C : Character) is
begin begin
Putc (Character'Pos (C), File); Putc (Character'Pos (C), File);
end Out_Char; end Out_Char;
procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char); -- Start of processing for Put
begin begin
WC_Out (Item, File.WC_Method); WC_Out (Item, File.WC_Method);
File.Col := File.Col + 1; File.Col := File.Col + 1;
end Put; end Put;
procedure Put (Item : in Wide_Character) is procedure Put (Item : Wide_Character) is
begin begin
Put (Current_Out, Item); Put (Current_Out, Item);
end Put; end Put;
...@@ -1097,8 +1160,8 @@ package body Ada.Wide_Text_IO is ...@@ -1097,8 +1160,8 @@ package body Ada.Wide_Text_IO is
--------- ---------
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in Wide_String) Item : Wide_String)
is is
begin begin
for J in Item'Range loop for J in Item'Range loop
...@@ -1106,7 +1169,7 @@ package body Ada.Wide_Text_IO is ...@@ -1106,7 +1169,7 @@ package body Ada.Wide_Text_IO is
end loop; end loop;
end Put; end Put;
procedure Put (Item : in Wide_String) is procedure Put (Item : Wide_String) is
begin begin
Put (Current_Out, Item); Put (Current_Out, Item);
end Put; end Put;
...@@ -1116,15 +1179,15 @@ package body Ada.Wide_Text_IO is ...@@ -1116,15 +1179,15 @@ package body Ada.Wide_Text_IO is
-------------- --------------
procedure Put_Line procedure Put_Line
(File : in File_Type; (File : File_Type;
Item : in Wide_String) Item : Wide_String)
is is
begin begin
Put (File, Item); Put (File, Item);
New_Line (File); New_Line (File);
end Put_Line; end Put_Line;
procedure Put_Line (Item : in Wide_String) is procedure Put_Line (Item : Wide_String) is
begin begin
Put (Current_Out, Item); Put (Current_Out, Item);
New_Line (Current_Out); New_Line (Current_Out);
...@@ -1231,7 +1294,7 @@ package body Ada.Wide_Text_IO is ...@@ -1231,7 +1294,7 @@ package body Ada.Wide_Text_IO is
procedure Reset procedure Reset
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode) Mode : File_Mode)
is is
begin begin
-- Don't allow change of mode for current file (RM A.10.2(5)) -- Don't allow change of mode for current file (RM A.10.2(5))
...@@ -1273,8 +1336,8 @@ package body Ada.Wide_Text_IO is ...@@ -1273,8 +1336,8 @@ package body Ada.Wide_Text_IO is
------------- -------------
procedure Set_Col procedure Set_Col
(File : in File_Type; (File : File_Type;
To : in Positive_Count) To : Positive_Count)
is is
ch : int; ch : int;
...@@ -1333,7 +1396,7 @@ package body Ada.Wide_Text_IO is ...@@ -1333,7 +1396,7 @@ package body Ada.Wide_Text_IO is
end if; end if;
end Set_Col; end Set_Col;
procedure Set_Col (To : in Positive_Count) is procedure Set_Col (To : Positive_Count) is
begin begin
Set_Col (Current_Out, To); Set_Col (Current_Out, To);
end Set_Col; end Set_Col;
...@@ -1342,7 +1405,7 @@ package body Ada.Wide_Text_IO is ...@@ -1342,7 +1405,7 @@ package body Ada.Wide_Text_IO is
-- Set_Error -- -- Set_Error --
--------------- ---------------
procedure Set_Error (File : in File_Type) is procedure Set_Error (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
Current_Err := File; Current_Err := File;
...@@ -1352,7 +1415,7 @@ package body Ada.Wide_Text_IO is ...@@ -1352,7 +1415,7 @@ package body Ada.Wide_Text_IO is
-- Set_Input -- -- Set_Input --
--------------- ---------------
procedure Set_Input (File : in File_Type) is procedure Set_Input (File : File_Type) is
begin begin
FIO.Check_Read_Status (AP (File)); FIO.Check_Read_Status (AP (File));
Current_In := File; Current_In := File;
...@@ -1363,8 +1426,8 @@ package body Ada.Wide_Text_IO is ...@@ -1363,8 +1426,8 @@ package body Ada.Wide_Text_IO is
-------------- --------------
procedure Set_Line procedure Set_Line
(File : in File_Type; (File : File_Type;
To : in Positive_Count) To : Positive_Count)
is is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
...@@ -1401,7 +1464,7 @@ package body Ada.Wide_Text_IO is ...@@ -1401,7 +1464,7 @@ package body Ada.Wide_Text_IO is
end if; end if;
end Set_Line; end Set_Line;
procedure Set_Line (To : in Positive_Count) is procedure Set_Line (To : Positive_Count) is
begin begin
Set_Line (Current_Out, To); Set_Line (Current_Out, To);
end Set_Line; end Set_Line;
...@@ -1410,7 +1473,7 @@ package body Ada.Wide_Text_IO is ...@@ -1410,7 +1473,7 @@ package body Ada.Wide_Text_IO is
-- Set_Line_Length -- -- Set_Line_Length --
--------------------- ---------------------
procedure Set_Line_Length (File : in File_Type; To : in Count) is procedure Set_Line_Length (File : File_Type; To : Count) is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
-- explicit test is that we don't want junk values around, even if -- explicit test is that we don't want junk values around, even if
...@@ -1424,7 +1487,7 @@ package body Ada.Wide_Text_IO is ...@@ -1424,7 +1487,7 @@ package body Ada.Wide_Text_IO is
File.Line_Length := To; File.Line_Length := To;
end Set_Line_Length; end Set_Line_Length;
procedure Set_Line_Length (To : in Count) is procedure Set_Line_Length (To : Count) is
begin begin
Set_Line_Length (Current_Out, To); Set_Line_Length (Current_Out, To);
end Set_Line_Length; end Set_Line_Length;
...@@ -1433,7 +1496,7 @@ package body Ada.Wide_Text_IO is ...@@ -1433,7 +1496,7 @@ package body Ada.Wide_Text_IO is
-- Set_Output -- -- Set_Output --
---------------- ----------------
procedure Set_Output (File : in File_Type) is procedure Set_Output (File : File_Type) is
begin begin
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
Current_Out := File; Current_Out := File;
...@@ -1443,7 +1506,7 @@ package body Ada.Wide_Text_IO is ...@@ -1443,7 +1506,7 @@ package body Ada.Wide_Text_IO is
-- Set_Page_Length -- -- Set_Page_Length --
--------------------- ---------------------
procedure Set_Page_Length (File : in File_Type; To : in Count) is procedure Set_Page_Length (File : File_Type; To : Count) is
begin begin
-- Raise Constraint_Error if out of range value. The reason for this -- Raise Constraint_Error if out of range value. The reason for this
-- explicit test is that we don't want junk values around, even if -- explicit test is that we don't want junk values around, even if
...@@ -1457,7 +1520,7 @@ package body Ada.Wide_Text_IO is ...@@ -1457,7 +1520,7 @@ package body Ada.Wide_Text_IO is
File.Page_Length := To; File.Page_Length := To;
end Set_Page_Length; end Set_Page_Length;
procedure Set_Page_Length (To : in Count) is procedure Set_Page_Length (To : Count) is
begin begin
Set_Page_Length (Current_Out, To); Set_Page_Length (Current_Out, To);
end Set_Page_Length; end Set_Page_Length;
...@@ -1497,8 +1560,8 @@ package body Ada.Wide_Text_IO is ...@@ -1497,8 +1560,8 @@ package body Ada.Wide_Text_IO is
--------------- ---------------
procedure Skip_Line procedure Skip_Line
(File : in File_Type; (File : File_Type;
Spacing : in Positive_Count := 1) Spacing : Positive_Count := 1)
is is
ch : int; ch : int;
...@@ -1580,7 +1643,7 @@ package body Ada.Wide_Text_IO is ...@@ -1580,7 +1643,7 @@ package body Ada.Wide_Text_IO is
File.Before_Wide_Character := False; File.Before_Wide_Character := False;
end Skip_Line; end Skip_Line;
procedure Skip_Line (Spacing : in Positive_Count := 1) is procedure Skip_Line (Spacing : Positive_Count := 1) is
begin begin
Skip_Line (Current_In, Spacing); Skip_Line (Current_In, Spacing);
end Skip_Line; end Skip_Line;
...@@ -1589,7 +1652,7 @@ package body Ada.Wide_Text_IO is ...@@ -1589,7 +1652,7 @@ package body Ada.Wide_Text_IO is
-- Skip_Page -- -- Skip_Page --
--------------- ---------------
procedure Skip_Page (File : in File_Type) is procedure Skip_Page (File : File_Type) is
ch : int; ch : int;
begin begin
...@@ -1741,7 +1804,7 @@ package body Ada.Wide_Text_IO is ...@@ -1741,7 +1804,7 @@ package body Ada.Wide_Text_IO is
procedure Write procedure Write
(File : in out Wide_Text_AFCB; (File : in out Wide_Text_AFCB;
Item : in Stream_Element_Array) Item : Stream_Element_Array)
is is
Siz : constant size_t := Item'Length; Siz : constant size_t := Item'Length;
......
gcc/ada/a-witeio.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2000 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -89,34 +89,34 @@ package Ada.Wide_Text_IO is ...@@ -89,34 +89,34 @@ package Ada.Wide_Text_IO is
procedure Create procedure Create
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode := Out_File; Mode : File_Mode := Out_File;
Name : in String := ""; Name : String := "";
Form : in String := ""); Form : String := "");
procedure Open procedure Open
(File : in out File_Type; (File : in out File_Type;
Mode : in File_Mode; Mode : File_Mode;
Name : in String; Name : String;
Form : in String := ""); Form : String := "");
procedure Close (File : in out File_Type); procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type); procedure Delete (File : in out File_Type);
procedure Reset (File : in out File_Type; Mode : in File_Mode); procedure Reset (File : in out File_Type; Mode : File_Mode);
procedure Reset (File : in out File_Type); procedure Reset (File : in out File_Type);
function Mode (File : in File_Type) return File_Mode; function Mode (File : File_Type) return File_Mode;
function Name (File : in File_Type) return String; function Name (File : File_Type) return String;
function Form (File : in File_Type) return String; function Form (File : File_Type) return String;
function Is_Open (File : in File_Type) return Boolean; function Is_Open (File : File_Type) return Boolean;
------------------------------------------------------ ------------------------------------------------------
-- Control of default input, output and error files -- -- Control of default input, output and error files --
------------------------------------------------------ ------------------------------------------------------
procedure Set_Input (File : in File_Type); procedure Set_Input (File : File_Type);
procedure Set_Output (File : in File_Type); procedure Set_Output (File : File_Type);
procedure Set_Error (File : in File_Type); procedure Set_Error (File : File_Type);
function Standard_Input return File_Type; function Standard_Input return File_Type;
function Standard_Output return File_Type; function Standard_Output return File_Type;
...@@ -143,76 +143,76 @@ package Ada.Wide_Text_IO is ...@@ -143,76 +143,76 @@ package Ada.Wide_Text_IO is
-- Note: The paramter file is in out in the RM, but as pointed out -- Note: The paramter file is in out in the RM, but as pointed out
-- in <<95-5166.a Tucker Taft 95-6-23>> this is clearly an oversight. -- in <<95-5166.a Tucker Taft 95-6-23>> this is clearly an oversight.
procedure Flush (File : in File_Type); procedure Flush (File : File_Type);
procedure Flush; procedure Flush;
-------------------------------------------- --------------------------------------------
-- Specification of line and page lengths -- -- Specification of line and page lengths --
-------------------------------------------- --------------------------------------------
procedure Set_Line_Length (File : in File_Type; To : in Count); procedure Set_Line_Length (File : File_Type; To : Count);
procedure Set_Line_Length (To : in Count); procedure Set_Line_Length (To : Count);
procedure Set_Page_Length (File : in File_Type; To : in Count); procedure Set_Page_Length (File : File_Type; To : Count);
procedure Set_Page_Length (To : in Count); procedure Set_Page_Length (To : Count);
function Line_Length (File : in File_Type) return Count; function Line_Length (File : File_Type) return Count;
function Line_Length return Count; function Line_Length return Count;
function Page_Length (File : in File_Type) return Count; function Page_Length (File : File_Type) return Count;
function Page_Length return Count; function Page_Length return Count;
------------------------------------ ------------------------------------
-- Column, Line, and Page Control -- -- Column, Line, and Page Control --
------------------------------------ ------------------------------------
procedure New_Line (File : in File_Type; Spacing : in Positive_Count := 1); procedure New_Line (File : File_Type; Spacing : Positive_Count := 1);
procedure New_Line (Spacing : in Positive_Count := 1); procedure New_Line (Spacing : Positive_Count := 1);
procedure Skip_Line (File : in File_Type; Spacing : in Positive_Count := 1); procedure Skip_Line (File : File_Type; Spacing : Positive_Count := 1);
procedure Skip_Line (Spacing : in Positive_Count := 1); procedure Skip_Line (Spacing : Positive_Count := 1);
function End_Of_Line (File : in File_Type) return Boolean; function End_Of_Line (File : File_Type) return Boolean;
function End_Of_Line return Boolean; function End_Of_Line return Boolean;
procedure New_Page (File : in File_Type); procedure New_Page (File : File_Type);
procedure New_Page; procedure New_Page;
procedure Skip_Page (File : in File_Type); procedure Skip_Page (File : File_Type);
procedure Skip_Page; procedure Skip_Page;
function End_Of_Page (File : in File_Type) return Boolean; function End_Of_Page (File : File_Type) return Boolean;
function End_Of_Page return Boolean; function End_Of_Page return Boolean;
function End_Of_File (File : in File_Type) return Boolean; function End_Of_File (File : File_Type) return Boolean;
function End_Of_File return Boolean; function End_Of_File return Boolean;
procedure Set_Col (File : in File_Type; To : in Positive_Count); procedure Set_Col (File : File_Type; To : Positive_Count);
procedure Set_Col (To : in Positive_Count); procedure Set_Col (To : Positive_Count);
procedure Set_Line (File : in File_Type; To : in Positive_Count); procedure Set_Line (File : File_Type; To : Positive_Count);
procedure Set_Line (To : in Positive_Count); procedure Set_Line (To : Positive_Count);
function Col (File : in File_Type) return Positive_Count; function Col (File : File_Type) return Positive_Count;
function Col return Positive_Count; function Col return Positive_Count;
function Line (File : in File_Type) return Positive_Count; function Line (File : File_Type) return Positive_Count;
function Line return Positive_Count; function Line return Positive_Count;
function Page (File : in File_Type) return Positive_Count; function Page (File : File_Type) return Positive_Count;
function Page return Positive_Count; function Page return Positive_Count;
---------------------------- ----------------------------
-- Character Input-Output -- -- Character Input-Output --
---------------------------- ----------------------------
procedure Get (File : in File_Type; Item : out Wide_Character); procedure Get (File : File_Type; Item : out Wide_Character);
procedure Get (Item : out Wide_Character); procedure Get (Item : out Wide_Character);
procedure Put (File : in File_Type; Item : in Wide_Character); procedure Put (File : File_Type; Item : Wide_Character);
procedure Put (Item : in Wide_Character); procedure Put (Item : Wide_Character);
procedure Look_Ahead procedure Look_Ahead
(File : in File_Type; (File : File_Type;
Item : out Wide_Character; Item : out Wide_Character;
End_Of_Line : out Boolean); End_Of_Line : out Boolean);
...@@ -221,14 +221,14 @@ package Ada.Wide_Text_IO is ...@@ -221,14 +221,14 @@ package Ada.Wide_Text_IO is
End_Of_Line : out Boolean); End_Of_Line : out Boolean);
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Wide_Character); Item : out Wide_Character);
procedure Get_Immediate procedure Get_Immediate
(Item : out Wide_Character); (Item : out Wide_Character);
procedure Get_Immediate procedure Get_Immediate
(File : in File_Type; (File : File_Type;
Item : out Wide_Character; Item : out Wide_Character;
Available : out Boolean); Available : out Boolean);
...@@ -240,13 +240,13 @@ package Ada.Wide_Text_IO is ...@@ -240,13 +240,13 @@ package Ada.Wide_Text_IO is
-- String Input-Output -- -- String Input-Output --
------------------------- -------------------------
procedure Get (File : in File_Type; Item : out Wide_String); procedure Get (File : File_Type; Item : out Wide_String);
procedure Get (Item : out Wide_String); procedure Get (Item : out Wide_String);
procedure Put (File : in File_Type; Item : in Wide_String); procedure Put (File : File_Type; Item : Wide_String);
procedure Put (Item : in Wide_String); procedure Put (Item : Wide_String);
procedure Get_Line procedure Get_Line
(File : in File_Type; (File : File_Type;
Item : out Wide_String; Item : out Wide_String;
Last : out Natural); Last : out Natural);
...@@ -254,12 +254,18 @@ package Ada.Wide_Text_IO is ...@@ -254,12 +254,18 @@ package Ada.Wide_Text_IO is
(Item : out Wide_String; (Item : out Wide_String;
Last : out Natural); Last : out Natural);
function Get_Line (File : File_Type) return Wide_String;
pragma Ada_05 (Get_Line);
function Get_Line return Wide_String;
pragma Ada_05 (Get_Line);
procedure Put_Line procedure Put_Line
(File : in File_Type; (File : File_Type;
Item : in Wide_String); Item : Wide_String);
procedure Put_Line procedure Put_Line
(Item : in Wide_String); (Item : Wide_String);
--------------------------------------- ---------------------------------------
-- Generic packages for Input-Output -- -- Generic packages for Input-Output --
...@@ -398,7 +404,7 @@ private ...@@ -398,7 +404,7 @@ private
procedure Write procedure Write
(File : in out Wide_Text_AFCB; (File : in out Wide_Text_AFCB;
Item : in Ada.Streams.Stream_Element_Array); Item : Ada.Streams.Stream_Element_Array);
-- Write operation used when Wide_Text_IO file is treated as a Stream -- Write operation used when Wide_Text_IO file is treated as a Stream
------------------------ ------------------------
...@@ -440,7 +446,7 @@ private ...@@ -440,7 +446,7 @@ private
-- occurs. The result is EOF if the end of file was read. -- occurs. The result is EOF if the end of file was read.
procedure Get_Character procedure Get_Character
(File : in File_Type; (File : File_Type;
Item : out Character); Item : out Character);
-- This is essentially a copy of the normal Get routine from Text_IO. It -- This is essentially a copy of the normal Get routine from Text_IO. It
-- obtains a single character from the input file File, and places it in -- obtains a single character from the input file File, and places it in
...@@ -449,8 +455,7 @@ private ...@@ -449,8 +455,7 @@ private
function Get_Wide_Char function Get_Wide_Char
(C : Character; (C : Character;
File : File_Type) File : File_Type) return Wide_Character;
return Wide_Character;
-- This function is shared by Get and Get_Immediate to extract a wide -- This function is shared by Get and Get_Immediate to extract a wide
-- character value from the given File. The first byte has already been -- character value from the given File. The first byte has already been
-- read and is passed in C. The wide character value is returned as the -- read and is passed in C. The wide character value is returned as the
......
gcc/ada/a-wtcoau.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,7 +45,7 @@ package body Ada.Wide_Text_IO.Complex_Aux is ...@@ -45,7 +45,7 @@ package body Ada.Wide_Text_IO.Complex_Aux is
--------- ---------
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
ItemR : out Long_Long_Float; ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float; ItemI : out Long_Long_Float;
Width : Field) Width : Field)
...@@ -96,7 +96,7 @@ package body Ada.Wide_Text_IO.Complex_Aux is ...@@ -96,7 +96,7 @@ package body Ada.Wide_Text_IO.Complex_Aux is
---------- ----------
procedure Gets procedure Gets
(From : in String; (From : String;
ItemR : out Long_Long_Float; ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float; ItemI : out Long_Long_Float;
Last : out Positive) Last : out Positive)
...@@ -163,8 +163,8 @@ package body Ada.Wide_Text_IO.Complex_Aux is ...@@ -163,8 +163,8 @@ package body Ada.Wide_Text_IO.Complex_Aux is
(To : out String; (To : out String;
ItemR : Long_Long_Float; ItemR : Long_Long_Float;
ItemI : Long_Long_Float; ItemI : Long_Long_Float;
Aft : in Field; Aft : Field;
Exp : in Field) Exp : Field)
is is
I_String : String (1 .. 3 * Field'Last); I_String : String (1 .. 3 * Field'Last);
R_String : String (1 .. 3 * Field'Last); R_String : String (1 .. 3 * Field'Last);
......
gcc/ada/a-wtcoau.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,7 +42,7 @@ ...@@ -42,7 +42,7 @@
package Ada.Wide_Text_IO.Complex_Aux is package Ada.Wide_Text_IO.Complex_Aux is
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
ItemR : out Long_Long_Float; ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float; ItemI : out Long_Long_Float;
Width : Field); Width : Field);
......
gcc/ada/a-wtcoio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Complex_Aux; with Ada.Wide_Text_IO.Complex_Aux;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS; with System.WCh_WtS; use System.WCh_WtS;
...@@ -44,9 +45,6 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -44,9 +45,6 @@ package body Ada.Wide_Text_IO.Complex_IO is
subtype LLF is Long_Long_Float; subtype LLF is Long_Long_Float;
-- Type used for calls to routines in Aux -- Type used for calls to routines in Aux
-- subtype TFT is Ada.Wide_Text_IO.File_Type;
-- File type required for calls to routines in Aux
function TFT is new function TFT is new
Ada.Unchecked_Conversion (File_Type, Ada.Wide_Text_IO.File_Type); Ada.Unchecked_Conversion (File_Type, Ada.Wide_Text_IO.File_Type);
-- This unchecked conversion is to get around a visibility bug in -- This unchecked conversion is to get around a visibility bug in
...@@ -58,12 +56,12 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -58,12 +56,12 @@ package body Ada.Wide_Text_IO.Complex_IO is
--------- ---------
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out Complex; Item : out Complex;
Width : in Field := 0) Width : Field := 0)
is is
Real_Item : Real'Base; Real_Item : Real'Base;
Imag_Item : Real'Base; Imag_Item : Real'Base;
begin begin
Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width); Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
...@@ -79,7 +77,7 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -79,7 +77,7 @@ package body Ada.Wide_Text_IO.Complex_IO is
procedure Get procedure Get
(Item : out Complex; (Item : out Complex;
Width : in Field := 0) Width : Field := 0)
is is
begin begin
Get (Current_Input, Item, Width); Get (Current_Input, Item, Width);
...@@ -90,7 +88,7 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -90,7 +88,7 @@ package body Ada.Wide_Text_IO.Complex_IO is
--------- ---------
procedure Get procedure Get
(From : in Wide_String; (From : Wide_String;
Item : out Complex; Item : out Complex;
Last : out Positive) Last : out Positive)
is is
...@@ -116,11 +114,11 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -116,11 +114,11 @@ package body Ada.Wide_Text_IO.Complex_IO is
--------- ---------
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in Complex; Item : Complex;
Fore : in Field := Default_Fore; Fore : Field := Default_Fore;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp) Exp : Field := Default_Exp)
is is
begin begin
Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp); Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
...@@ -131,10 +129,10 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -131,10 +129,10 @@ package body Ada.Wide_Text_IO.Complex_IO is
--------- ---------
procedure Put procedure Put
(Item : in Complex; (Item : Complex;
Fore : in Field := Default_Fore; Fore : Field := Default_Fore;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp) Exp : Field := Default_Exp)
is is
begin begin
Put (Current_Output, Item, Fore, Aft, Exp); Put (Current_Output, Item, Fore, Aft, Exp);
...@@ -146,9 +144,9 @@ package body Ada.Wide_Text_IO.Complex_IO is ...@@ -146,9 +144,9 @@ package body Ada.Wide_Text_IO.Complex_IO is
procedure Put procedure Put
(To : out Wide_String; (To : out Wide_String;
Item : in Complex; Item : Complex;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp) Exp : Field := Default_Exp)
is is
S : String (To'First .. To'Last); S : String (To'First .. To'Last);
......
gcc/ada/a-wtcoio.ads
...@@ -27,36 +27,36 @@ package Ada.Wide_Text_IO.Complex_IO is ...@@ -27,36 +27,36 @@ package Ada.Wide_Text_IO.Complex_IO is
Default_Exp : Field := 3; Default_Exp : Field := 3;
procedure Get procedure Get
(File : in File_Type; (File : File_Type;
Item : out Complex; Item : out Complex;
Width : in Field := 0); Width : Field := 0);
procedure Get procedure Get
(Item : out Complex; (Item : out Complex;
Width : in Field := 0); Width : Field := 0);
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : in Complex; Item : Complex;
Fore : in Field := Default_Fore; Fore : Field := Default_Fore;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp); Exp : Field := Default_Exp);
procedure Put procedure Put
(Item : in Complex; (Item : Complex;
Fore : in Field := Default_Fore; Fore : Field := Default_Fore;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp); Exp : Field := Default_Exp);
procedure Get procedure Get
(From : in Wide_String; (From : Wide_String;
Item : out Complex; Item : out Complex;
Last : out Positive); Last : out Positive);
procedure Put procedure Put
(To : out Wide_String; (To : out Wide_String;
Item : in Complex; Item : Complex;
Aft : in Field := Default_Aft; Aft : Field := Default_Aft;
Exp : in Field := Default_Exp); Exp : Field := Default_Exp);
end Ada.Wide_Text_IO.Complex_IO; end Ada.Wide_Text_IO.Complex_IO;
gcc/ada/a-wtedit.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -69,13 +69,12 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -69,13 +69,12 @@ package body Ada.Wide_Text_IO.Editing is
----------- -----------
function Image function Image
(Item : in Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark) Radix_Mark : Wide_Character := Default_Radix_Mark) return Wide_String
return Wide_String
is is
begin begin
return Format_Number return Format_Number
...@@ -88,9 +87,8 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -88,9 +87,8 @@ package body Ada.Wide_Text_IO.Editing is
------------ ------------
function Length function Length
(Pic : in Picture; (Pic : Picture;
Currency : in Wide_String := Default_Currency) Currency : Wide_String := Default_Currency) return Natural
return Natural
is is
Picstr : constant String := Pic_String (Pic); Picstr : constant String := Pic_String (Pic);
V_Adjust : Integer := 0; V_Adjust : Integer := 0;
...@@ -122,13 +120,13 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -122,13 +120,13 @@ package body Ada.Wide_Text_IO.Editing is
--------- ---------
procedure Put procedure Put
(File : in Wide_Text_IO.File_Type; (File : Wide_Text_IO.File_Type;
Item : in Num; Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark) Radix_Mark : Wide_Character := Default_Radix_Mark)
is is
begin begin
Wide_Text_IO.Put (File, Image (Item, Pic, Wide_Text_IO.Put (File, Image (Item, Pic,
...@@ -136,12 +134,12 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -136,12 +134,12 @@ package body Ada.Wide_Text_IO.Editing is
end Put; end Put;
procedure Put procedure Put
(Item : in Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark) Radix_Mark : Wide_Character := Default_Radix_Mark)
is is
begin begin
Wide_Text_IO.Put (Image (Item, Pic, Wide_Text_IO.Put (Image (Item, Pic,
...@@ -150,12 +148,12 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -150,12 +148,12 @@ package body Ada.Wide_Text_IO.Editing is
procedure Put procedure Put
(To : out Wide_String; (To : out Wide_String;
Item : in Num; Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark) Radix_Mark : Wide_Character := Default_Radix_Mark)
is is
Result : constant Wide_String := Result : constant Wide_String :=
Image (Item, Pic, Currency, Fill, Separator, Radix_Mark); Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
...@@ -175,15 +173,13 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -175,15 +173,13 @@ package body Ada.Wide_Text_IO.Editing is
function Valid function Valid
(Item : Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency) Currency : Wide_String := Default_Currency) return Boolean
return Boolean
is is
begin begin
declare declare
Temp : constant Wide_String := Image (Item, Pic, Currency); Temp : constant Wide_String := Image (Item, Pic, Currency);
pragma Warnings (Off, Temp); pragma Warnings (Off, Temp);
begin begin
return True; return True;
end; end;
...@@ -192,7 +188,6 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -192,7 +188,6 @@ package body Ada.Wide_Text_IO.Editing is
when Layout_Error => return False; when Layout_Error => return False;
end Valid; end Valid;
end Decimal_Output; end Decimal_Output;
------------ ------------
...@@ -220,11 +215,11 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -220,11 +215,11 @@ package body Ada.Wide_Text_IO.Editing is
when '(' => when '(' =>
-- We now need to scan out the count after a left paren. -- We now need to scan out the count after a left paren. In
-- In the non-wide version we used Integer_IO.Get, but -- the non-wide version we used Integer_IO.Get, but that is
-- that is not convenient here, since we don't want to -- not convenient here, since we don't want to drag in normal
-- drag in normal Text_IO just for this purpose. So we -- Text_IO just for this purpose. So we do the scan ourselves,
-- do the scan ourselves, with the normal validity checks. -- with the normal validity checks.
Last := Picture_Index + 1; Last := Picture_Index + 1;
Count := 0; Count := 0;
...@@ -262,7 +257,7 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -262,7 +257,7 @@ package body Ada.Wide_Text_IO.Editing is
end loop; end loop;
-- In what follows note that one copy of the repeated -- In what follows note that one copy of the repeated
-- character has already been made, so a count of one is a -- character has already been made, so a count of one is
-- no-op, and a count of zero erases a character. -- no-op, and a count of zero erases a character.
for J in 2 .. Count loop for J in 2 .. Count loop
...@@ -293,7 +288,6 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -293,7 +288,6 @@ package body Ada.Wide_Text_IO.Editing is
exception exception
when others => when others =>
raise Picture_Error; raise Picture_Error;
end Expand; end Expand;
------------------- -------------------
...@@ -306,8 +300,7 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -306,8 +300,7 @@ package body Ada.Wide_Text_IO.Editing is
Currency_Symbol : Wide_String; Currency_Symbol : Wide_String;
Fill_Character : Wide_Character; Fill_Character : Wide_Character;
Separator_Character : Wide_Character; Separator_Character : Wide_Character;
Radix_Point : Wide_Character) Radix_Point : Wide_Character) return Wide_String
return Wide_String
is is
Attrs : Number_Attributes := Parse_Number_String (Number); Attrs : Number_Attributes := Parse_Number_String (Number);
Position : Integer; Position : Integer;
...@@ -368,8 +361,8 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -368,8 +361,8 @@ package body Ada.Wide_Text_IO.Editing is
end loop; end loop;
-- The rounding may add a digit in front. Either the -- The rounding may add a digit in front. Either the
-- leading blank or the sign (already captured) can -- leading blank or the sign (already captured) can be
-- be overwritten. -- overwritten.
if R_Pos = 1 then if R_Pos = 1 then
Rounded (R_Pos) := '1'; Rounded (R_Pos) := '1';
...@@ -421,7 +414,7 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -421,7 +414,7 @@ package body Ada.Wide_Text_IO.Editing is
for J in reverse Last .. Answer'Last loop for J in reverse Last .. Answer'Last loop
exit when J = Pic.Radix_Position; exit when J = Pic.Radix_Position;
-- Do this test First, Separator_Character can equal Pic.Floater. -- Do this test First, Separator_Character can equal Pic.Floater
if Answer (J) = Pic.Floater then if Answer (J) = Pic.Floater then
exit; exit;
...@@ -547,7 +540,7 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -547,7 +540,7 @@ package body Ada.Wide_Text_IO.Editing is
or else or else
Pic.Floater = '-' Pic.Floater = '-'
then then
for J in Pic.End_Float .. Position loop -- May be null range. for J in Pic.End_Float .. Position loop -- May be null range
if Answer (J) = '9' then if Answer (J) = '9' then
Answer (J) := '0'; Answer (J) := '0';
...@@ -573,12 +566,12 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -573,12 +566,12 @@ package body Ada.Wide_Text_IO.Editing is
elsif Pic.Floater = '$' then elsif Pic.Floater = '$' then
for J in Pic.End_Float .. Position loop -- May be null range. for J in Pic.End_Float .. Position loop -- May be null range
if Answer (J) = '9' then if Answer (J) = '9' then
Answer (J) := '0'; Answer (J) := '0';
elsif Answer (J) = '_' then elsif Answer (J) = '_' then
Answer (J) := ' '; -- no separator before leftmost digit. Answer (J) := ' '; -- no separator before leftmost digit
elsif Answer (J) = 'b' then elsif Answer (J) = 'b' then
Answer (J) := ' '; Answer (J) := ' ';
...@@ -598,7 +591,7 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -598,7 +591,7 @@ package body Ada.Wide_Text_IO.Editing is
elsif Pic.Floater = '*' then elsif Pic.Floater = '*' then
for J in Pic.End_Float .. Position loop -- May be null range. for J in Pic.End_Float .. Position loop -- May be null range
if Answer (J) = '9' then if Answer (J) = '9' then
Answer (J) := '0'; Answer (J) := '0';
...@@ -1013,7 +1006,6 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -1013,7 +1006,6 @@ package body Ada.Wide_Text_IO.Editing is
return Answer; return Answer;
end if; end if;
end Format_Number; end Format_Number;
------------------------- -------------------------
...@@ -1094,7 +1086,6 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -1094,7 +1086,6 @@ package body Ada.Wide_Text_IO.Editing is
-- No significant (intger) digits needs a null range. -- No significant (intger) digits needs a null range.
return Answer; return Answer;
end Parse_Number_String; end Parse_Number_String;
---------------- ----------------
...@@ -2713,9 +2704,8 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -2713,9 +2704,8 @@ package body Ada.Wide_Text_IO.Editing is
---------------- ----------------
function To_Picture function To_Picture
(Pic_String : in String; (Pic_String : String;
Blank_When_Zero : in Boolean := False) Blank_When_Zero : Boolean := False) return Picture
return Picture
is is
Result : Picture; Result : Picture;
...@@ -2751,9 +2741,8 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -2751,9 +2741,8 @@ package body Ada.Wide_Text_IO.Editing is
----------- -----------
function Valid function Valid
(Pic_String : in String; (Pic_String : String;
Blank_When_Zero : in Boolean := False) Blank_When_Zero : Boolean := False) return Boolean
return Boolean
is is
begin begin
declare declare
...@@ -2777,7 +2766,6 @@ package body Ada.Wide_Text_IO.Editing is ...@@ -2777,7 +2766,6 @@ package body Ada.Wide_Text_IO.Editing is
exception exception
when others => return False; when others => return False;
end Valid; end Valid;
end Ada.Wide_Text_IO.Editing; end Ada.Wide_Text_IO.Editing;
gcc/ada/a-wtedit.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-1997 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -40,14 +40,12 @@ package Ada.Wide_Text_IO.Editing is ...@@ -40,14 +40,12 @@ package Ada.Wide_Text_IO.Editing is
type Picture is private; type Picture is private;
function Valid function Valid
(Pic_String : in String; (Pic_String : String;
Blank_When_Zero : in Boolean := False) Blank_When_Zero : Boolean := False) return Boolean;
return Boolean;
function To_Picture function To_Picture
(Pic_String : in String; (Pic_String : String;
Blank_When_Zero : in Boolean := False) Blank_When_Zero : Boolean := False) return Picture;
return Picture;
function Pic_String (Pic : in Picture) return String; function Pic_String (Pic : in Picture) return String;
function Blank_When_Zero (Pic : in Picture) return Boolean; function Blank_When_Zero (Pic : in Picture) return Boolean;
...@@ -63,62 +61,59 @@ package Ada.Wide_Text_IO.Editing is ...@@ -63,62 +61,59 @@ package Ada.Wide_Text_IO.Editing is
generic generic
type Num is delta <> digits <>; type Num is delta <> digits <>;
Default_Currency : in Wide_String := Default_Currency : Wide_String :=
Wide_Text_IO.Editing.Default_Currency; Wide_Text_IO.Editing.Default_Currency;
Default_Fill : in Wide_Character := Default_Fill : Wide_Character :=
Wide_Text_IO.Editing.Default_Fill; Wide_Text_IO.Editing.Default_Fill;
Default_Separator : in Wide_Character := Default_Separator : Wide_Character :=
Wide_Text_IO.Editing.Default_Separator; Wide_Text_IO.Editing.Default_Separator;
Default_Radix_Mark : in Wide_Character := Default_Radix_Mark : Wide_Character :=
Wide_Text_IO.Editing.Default_Radix_Mark; Wide_Text_IO.Editing.Default_Radix_Mark;
package Decimal_Output is package Decimal_Output is
function Length function Length
(Pic : in Picture; (Pic : Picture;
Currency : in Wide_String := Default_Currency) Currency : Wide_String := Default_Currency) return Natural;
return Natural;
function Valid function Valid
(Item : Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency) Currency : Wide_String := Default_Currency) return Boolean;
return Boolean;
function Image function Image
(Item : Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark) Radix_Mark : Wide_Character := Default_Radix_Mark) return Wide_String;
return Wide_String;
procedure Put procedure Put
(File : in File_Type; (File : File_Type;
Item : Num; Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark); Radix_Mark : Wide_Character := Default_Radix_Mark);
procedure Put procedure Put
(Item : Num; (Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark); Radix_Mark : Wide_Character := Default_Radix_Mark);
procedure Put procedure Put
(To : out Wide_String; (To : out Wide_String;
Item : Num; Item : Num;
Pic : in Picture; Pic : Picture;
Currency : in Wide_String := Default_Currency; Currency : Wide_String := Default_Currency;
Fill : in Wide_Character := Default_Fill; Fill : Wide_Character := Default_Fill;
Separator : in Wide_Character := Default_Separator; Separator : Wide_Character := Default_Separator;
Radix_Mark : in Wide_Character := Default_Radix_Mark); Radix_Mark : Wide_Character := Default_Radix_Mark);
end Decimal_Output; end Decimal_Output;
...@@ -196,8 +191,7 @@ private ...@@ -196,8 +191,7 @@ private
Currency_Symbol : Wide_String; Currency_Symbol : Wide_String;
Fill_Character : Wide_Character; Fill_Character : Wide_Character;
Separator_Character : Wide_Character; Separator_Character : Wide_Character;
Radix_Point : Wide_Character) Radix_Point : Wide_Character) return Wide_String;
return Wide_String;
-- Formats number according to Pic -- Formats number according to Pic
function Expand (Picture : in String) return String; function Expand (Picture : in String) return String;
......
gcc/ada/a-wttest.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,7 +39,7 @@ package body Ada.Wide_Text_IO.Text_Streams is ...@@ -39,7 +39,7 @@ package body Ada.Wide_Text_IO.Text_Streams is
-- Stream -- -- Stream --
------------ ------------
function Stream (File : in File_Type) return Stream_Access is function Stream (File : File_Type) return Stream_Access is
begin begin
System.File_IO.Check_File_Open (FCB.AFCB_Ptr (File)); System.File_IO.Check_File_Open (FCB.AFCB_Ptr (File));
return Stream_Access (File); return Stream_Access (File);
......
gcc/ada/a-wttest.ads
...@@ -19,6 +19,6 @@ package Ada.Wide_Text_IO.Text_Streams is ...@@ -19,6 +19,6 @@ package Ada.Wide_Text_IO.Text_Streams is
type Stream_Access is access all Streams.Root_Stream_Type'Class; type Stream_Access is access all Streams.Root_Stream_Type'Class;
function Stream (File : in File_Type) return Stream_Access; function Stream (File : File_Type) return Stream_Access;
end Ada.Wide_Text_IO.Text_Streams; end Ada.Wide_Text_IO.Text_Streams;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment