-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
+-- ware Foundation; either version 3, 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. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- 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. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
-with Ada.Strings.Maps; use Ada.Strings.Maps;
-with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+with Ada.Strings.Maps; use Ada.Strings.Maps;
+with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
package body Ada.Characters.Handling is
-- Is_Alphanumeric --
---------------------
- function Is_Alphanumeric (Item : in Character) return Boolean is
+ function Is_Alphanumeric (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Alphanum) /= 0;
end Is_Alphanumeric;
-- Is_Basic --
--------------
- function Is_Basic (Item : in Character) return Boolean is
+ function Is_Basic (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Basic) /= 0;
end Is_Basic;
-- Is_Character --
------------------
- function Is_Character (Item : in Wide_Character) return Boolean is
+ function Is_Character (Item : Wide_Character) return Boolean is
begin
return Wide_Character'Pos (Item) < 256;
end Is_Character;
-- Is_Control --
----------------
- function Is_Control (Item : in Character) return Boolean is
+ function Is_Control (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Control) /= 0;
end Is_Control;
-- Is_Digit --
--------------
- function Is_Digit (Item : in Character) return Boolean is
+ function Is_Digit (Item : Character) return Boolean is
begin
return Item in '0' .. '9';
end Is_Digit;
-- Is_Graphic --
----------------
- function Is_Graphic (Item : in Character) return Boolean is
+ function Is_Graphic (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Graphic) /= 0;
end Is_Graphic;
-- Is_Hexadecimal_Digit --
--------------------------
- function Is_Hexadecimal_Digit (Item : in Character) return Boolean is
+ function Is_Hexadecimal_Digit (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Hex_Digit) /= 0;
end Is_Hexadecimal_Digit;
-- Is_ISO_646 --
----------------
- function Is_ISO_646 (Item : in Character) return Boolean is
+ function Is_ISO_646 (Item : Character) return Boolean is
begin
return Item in ISO_646;
end Is_ISO_646;
-- Note: much more efficient coding of the following function is possible
-- by testing several 16#80# bits in a complete word in a single operation
- function Is_ISO_646 (Item : in String) return Boolean is
+ function Is_ISO_646 (Item : String) return Boolean is
begin
for J in Item'Range loop
if Item (J) not in ISO_646 then
-- Is_Letter --
---------------
- function Is_Letter (Item : in Character) return Boolean is
+ function Is_Letter (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Letter) /= 0;
end Is_Letter;
-- Is_Lower --
--------------
- function Is_Lower (Item : in Character) return Boolean is
+ function Is_Lower (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Lower) /= 0;
end Is_Lower;
-- Is_Special --
----------------
- function Is_Special (Item : in Character) return Boolean is
+ function Is_Special (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Special) /= 0;
end Is_Special;
-- Is_String --
---------------
- function Is_String (Item : in Wide_String) return Boolean is
+ function Is_String (Item : Wide_String) return Boolean is
begin
for J in Item'Range loop
if Wide_Character'Pos (Item (J)) >= 256 then
-- Is_Upper --
--------------
- function Is_Upper (Item : in Character) return Boolean is
+ function Is_Upper (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Upper) /= 0;
end Is_Upper;
-- To_Basic --
--------------
- function To_Basic (Item : in Character) return Character is
+ function To_Basic (Item : Character) return Character is
begin
return Value (Basic_Map, Item);
end To_Basic;
- function To_Basic (Item : in String) return String is
+ function To_Basic (Item : String) return String is
Result : String (1 .. Item'Length);
begin
------------------
function To_Character
- (Item : in Wide_Character;
- Substitute : in Character := ' ')
- return Character
+ (Item : Wide_Character;
+ Substitute : Character := ' ') return Character
is
begin
if Is_Character (Item) then
----------------
function To_ISO_646
- (Item : in Character;
- Substitute : in ISO_646 := ' ')
- return ISO_646
+ (Item : Character;
+ Substitute : ISO_646 := ' ') return ISO_646
is
begin
- if Item in ISO_646 then
- return Item;
- else
- return Substitute;
- end if;
+ return (if Item in ISO_646 then Item else Substitute);
end To_ISO_646;
function To_ISO_646
- (Item : in String;
- Substitute : in ISO_646 := ' ')
- return String
+ (Item : String;
+ Substitute : ISO_646 := ' ') return String
is
Result : String (1 .. Item'Length);
begin
for J in Item'Range loop
- if Item (J) in ISO_646 then
- Result (J - (Item'First - 1)) := Item (J);
- else
- Result (J - (Item'First - 1)) := Substitute;
- end if;
+ Result (J - (Item'First - 1)) :=
+ (if Item (J) in ISO_646 then Item (J) else Substitute);
end loop;
return Result;
-- To_Lower --
--------------
- function To_Lower (Item : in Character) return Character is
+ function To_Lower (Item : Character) return Character is
begin
return Value (Lower_Case_Map, Item);
end To_Lower;
- function To_Lower (Item : in String) return String is
+ function To_Lower (Item : String) return String is
Result : String (1 .. Item'Length);
begin
---------------
function To_String
- (Item : in Wide_String;
- Substitute : in Character := ' ')
- return String
+ (Item : Wide_String;
+ Substitute : Character := ' ') return String
is
Result : String (1 .. Item'Length);
for J in Item'Range loop
Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
end loop;
+
return Result;
end To_String;
--------------
function To_Upper
- (Item : in Character)
- return Character
+ (Item : Character) return Character
is
begin
return Value (Upper_Case_Map, Item);
end To_Upper;
function To_Upper
- (Item : in String)
- return String
+ (Item : String) return String
is
Result : String (1 .. Item'Length);
-----------------------
function To_Wide_Character
- (Item : in Character)
- return Wide_Character
+ (Item : Character) return Wide_Character
is
begin
return Wide_Character'Val (Character'Pos (Item));
--------------------
function To_Wide_String
- (Item : in String)
- return Wide_String
+ (Item : String) return Wide_String
is
Result : Wide_String (1 .. Item'Length);
return Result;
end To_Wide_String;
+
end Ada.Characters.Handling;
OSDN Git Service
