File : a-tiinio.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . T E X T _ I O . I N T E G E R _ 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 -- --
19 -- --
20 -- --
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
32 with Ada.Text_IO.Integer_Aux;
33
34 package body Ada.Text_IO.Integer_IO is
35
36 package Aux renames Ada.Text_IO.Integer_Aux;
37
38 Need_LLI : constant Boolean := Num'Base'Size > Integer'Size;
39 -- Throughout this generic body, we distinguish between the case where type
40 -- Integer is acceptable, and where a Long_Long_Integer is needed. This
41 -- Boolean is used to test for these cases and since it is a constant, only
42 -- code for the relevant case will be included in the instance.
43
44 ---------
45 -- Get --
46 ---------
47
48 procedure Get
49 (File : File_Type;
50 Item : out Num;
51 Width : Field := 0)
52 is
53 -- We depend on a range check to get Data_Error
54
55 pragma Unsuppress (Range_Check);
56 pragma Unsuppress (Overflow_Check);
57
58 begin
59 if Need_LLI then
60 Aux.Get_LLI (File, Long_Long_Integer (Item), Width);
61 else
62 Aux.Get_Int (File, Integer (Item), Width);
63 end if;
64
65 exception
66 when Constraint_Error => raise Data_Error;
67 end Get;
68
69 procedure Get
70 (Item : out Num;
71 Width : Field := 0)
72 is
73 -- We depend on a range check to get Data_Error
74
75 pragma Unsuppress (Range_Check);
76 pragma Unsuppress (Overflow_Check);
77
78 begin
79 if Need_LLI then
80 Aux.Get_LLI (Current_In, Long_Long_Integer (Item), Width);
81 else
82 Aux.Get_Int (Current_In, Integer (Item), Width);
83 end if;
84
85 exception
86 when Constraint_Error => raise Data_Error;
87 end Get;
88
89 procedure Get
90 (From : String;
91 Item : out Num;
92 Last : out Positive)
93 is
94 -- We depend on a range check to get Data_Error
95
96 pragma Unsuppress (Range_Check);
97 pragma Unsuppress (Overflow_Check);
98
99 begin
100 if Need_LLI then
101 Aux.Gets_LLI (From, Long_Long_Integer (Item), Last);
102 else
103 Aux.Gets_Int (From, Integer (Item), Last);
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 Width : Field := Default_Width;
118 Base : Number_Base := Default_Base)
119 is
120 begin
121 if Need_LLI then
122 Aux.Put_LLI (File, Long_Long_Integer (Item), Width, Base);
123 else
124 Aux.Put_Int (File, Integer (Item), Width, Base);
125 end if;
126 end Put;
127
128 procedure Put
129 (Item : Num;
130 Width : Field := Default_Width;
131 Base : Number_Base := Default_Base)
132 is
133 begin
134 if Need_LLI then
135 Aux.Put_LLI (Current_Out, Long_Long_Integer (Item), Width, Base);
136 else
137 Aux.Put_Int (Current_Out, Integer (Item), Width, Base);
138 end if;
139 end Put;
140
141 procedure Put
142 (To : out String;
143 Item : Num;
144 Base : Number_Base := Default_Base)
145 is
146 begin
147 if Need_LLI then
148 Aux.Puts_LLI (To, Long_Long_Integer (Item), Base);
149 else
150 Aux.Puts_Int (To, Integer (Item), Base);
151 end if;
152 end Put;
153
154 end Ada.Text_IO.Integer_IO;