1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . T E X T _ I O . F L O A T _ I O -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, 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.Text_IO.Float_Aux; 33 34package body Ada.Text_IO.Float_IO is 35 36 package Aux renames Ada.Text_IO.Float_Aux; 37 38 --------- 39 -- Get -- 40 --------- 41 42 procedure Get 43 (File : File_Type; 44 Item : out Num; 45 Width : Field := 0) 46 is 47 pragma Unsuppress (Range_Check); 48 49 begin 50 Aux.Get (File, Long_Long_Float (Item), Width); 51 52 -- In the case where the type is unconstrained (e.g. Standard'Float), 53 -- the above conversion may result in an infinite value, which is 54 -- normally fine for a conversion, but in this case, we want to treat 55 -- that as a data error. 56 57 if not Item'Valid then 58 raise Data_Error; 59 end if; 60 61 exception 62 when Constraint_Error => raise Data_Error; 63 end Get; 64 65 procedure Get 66 (Item : out Num; 67 Width : Field := 0) 68 is 69 pragma Unsuppress (Range_Check); 70 71 begin 72 Aux.Get (Current_In, Long_Long_Float (Item), Width); 73 74 -- In the case where the type is unconstrained (e.g. Standard'Float), 75 -- the above conversion may result in an infinite value, which is 76 -- normally fine for a conversion, but in this case, we want to treat 77 -- that as a data error. 78 79 if not Item'Valid then 80 raise Data_Error; 81 end if; 82 83 exception 84 when Constraint_Error => raise Data_Error; 85 end Get; 86 87 procedure Get 88 (From : String; 89 Item : out Num; 90 Last : out Positive) 91 is 92 pragma Unsuppress (Range_Check); 93 94 begin 95 Aux.Gets (From, Long_Long_Float (Item), Last); 96 97 -- In the case where the type is unconstrained (e.g. Standard'Float), 98 -- the above conversion may result in an infinite value, which is 99 -- normally fine for a conversion, but in this case, we want to treat 100 -- that as a data error. 101 102 if not Item'Valid then 103 raise Data_Error; 104 end if; 105 106 exception 107 when Constraint_Error => raise Data_Error; 108 end Get; 109 110 --------- 111 -- Put -- 112 --------- 113 114 procedure Put 115 (File : File_Type; 116 Item : Num; 117 Fore : Field := Default_Fore; 118 Aft : Field := Default_Aft; 119 Exp : Field := Default_Exp) 120 is 121 begin 122 Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp); 123 end Put; 124 125 procedure Put 126 (Item : Num; 127 Fore : Field := Default_Fore; 128 Aft : Field := Default_Aft; 129 Exp : Field := Default_Exp) 130 is 131 begin 132 Aux.Put (Current_Out, Long_Long_Float (Item), Fore, Aft, Exp); 133 end Put; 134 135 procedure Put 136 (To : out String; 137 Item : Num; 138 Aft : Field := Default_Aft; 139 Exp : Field := Default_Exp) 140 is 141 begin 142 Aux.Puts (To, Long_Long_Float (Item), Aft, Exp); 143 end Put; 144 145end Ada.Text_IO.Float_IO; 146