1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . W I D E _ T E X T _ I O . F L O A T _ 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_Text_IO.Float_Aux; 33 34with System.WCh_Con; use System.WCh_Con; 35with System.WCh_WtS; use System.WCh_WtS; 36 37package body Ada.Wide_Text_IO.Float_IO is 38 39 subtype TFT is Ada.Wide_Text_IO.File_Type; 40 -- File type required for calls to routines in Aux 41 42 package Aux renames Ada.Wide_Text_IO.Float_Aux; 43 44 --------- 45 -- Get -- 46 --------- 47 48 procedure Get 49 (File : File_Type; 50 Item : out Num; 51 Width : Field := 0) 52 is 53 begin 54 Aux.Get (TFT (File), Long_Long_Float (Item), Width); 55 56 exception 57 when Constraint_Error => raise Data_Error; 58 end Get; 59 60 procedure Get 61 (Item : out Num; 62 Width : Field := 0) 63 is 64 begin 65 Get (Current_Input, Item, Width); 66 end Get; 67 68 procedure Get 69 (From : Wide_String; 70 Item : out Num; 71 Last : out Positive) 72 is 73 S : constant String := Wide_String_To_String (From, WCEM_Upper); 74 -- String on which we do the actual conversion. Note that the method 75 -- used for wide character encoding is irrelevant, since if there is 76 -- a character outside the Standard.Character range then the call to 77 -- Aux.Gets will raise Data_Error in any case. 78 79 begin 80 Aux.Gets (S, Long_Long_Float (Item), Last); 81 82 exception 83 when Constraint_Error => raise Data_Error; 84 end Get; 85 86 --------- 87 -- Put -- 88 --------- 89 90 procedure Put 91 (File : File_Type; 92 Item : Num; 93 Fore : Field := Default_Fore; 94 Aft : Field := Default_Aft; 95 Exp : Field := Default_Exp) 96 is 97 begin 98 Aux.Put (TFT (File), Long_Long_Float (Item), Fore, Aft, Exp); 99 end Put; 100 101 procedure Put 102 (Item : Num; 103 Fore : Field := Default_Fore; 104 Aft : Field := Default_Aft; 105 Exp : Field := Default_Exp) 106 is 107 begin 108 Put (Current_Output, Item, Fore, Aft, Exp); 109 end Put; 110 111 procedure Put 112 (To : out Wide_String; 113 Item : Num; 114 Aft : Field := Default_Aft; 115 Exp : Field := Default_Exp) 116 is 117 S : String (To'First .. To'Last); 118 119 begin 120 Aux.Puts (S, Long_Long_Float (Item), Aft, Exp); 121 122 for J in S'Range loop 123 To (J) := Wide_Character'Val (Character'Pos (S (J))); 124 end loop; 125 end Put; 126 127end Ada.Wide_Text_IO.Float_IO; 128