1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUNTIME COMPONENTS -- 4-- -- 5-- A D A . T E X T _ I O . W I D E _ T E X T _ I O . F I X E D _ I O -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2000 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 2, 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. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28-- -- 29-- GNAT was originally developed by the GNAT team at New York University. -- 30-- Extensive contributions were provided by Ada Core Technologies Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34with Ada.Wide_Text_IO.Float_Aux; 35with System.WCh_Con; use System.WCh_Con; 36with System.WCh_WtS; use System.WCh_WtS; 37 38package body Ada.Wide_Text_IO.Fixed_IO is 39 40 subtype TFT is Ada.Wide_Text_IO.File_Type; 41 -- File type required for calls to routines in Aux 42 43 package Aux renames Ada.Wide_Text_IO.Float_Aux; 44 45 --------- 46 -- Get -- 47 --------- 48 49 procedure Get 50 (File : in File_Type; 51 Item : out Num; 52 Width : in Field := 0) 53 is 54 begin 55 Aux.Get (TFT (File), Long_Long_Float (Item), Width); 56 57 exception 58 when Constraint_Error => raise Data_Error; 59 end Get; 60 61 procedure Get 62 (Item : out Num; 63 Width : in Field := 0) 64 is 65 begin 66 Get (Current_Input, Item, Width); 67 end Get; 68 69 procedure Get 70 (From : in Wide_String; 71 Item : out Num; 72 Last : out Positive) 73 is 74 S : constant String := Wide_String_To_String (From, WCEM_Upper); 75 -- String on which we do the actual conversion. Note that the method 76 -- used for wide character encoding is irrelevant, since if there is 77 -- a character outside the Standard.Character range then the call to 78 -- Aux.Gets will raise Data_Error in any case. 79 80 begin 81 Aux.Gets (S, Long_Long_Float (Item), Last); 82 83 exception 84 when Constraint_Error => raise Data_Error; 85 end Get; 86 87 --------- 88 -- Put -- 89 --------- 90 91 procedure Put 92 (File : in File_Type; 93 Item : in Num; 94 Fore : in Field := Default_Fore; 95 Aft : in Field := Default_Aft; 96 Exp : in Field := Default_Exp) 97 is 98 begin 99 Aux.Put (TFT (File), Long_Long_Float (Item), Fore, Aft, Exp); 100 end Put; 101 102 procedure Put 103 (Item : in Num; 104 Fore : in Field := Default_Fore; 105 Aft : in Field := Default_Aft; 106 Exp : in Field := Default_Exp) 107 is 108 begin 109 Put (Current_Output, Item, Fore, Aft, Exp); 110 end Put; 111 112 procedure Put 113 (To : out Wide_String; 114 Item : in Num; 115 Aft : in Field := Default_Aft; 116 Exp : in Field := Default_Exp) 117 is 118 S : String (To'First .. To'Last); 119 120 begin 121 Aux.Puts (S, Long_Long_Float (Item), Aft, Exp); 122 123 for J in S'Range loop 124 To (J) := Wide_Character'Val (Character'Pos (S (J))); 125 end loop; 126 end Put; 127 128end Ada.Wide_Text_IO.Fixed_IO; 129