------------------------------------------------------------------------------
+------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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 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. --
-- --
--- 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. --
+-- 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 Interfaces; use Interfaces;
+
with System.Img_Char; use System.Img_Char;
-with System.WCh_Con; use System.WCh_Con;
-with System.WCh_WtS; use System.WCh_WtS;
package body System.Img_WChar is
-- Image_Wide_Character --
--------------------------
- function Image_Wide_Character
- (V : Wide_Character;
- EM : WC_Encoding_Method)
- return String
+ procedure Image_Wide_Character
+ (V : Wide_Character;
+ S : in out String;
+ P : out Natural;
+ Ada_2005 : Boolean)
is
- Val : constant Natural := Wide_Character'Pos (V);
- WS : Wide_String (1 .. 3);
+ pragma Assert (S'First = 1);
begin
- -- If in range of standard character, use standard character routine
+ -- Annoying Ada 95 incompatibility with FFFE/FFFF
- if Val < 16#80#
- or else (Val <= 16#FF#
- and then EM not in WC_Upper_Half_Encoding_Method)
+ if V >= Wide_Character'Val (16#FFFE#)
+ and then not Ada_2005
then
- return Image_Character (Character'Val (Val));
+ if V = Wide_Character'Val (16#FFFE#) then
+ S (1 .. 4) := "FFFE";
+ else
+ S (1 .. 4) := "FFFF";
+ end if;
- -- if the value is one of the last two characters in the type, use
- -- their language-defined names (3.5.2(3)).
+ P := 4;
- elsif Val = 16#FFFE# then
- return "FFFE";
+ -- Deal with annoying Ada 95 incompatibility with soft hyphen
- elsif Val = 16#FFFF# then
- return "FFFF";
+ elsif V = Wide_Character'Val (16#00AD#)
+ and then not Ada_2005
+ then
+ P := 3;
+ S (1) := ''';
+ S (2) := Character'Val (16#00AD#);
+ S (3) := ''';
- -- Otherwise return an appropriate escape sequence (i.e. one matching
- -- the convention implemented by Scn.Wide_Char). The easiest thing is
- -- to build a wide string for the result, and then use the Wide_Value
- -- function to build the resulting String.
+ -- Normal case, same as Wide_Wide_Character
else
- WS (1) := ''';
- WS (2) := V;
- WS (3) := ''';
-
- return Wide_String_To_String (WS, EM);
+ Image_Wide_Wide_Character
+ (Wide_Wide_Character'Val (Wide_Character'Pos (V)), S, P);
end if;
-
end Image_Wide_Character;
+ -------------------------------
+ -- Image_Wide_Wide_Character --
+ -------------------------------
+
+ procedure Image_Wide_Wide_Character
+ (V : Wide_Wide_Character;
+ S : in out String;
+ P : out Natural)
+ is
+ pragma Assert (S'First = 1);
+
+ Val : Unsigned_32 := Wide_Wide_Character'Pos (V);
+
+ begin
+ -- If in range of standard Character, use Character routine. Use the
+ -- Ada 2005 version, since either we are called directly in Ada 2005
+ -- mode for Wide_Wide_Character, or this is the Wide_Character case
+ -- which already took care of the Soft_Hyphen glitch.
+
+ if Val <= 16#FF# then
+ Image_Character_05
+ (Character'Val (Wide_Wide_Character'Pos (V)), S, P);
+
+ -- Otherwise value returned is Hex_hhhhhhhh
+
+ else
+ declare
+ Hex : constant array (Unsigned_32 range 0 .. 15) of Character :=
+ "0123456789ABCDEF";
+
+ begin
+ S (1 .. 4) := "Hex_";
+
+ for J in reverse 5 .. 12 loop
+ S (J) := Hex (Val mod 16);
+ Val := Val / 16;
+ end loop;
+
+ P := 12;
+ end;
+ end if;
+ end Image_Wide_Wide_Character;
+
end System.Img_WChar;
OSDN Git Service
