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 _ A U X            --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2021, 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.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
33
34with System.Img_Util; use System.Img_Util;
35
36package body Ada.Wide_Text_IO.Float_Aux is
37
38   ---------
39   -- Get --
40   ---------
41
42   procedure Get
43     (File  : File_Type;
44      Item  : out Num;
45      Width : Field)
46   is
47      Buf  : String (1 .. Field'Last);
48      Stop : Integer := 0;
49      Ptr  : aliased Integer;
50
51   begin
52      if Width /= 0 then
53         Load_Width (File, Width, Buf, Stop);
54         String_Skip (Buf, Ptr);
55      else
56         Load_Real (File, Buf, Stop);
57         Ptr := 1;
58      end if;
59
60      Item := Scan (Buf, Ptr'Access, Stop);
61      Check_End_Of_Field (Buf, Stop, Ptr, Width);
62   end Get;
63
64   ----------
65   -- Gets --
66   ----------
67
68   procedure Gets
69     (From : String;
70      Item : out Num;
71      Last : out Positive)
72   is
73      Pos : aliased Integer;
74
75   begin
76      String_Skip (From, Pos);
77      Item := Scan (From, Pos'Access, From'Last);
78      Last := Pos - 1;
79
80   exception
81      when Constraint_Error => raise Data_Error;
82   end Gets;
83
84   ---------
85   -- Put --
86   ---------
87
88   procedure Put
89     (File : File_Type;
90      Item : Num;
91      Fore : Field;
92      Aft  : Field;
93      Exp  : Field)
94   is
95      Buf : String (1 .. Max_Real_Image_Length);
96      Ptr : Natural := 0;
97
98   begin
99      Set_Image (Item, Buf, Ptr, Fore, Aft, Exp);
100      Put_Item (File, Buf (1 .. Ptr));
101   end Put;
102
103   ----------
104   -- Puts --
105   ----------
106
107   procedure Puts
108     (To   : out String;
109      Item : Num;
110      Aft  : Field;
111      Exp  : Field)
112   is
113      Buf : String (1 .. Max_Real_Image_Length);
114      Ptr : Natural := 0;
115
116   begin
117      Set_Image (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
118
119      if Ptr > To'Length then
120         raise Layout_Error;
121
122      else
123         for J in 1 .. Ptr loop
124            To (To'Last - Ptr + J) := Buf (J);
125         end loop;
126
127         for J in To'First .. To'Last - Ptr loop
128            To (J) := ' ';
129         end loop;
130      end if;
131   end Puts;
132
133end Ada.Wide_Text_IO.Float_Aux;
134