asis_2019.0.0_3ca32fa2/tools/gnat2xml/test/mckae-xml-ez_out-string_stream.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
------------------------------------------------------------------------
--                                                                    --
--                     McKae Software Utilities                       --
--                                                                    --
--           Copyright (C) 2005 McKae Technologies                    --
--                                                                    --
-- The  McKae   software  utilities   are  free  software;   you  can --
-- redistribute it  and/or modify it  under terms of the  GNU General --
-- Public  License  as published  by  the  Free Software  Foundation; --
-- either version  2, or (at  your option) any later  version.  McKae --
-- Software Utilities are  distributed in the hope that  they will be --
-- useful,  but  WITHOUT  ANY  WARRANTY;  without  even  the  implied --
-- warranty of  MERCHANTABILITY or FITNESS FOR  A PARTICULAR PURPOSE. --
-- See the GNU  General Public License for more  details.  You should --
-- have received a copy of the GNU General Public License distributed --
-- with DTraq; see file COPYING.   If not, write to the Free Software --
-- Foundation, 59  Temple Place -  Suite 330, Boston,  MA 02111-1307, --
-- USA.                                                               --
--                                                                    --
-- As a  special exception, if other files  instantiate generics from --
-- this unit,  or you link this  unit with other files  to produce an --
-- executable,  this unit  does  not by  itself  cause the  resulting --
-- executable to be covered by  the GNU General Public License.  This --
-- exception does  not however invalidate  any other reasons  why the --
-- executable file might be covered by the GNU Public License.        --
--                                                                    --
-- The McKae Software Utilities  are maintained by McKae Technologies --
-- (http://www.mckae.com).                                            --
------------------------------------------------------------------------

with Mckae.XML.EZ_Out.Generic_Medium;
with Ada.Strings.Fixed;
with Ada.Text_IO;
use  Ada.Text_IO;
with Unchecked_Deallocation;

package body Mckae.XML.EZ_Out.String_Stream is

   package body String_Buffering is
      procedure Free is new Unchecked_Deallocation(String, Buffer_Ptr);

      -- A basic in-memory string buffering package for building XML
      --  documents with EZ_Out.  This is not intended to be a robust,
      --  full-function memory buffering package.

      procedure Extend (F      : in String_Buffer;
                        To_Add : in Positive)is

         Temp_Buff        : Buffer_Ptr := F.Buff;

         Size_Delta       : Positive;
         Expansion_Factor : Positive;
         New_Size         : Positive := F.Size + To_Add;

      begin
         if New_Size > F.Allocation then
            Size_Delta        := New_Size - F.Allocation;
            Expansion_Factor  := (Size_Delta / F.Expansion) + 1;
            F.Self.Sb.Allocation
              := F.Allocation + (Expansion_Factor * F.Expansion);

            F.Self.Sb.Buff := new String(1 .. F.Allocation);
            F.Self.Sb.Buff(1 .. F.Size) := Temp_Buff(1 .. F.Size);
            Free (Temp_Buff);
         end if;
      end Extend;

      -- Copy the given string into the buffer, expanding it if needed.
      procedure Put(F : in String_Buffer;
                    S : in String) is
      begin
         if S'Length > 0 then
            Extend(F, S'Length);
            F.Buff(F.Size + 1 .. F.Size + S'Length) := S;
            F.Self.Sb.Size := F.Size + S'Length;
         end if;
      end Put;

      -- Insert a new line indicator into the buffer.
      procedure New_Line (F       : in String_Buffer;
                          Spacing : in Ada.Text_IO.Positive_Count := 1) is
         use Ada.Strings.Fixed;
      begin
         null;
      end New_Line;

      -- Clear the buffer
      procedure Clear(S : String_Buffer) is
      begin
         S.Self.Sb.Size := 0;
      end Clear;

      -- Return the current contents of the string buffer
      function Get_String(S : String_Buffer) return String is
      begin
         return S.Buff(1 .. S.Size);
      end Get_String;
   end String_Buffering;

end Mckae.XML.EZ_Out.String_Stream;