gcc/ada/a-zzboio.adb

   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
  32 with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
  33 with Ada.Unchecked_Deallocation;
  34
  35 package 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
 180 end Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO;