1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--               A D A . T E X T _ I O . B O U N D E D _ I O                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1997-2018, 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; use Ada.Text_IO;
33with Ada.Unchecked_Deallocation;
34
35package body Ada.Text_IO.Bounded_IO is
36
37   type String_Access is access all String;
38
39   procedure Free (SA : in out String_Access);
40   --  Perform an unchecked deallocation of a non-null string
41
42   ----------
43   -- Free --
44   ----------
45
46   procedure Free (SA : in out String_Access) is
47      Null_String : constant String := "";
48
49      procedure Deallocate is
50        new Ada.Unchecked_Deallocation (String, String_Access);
51
52   begin
53      --  Do not try to free statically allocated null string
54
55      if SA.all /= Null_String then
56         Deallocate (SA);
57      end if;
58   end Free;
59
60   --------------
61   -- Get_Line --
62   --------------
63
64   function Get_Line return Bounded.Bounded_String is
65   begin
66      return Bounded.To_Bounded_String (Get_Line);
67   end Get_Line;
68
69   --------------
70   -- Get_Line --
71   --------------
72
73   function Get_Line
74     (File : File_Type) return Bounded.Bounded_String
75   is
76   begin
77      return Bounded.To_Bounded_String (Get_Line (File));
78   end Get_Line;
79
80   --------------
81   -- Get_Line --
82   --------------
83
84   procedure Get_Line
85     (Item : out Bounded.Bounded_String)
86   is
87      Buffer : String (1 .. 1000);
88      Last   : Natural;
89      Str1   : String_Access;
90      Str2   : String_Access;
91
92   begin
93      Get_Line (Buffer, Last);
94      Str1 := new String'(Buffer (1 .. Last));
95
96      while Last = Buffer'Last loop
97         Get_Line (Buffer, Last);
98         Str2 := new String'(Str1.all & Buffer (1 .. Last));
99         Free (Str1);
100         Str1 := Str2;
101      end loop;
102
103      Item := Bounded.To_Bounded_String (Str1.all);
104   end Get_Line;
105
106   --------------
107   -- Get_Line --
108   --------------
109
110   procedure Get_Line
111     (File : File_Type;
112      Item : out Bounded.Bounded_String)
113   is
114      Buffer : String (1 .. 1000);
115      Last   : Natural;
116      Str1   : String_Access;
117      Str2   : String_Access;
118
119   begin
120      Get_Line (File, Buffer, Last);
121      Str1 := new String'(Buffer (1 .. Last));
122
123      while Last = Buffer'Last loop
124         Get_Line (File, Buffer, Last);
125         Str2 := new String'(Str1.all & Buffer (1 .. Last));
126         Free (Str1);
127         Str1 := Str2;
128      end loop;
129
130      Item := Bounded.To_Bounded_String (Str1.all);
131   end Get_Line;
132
133   ---------
134   -- Put --
135   ---------
136
137   procedure Put
138     (Item : Bounded.Bounded_String)
139   is
140   begin
141      Put (Bounded.To_String (Item));
142   end Put;
143
144   ---------
145   -- Put --
146   ---------
147
148   procedure Put
149     (File : File_Type;
150      Item : Bounded.Bounded_String)
151   is
152   begin
153      Put (File, Bounded.To_String (Item));
154   end Put;
155
156   --------------
157   -- Put_Line --
158   --------------
159
160   procedure Put_Line
161     (Item : Bounded.Bounded_String)
162   is
163   begin
164      Put_Line (Bounded.To_String (Item));
165   end Put_Line;
166
167   --------------
168   -- Put_Line --
169   --------------
170
171   procedure Put_Line
172     (File : File_Type;
173      Item : Bounded.Bounded_String)
174   is
175   begin
176      Put_Line (File, Bounded.To_String (Item));
177   end Put_Line;
178
179end Ada.Text_IO.Bounded_IO;
180