diff options
Diffstat (limited to 'gcc/ada/libgnat/a-wtmoio.adb')
| -rw-r--r-- | gcc/ada/libgnat/a-wtmoio.adb | 72 |
1 files changed, 53 insertions, 19 deletions
diff --git a/gcc/ada/libgnat/a-wtmoio.adb b/gcc/ada/libgnat/a-wtmoio.adb index 629f95d..702dcbb 100644 --- a/gcc/ada/libgnat/a-wtmoio.adb +++ b/gcc/ada/libgnat/a-wtmoio.adb @@ -29,19 +29,45 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Wide_Text_IO.Modular_Aux; - -with System.Unsigned_Types; use System.Unsigned_Types; -with System.WCh_Con; use System.WCh_Con; -with System.WCh_WtS; use System.WCh_WtS; +with Ada.Wide_Text_IO.Integer_Aux; +with System.Img_BIU; use System.Img_BIU; +with System.Img_Uns; use System.Img_Uns; +with System.Img_LLB; use System.Img_LLB; +with System.Img_LLU; use System.Img_LLU; +with System.Img_LLW; use System.Img_LLW; +with System.Img_WIU; use System.Img_WIU; +with System.Val_Uns; use System.Val_Uns; +with System.Val_LLU; use System.Val_LLU; +with System.WCh_Con; use System.WCh_Con; +with System.WCh_WtS; use System.WCh_WtS; package body Ada.Wide_Text_IO.Modular_IO is + package Aux_Uns is new + Ada.Wide_Text_IO.Integer_Aux + (Unsigned, + Scan_Unsigned, + Set_Image_Unsigned, + Set_Image_Width_Unsigned, + Set_Image_Based_Unsigned); + + package Aux_LLU is new + Ada.Wide_Text_IO.Integer_Aux + (Long_Long_Unsigned, + Scan_Long_Long_Unsigned, + Set_Image_Long_Long_Unsigned, + Set_Image_Width_Long_Long_Unsigned, + Set_Image_Based_Long_Long_Unsigned); + + Need_LLU : constant Boolean := Num'Base'Size > Unsigned'Size; + -- Throughout this generic body, we distinguish between the case where type + -- Unsigned is acceptable, and where a Long_Long_Unsigned is needed. This + -- Boolean is used to test for these cases and since it is a constant, only + -- code for the relevant case will be included in the instance. + subtype TFT is Ada.Wide_Text_IO.File_Type; -- File type required for calls to routines in Aux - package Aux renames Ada.Wide_Text_IO.Modular_Aux; - --------- -- Get -- --------- @@ -51,11 +77,15 @@ package body Ada.Wide_Text_IO.Modular_IO is Item : out Num; Width : Field := 0) is + -- We depend on a range check to get Data_Error + + pragma Unsuppress (Range_Check); + begin - if Num'Size > Unsigned'Size then - Aux.Get_LLU (TFT (File), Long_Long_Unsigned (Item), Width); + if Need_LLU then + Aux_LLU.Get (TFT (File), Long_Long_Unsigned (Item), Width); else - Aux.Get_Uns (TFT (File), Unsigned (Item), Width); + Aux_Uns.Get (TFT (File), Unsigned (Item), Width); end if; exception @@ -75,6 +105,10 @@ package body Ada.Wide_Text_IO.Modular_IO is Item : out Num; Last : out Positive) is + -- We depend on a range check to get Data_Error + + pragma Unsuppress (Range_Check); + S : constant String := Wide_String_To_String (From, WCEM_Upper); -- String on which we do the actual conversion. Note that the method -- used for wide character encoding is irrelevant, since if there is @@ -82,10 +116,10 @@ package body Ada.Wide_Text_IO.Modular_IO is -- Aux.Gets will raise Data_Error in any case. begin - if Num'Size > Unsigned'Size then - Aux.Gets_LLU (S, Long_Long_Unsigned (Item), Last); + if Need_LLU then + Aux_LLU.Gets (S, Long_Long_Unsigned (Item), Last); else - Aux.Gets_Uns (S, Unsigned (Item), Last); + Aux_Uns.Gets (S, Unsigned (Item), Last); end if; exception @@ -103,10 +137,10 @@ package body Ada.Wide_Text_IO.Modular_IO is Base : Number_Base := Default_Base) is begin - if Num'Size > Unsigned'Size then - Aux.Put_LLU (TFT (File), Long_Long_Unsigned (Item), Width, Base); + if Need_LLU then + Aux_LLU.Put (TFT (File), Long_Long_Unsigned (Item), Width, Base); else - Aux.Put_Uns (TFT (File), Unsigned (Item), Width, Base); + Aux_Uns.Put (TFT (File), Unsigned (Item), Width, Base); end if; end Put; @@ -127,10 +161,10 @@ package body Ada.Wide_Text_IO.Modular_IO is S : String (To'First .. To'Last); begin - if Num'Size > Unsigned'Size then - Aux.Puts_LLU (S, Long_Long_Unsigned (Item), Base); + if Need_LLU then + Aux_LLU.Puts (S, Long_Long_Unsigned (Item), Base); else - Aux.Puts_Uns (S, Unsigned (Item), Base); + Aux_Uns.Puts (S, Unsigned (Item), Base); end if; for J in S'Range loop |