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