1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--         A D A . W I D E _ T E X T _ I O . D E C I M A L _ 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
34package body Ada.Wide_Text_IO.Decimal_Aux is
35
36   ---------
37   -- Get --
38   ---------
39
40   function Get
41     (File  : File_Type;
42      Width : Field;
43      Scale : Integer) return Int
44   is
45      Buf  : String (1 .. Field'Last);
46      Ptr  : aliased Integer;
47      Stop : Integer := 0;
48      Item : Int;
49
50   begin
51      if Width /= 0 then
52         Load_Width (File, Width, Buf, Stop);
53         String_Skip (Buf, Ptr);
54      else
55         Load_Real (File, Buf, Stop);
56         Ptr := 1;
57      end if;
58
59      Item := Scan (Buf, Ptr'Access, Stop, Scale);
60      Check_End_Of_Field (Buf, Stop, Ptr, Width);
61      return Item;
62   end Get;
63
64   ----------
65   -- Gets --
66   ----------
67
68   function Gets
69     (From  : String;
70      Last  : out Positive;
71      Scale : Integer) return Int
72   is
73      Pos  : aliased Integer;
74      Item : Int;
75
76   begin
77      String_Skip (From, Pos);
78      Item := Scan (From, Pos'Access, From'Last, Scale);
79      Last := Pos - 1;
80      return Item;
81
82   exception
83      when Constraint_Error =>
84         Last := Pos - 1;
85         raise Data_Error;
86   end Gets;
87
88   ---------
89   -- Put --
90   ---------
91
92   procedure Put
93     (File  : File_Type;
94      Item  : Int;
95      Fore  : Field;
96      Aft   : Field;
97      Exp   : Field;
98      Scale : Integer)
99   is
100      Buf : String (1 .. Field'Last);
101      Ptr : Natural := 0;
102
103   begin
104      Set_Image (Item, Buf, Ptr, Scale, Fore, Aft, Exp);
105      Put_Item (File, Buf (1 .. Ptr));
106   end Put;
107
108   ----------
109   -- Puts --
110   ----------
111
112   procedure Puts
113     (To    : out String;
114      Item  : Int;
115      Aft   : Field;
116      Exp   : Field;
117      Scale : Integer)
118   is
119      Buf  : String (1 .. Positive'Max (Field'Last, To'Length));
120      Fore : Integer;
121      Ptr  : Natural := 0;
122
123   begin
124      --  Compute Fore, allowing for the decimal dot and Aft digits
125
126      Fore := To'Length - 1 - Field'Max (1, Aft);
127
128      --  Allow for Exp and one more for E if exponent present
129
130      if Exp /= 0 then
131         Fore := Fore - 1 - Field'Max (2, Exp);
132      end if;
133
134      --  Make sure we have enough room
135
136      if Fore < 1 + Boolean'Pos (Item < 0) then
137         raise Layout_Error;
138      end if;
139
140      --  Do the conversion and check length of result
141
142      Set_Image (Item, Buf, Ptr, Scale, Fore, Aft, Exp);
143
144      if Ptr > To'Length then
145         raise Layout_Error;
146      else
147         To := Buf (1 .. Ptr);
148      end if;
149   end Puts;
150
151end Ada.Wide_Text_IO.Decimal_Aux;
152