------------------------------------------------------------------------------
--                              G N A T L I B                               --
--                                                                          --
--                     Copyright (C) 2001-2015, AdaCore                     --
--                                                                          --
-- This library is 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 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with GNAT.IO;     use GNAT.IO;
with Ada.Unchecked_Deallocation;

package body Traces2_Support is

   procedure Put (Stream : in out My_Stream; Str : String) is
   begin
      Put_Line (Stream.Args.all & "--" & Str & "--");
   end Put;

   procedure Newline (Stream : in out My_Stream) is
   begin
      Put_Line (Stream.Args.all & "--------------------");
   end Newline;

   procedure Close (Stream : in out My_Stream) is
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (String, String_Access);
   begin
      Unchecked_Free (Stream.Args);
      Close (Trace_Stream_Record (Stream));
   end Close;

   function New_Stream
     (Fact : Factory; Args : String) return Trace_Stream
   is
      pragma Unreferenced (Fact);
   begin
      return new My_Stream'
         (Trace_Stream_Record with Args => new String'(Args));
   end New_Stream;

   procedure Pre_Decorator
     (Handle  : in out My_Decorator;
      Stream  : in out Trace_Stream_Record'Class;
      Message : String)
   is
      pragma Unreferenced (Handle, Message);
   begin
      Put (Stream, "[MY_DECORATOR.PRE]");
   end Pre_Decorator;

   procedure Post_Decorator
     (Handle   : in out My_Decorator;
      Stream   : in out Trace_Stream_Record'Class;
      Location : String;
      Entity   : String;
      Message  : String)
   is
      pragma Unreferenced (Handle, Message, Location, Entity);
   begin
      Put (Stream, "[MY_DECORATOR.POST]");
   end Post_Decorator;

   procedure Pre_Decorator
     (Handle  : in out My_Handle;
      Stream  : in out Trace_Stream_Record'Class;
      Message : String) is
   begin
      Put (Stream, "[PREDECORATOR]");
      Pre_Decorator (Trace_Handle_Record (Handle), Stream, Message);
   end Pre_Decorator;

   procedure Post_Decorator
     (Handle   : in out My_Handle;
      Stream   : in out Trace_Stream_Record'Class;
      Location : String;
      Entity   : String;
      Message  : String) is
   begin
      Put (Stream, "[POSTDECORATOR]");
      Post_Decorator
        (Trace_Handle_Record (Handle), Stream, Location, Entity, Message);
   end Post_Decorator;

   function My_Decorator_Factory return Trace_Handle is
   begin
      return new My_Decorator;
   end My_Decorator_Factory;

   function My_Handle_Factory return Trace_Handle is
   begin
      return new My_Handle;
   end My_Handle_Factory;

end Traces2_Support;
