------------------------------------------------------------------------------
+------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-1998, 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- 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. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, 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, --
-- --
------------------------------------------------------------------------------
+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
--------------------------
function Image_Wide_Character
- (V : Wide_Character;
- EM : WC_Encoding_Method)
- return String
+ (V : Wide_Character;
+ Ada_2005 : Boolean) return String
is
- Val : constant Natural := Wide_Character'Pos (V);
- WS : Wide_String (1 .. 3);
-
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
+ return "FFFE";
+ else
+ return "FFFF";
+ end if;
+ end if;
+
+ -- Normal case, same as Wide_Wide_Character
+
+ return
+ Image_Wide_Wide_Character
+ (Wide_Wide_Character'Val (Wide_Character'Pos (V)));
+ end Image_Wide_Character;
+
+ -------------------------------
+ -- Image_Wide_Wide_Character --
+ -------------------------------
- -- if the value is one of the last two characters in the type, use
- -- their language-defined names (3.5.2(3)).
+ function Image_Wide_Wide_Character
+ (V : Wide_Wide_Character) return String
+ is
+ Val : Unsigned_32 := Wide_Wide_Character'Pos (V);
- elsif Val = 16#FFFE# then
- return "FFFE";
+ begin
+ -- If in range of standard Character, use Character routine
- elsif Val = 16#FFFF# then
- return "FFFF";
+ if Val <= 16#FF# then
+ return Image_Character (Character'Val (Wide_Wide_Character'Pos (V)));
- -- 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.
+ -- Otherwise value returned is Hex_hhhhhhhh
else
- WS (1) := ''';
- WS (2) := V;
- WS (3) := ''';
+ declare
+ Result : String (1 .. 12) := "Hex_hhhhhhhh";
+ Hex : constant array (Unsigned_32 range 0 .. 15) of Character :=
+ "0123456789ABCDEF";
- return Wide_String_To_String (WS, EM);
- end if;
+ begin
+ for J in reverse 5 .. 12 loop
+ Result (J) := Hex (Val mod 16);
+ Val := Val / 16;
+ end loop;
- end Image_Wide_Character;
+ return Result;
+ end;
+ end if;
+ end Image_Wide_Wide_Character;
end System.Img_WChar;