OSDN Git Service

2006-10-31 Javier Miranda <miranda@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / s-imgwch.adb
index ef25ce9..a408ef6 100644 (file)
@@ -1,4 +1,4 @@
------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 --                                                                          --
 --                         GNAT RUN-TIME COMPONENTS                         --
 --                                                                          --
@@ -6,8 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -17,8 +16,8 @@
 -- 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, --
@@ -32,9 +31,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+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
 
@@ -43,44 +42,61 @@ 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;