1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Wide_Wide_Text_IO.Integer_Aux; 33with System.WCh_Con; use System.WCh_Con; 34with System.WCh_WtS; use System.WCh_WtS; 35 36package body Ada.Wide_Wide_Text_IO.Integer_IO is 37 38 Need_LLI : constant Boolean := Num'Base'Size > Integer'Size; 39 -- Throughout this generic body, we distinguish between the case where type 40 -- Integer is acceptable, and where a Long_Long_Integer is needed. This 41 -- Boolean is used to test for these cases and since it is a constant, only 42 -- code for the relevant case will be included in the instance. 43 44 subtype TFT is Ada.Wide_Wide_Text_IO.File_Type; 45 -- File type required for calls to routines in Aux 46 47 package Aux renames Ada.Wide_Wide_Text_IO.Integer_Aux; 48 49 --------- 50 -- Get -- 51 --------- 52 53 procedure Get 54 (File : File_Type; 55 Item : out Num; 56 Width : Field := 0) 57 is 58 begin 59 if Need_LLI then 60 Aux.Get_LLI (TFT (File), Long_Long_Integer (Item), Width); 61 else 62 Aux.Get_Int (TFT (File), Integer (Item), Width); 63 end if; 64 65 exception 66 when Constraint_Error => raise Data_Error; 67 end Get; 68 69 procedure Get 70 (Item : out Num; 71 Width : Field := 0) 72 is 73 begin 74 Get (Current_Input, Item, Width); 75 end Get; 76 77 procedure Get 78 (From : Wide_Wide_String; 79 Item : out Num; 80 Last : out Positive) 81 is 82 S : constant String := Wide_Wide_String_To_String (From, WCEM_Upper); 83 -- String on which we do the actual conversion. Note that the method 84 -- used for wide character encoding is irrelevant, since if there is 85 -- a character outside the Standard.Character range then the call to 86 -- Aux.Gets will raise Data_Error in any case. 87 88 begin 89 if Need_LLI then 90 Aux.Gets_LLI (S, Long_Long_Integer (Item), Last); 91 else 92 Aux.Gets_Int (S, Integer (Item), Last); 93 end if; 94 95 exception 96 when Constraint_Error => raise Data_Error; 97 end Get; 98 99 --------- 100 -- Put -- 101 --------- 102 103 procedure Put 104 (File : File_Type; 105 Item : Num; 106 Width : Field := Default_Width; 107 Base : Number_Base := Default_Base) 108 is 109 begin 110 if Need_LLI then 111 Aux.Put_LLI (TFT (File), Long_Long_Integer (Item), Width, Base); 112 else 113 Aux.Put_Int (TFT (File), Integer (Item), Width, Base); 114 end if; 115 end Put; 116 117 procedure Put 118 (Item : Num; 119 Width : Field := Default_Width; 120 Base : Number_Base := Default_Base) 121 is 122 begin 123 Put (Current_Output, Item, Width, Base); 124 end Put; 125 126 procedure Put 127 (To : out Wide_Wide_String; 128 Item : Num; 129 Base : Number_Base := Default_Base) 130 is 131 S : String (To'First .. To'Last); 132 133 begin 134 if Need_LLI then 135 Aux.Puts_LLI (S, Long_Long_Integer (Item), Base); 136 else 137 Aux.Puts_Int (S, Integer (Item), Base); 138 end if; 139 140 for J in S'Range loop 141 To (J) := Wide_Wide_Character'Val (Character'Pos (S (J))); 142 end loop; 143 end Put; 144 145end Ada.Wide_Wide_Text_IO.Integer_IO; 146