diff options
Diffstat (limited to 'gcc/ada/s-valwch.adb')
| -rw-r--r-- | gcc/ada/s-valwch.adb | 47 |
1 files changed, 32 insertions, 15 deletions
diff --git a/gcc/ada/s-valwch.adb b/gcc/ada/s-valwch.adb index 5e75a979d5a..8d4604552dc 100644 --- a/gcc/ada/s-valwch.adb +++ b/gcc/ada/s-valwch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,6 +31,7 @@ -- -- ------------------------------------------------------------------------------ +with Interfaces; use Interfaces; with System.Val_Util; use System.Val_Util; with System.WCh_Con; use System.WCh_Con; with System.WCh_StW; use System.WCh_StW; @@ -42,9 +43,27 @@ package body System.Val_WChar is -------------------------- function Value_Wide_Character - (Str : String; - EM : WC_Encoding_Method) - return Wide_Character + (Str : String; + EM : WC_Encoding_Method) return Wide_Character + is + WWC : constant Wide_Wide_Character := + Value_Wide_Wide_Character (Str, EM); + WWV : constant Unsigned_32 := Wide_Wide_Character'Pos (WWC); + begin + if WWV > 16#FFFF# then + raise Constraint_Error; + else + return Wide_Character'Val (WWV); + end if; + end Value_Wide_Character; + + ------------------------------- + -- Value_Wide_Wide_Character -- + ------------------------------- + + function Value_Wide_Wide_Character + (Str : String; + EM : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_Character is F : Natural; L : Natural; @@ -60,21 +79,20 @@ package body System.Val_WChar is -- If just three characters, simple character case if L - F = 2 then - return Wide_Character'Val (Character'Pos (S (F + 1))); + return Wide_Wide_Character'Val (Character'Pos (S (F + 1))); -- Otherwise must be a wide character in quotes. The easiest - -- thing is to convert the string to a wide string and then + -- thing is to convert the string to a wide wide string and then -- pick up the single character that it should contain. else declare - WS : constant Wide_String := - String_To_Wide_String (S (F + 1 .. L - 1), EM); + WS : constant Wide_Wide_String := + String_To_Wide_Wide_String (S (F + 1 .. L - 1), EM); begin if WS'Length /= 1 then raise Constraint_Error; - else return WS (WS'First); end if; @@ -84,29 +102,28 @@ package body System.Val_WChar is -- the last two values of the type have language-defined names: elsif S = "FFFE" then - return Wide_Character'Val (16#FFFE#); + return Wide_Wide_Character'Val (16#FFFE#); elsif S = "FFFF" then - return Wide_Character'Val (16#FFFF#); + return Wide_Wide_Character'Val (16#FFFF#); -- Otherwise must be a control character else for C in Character'Val (16#00#) .. Character'Val (16#1F#) loop if S (F .. L) = Character'Image (C) then - return Wide_Character'Val (Character'Pos (C)); + return Wide_Wide_Character'Val (Character'Pos (C)); end if; end loop; for C in Character'Val (16#7F#) .. Character'Val (16#9F#) loop if S (F .. L) = Character'Image (C) then - return Wide_Character'Val (Character'Pos (C)); + return Wide_Wide_Character'Val (Character'Pos (C)); end if; end loop; raise Constraint_Error; end if; - - end Value_Wide_Character; + end Value_Wide_Wide_Character; end System.Val_WChar; |