--------------------------------------------------------------- {{{1 ---------- --: Copyright © 2007 … 2023 Martin Krischik «krischik@users.sourceforge.net» ----------------------------------------------------------------------------- --: This library is free software; you can redistribute it and/or modify it --: under the terms of the GNU Library General Public License as published by --: the Free Software Foundation; either version 2 of the License, 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 MERCHANTABILITY --: or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public --: License for more details. --: --: You should have received a copy of the GNU Library General Public License --: along with this library; if not, write to the Free Software Foundation, --: Inc., 675 Mass Ave, Cambridge, MA 02139, USA. --------------------------------------------------------------- }}}1 ---------- pragma License (Modified_Gpl); pragma Ada_2022; with Ada.Assertions; with Ada.Exceptions; with Ada.Strings.Unbounded; with AdaCL.Base; with GNAT.Source_Info; with System.Storage_Elements; with System; --- -- @summary -- -- @description package AdaCL.Trace is --- -- Keep internal data for function traces --: @field Name_Length Lenght of trace String -- type Object (Name_Length : Positive) is new Base.Object with private; --- -- Trace Destination -- --: @value Queue Trace to system queue --: @value Standard_Error Trace to standart error --: @value Standard_Output Trace to standart output --: @value File Trace to file type Destination is (Queue, Standard_Error, Standard_Output, File); --- -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways -- some extra Adjust with matching. Finalize. -- -- Name of the function calls to be traced. -- function Function_Trace (Name : in String) return Object; pragma Inline (Function_Trace); --- -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways -- some extra Adjust with matching. Finalize. -- -- Name of the function calls to be traced. -- function Function_Trace (Entity : in String := GNAT.Source_Info.Enclosing_Entity; Source : in String := GNAT.Source_Info.Source_Location) return Object is (Function_Trace (Name => Entity & ':' & Source)); --- -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways -- some extra Adjust with matching. Finalize. -- -- Name of the function calls to be traced. -- --: function Function_Trace ( --: Entity : in String; --: Parameter : in Parameter_Vector.Vector) --: return Object --: is (Function_Trace (Entity & ':' & Parameter.Image)); --- -- Trace the given exeption details and then raise the exception. -- --: @param Raising Exeption which is raised Message : Free form Message --: @param Message Message to print to trace --: @param Entity Location destriptor. --: @param Source Location destriptor. procedure Raise_Exception (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity; Message : in String := "No Message given"; Entity : in String := GNAT.Source_Info.Enclosing_Entity; Source : in String := GNAT.Source_Info.Source_Location); pragma No_Return (Raise_Exception); --- -- Trace the given exeption details and then raise the exception. -- --: @param Raising Exeption which is raised Message : Free form Message --: @param Message Message to print to trace --: @param Source Filename. --: @param Line Line number. procedure Raise_Exception (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity; Message : in String := "No Message given"; Source : in String := GNAT.Source_Info.File; Line : in Natural := GNAT.Source_Info.Line); --- -- Report an assert condition. If the condition is not true create a trace entry describing the assertion and then -- raise an exception. -- --: @param Condition Condition which should be true --: @param Raising Exeption which is raised --: @param Message Free form Message --: @param Entity Location destriptor. --: @param Source Location destriptor. procedure Report_Assertion (Condition : in Boolean; Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity; Message : in String := "No Message given."; Entity : in String := GNAT.Source_Info.Enclosing_Entity; Source : in String := GNAT.Source_Info.Source_Location); pragma Inline (Report_Assertion); --- -- Report an assert condition. If the condition is not true create a trace entry describing the assertion and then -- raise an exception. -- -- This version used parameter which are compatible with AUnit -- --: @param Condition Condition which should be true --: @param Message Free form Message --: @param Source Filename of source code --: @param Line Line number in source code. procedure Report_Assertion (Condition : Boolean; Message : String; Source : String := GNAT.Source_Info.File; Line : Natural := GNAT.Source_Info.Line); --- -- Write Line numbers -- procedure Enable_Write_Line_Number; pragma Inline (Enable_Write_Line_Number); --- -- Don't Write Line numbers -- procedure Disable_Write_Line_Number; pragma Inline (Disable_Write_Line_Number); --- -- check if Line numbers are written -- function Is_Write_Line_Number_Enabled return Boolean; pragma Inline (Is_Write_Line_Number_Enabled); --- -- Enable Trace -- procedure Enable_Trace; pragma Inline (Enable_Trace); --- -- Enable Trace -- procedure Disable_Trace; pragma Inline (Disable_Trace); --- -- check is trace is Enabled -- function Is_Trace_Enabled return Boolean; pragma Inline (Is_Trace_Enabled); --- -- Enable Verbose Output -- procedure Enable_Verbose; pragma Inline (Enable_Verbose); --- -- Disable Verbose Output -- procedure Disable_Verbose; pragma Inline (Disable_Verbose); --- -- check is trace is Enabled -- function Is_Verbose_Enabled return Boolean; pragma Inline (Is_Verbose_Enabled); --- -- Write to queue - not supported yet. -- procedure Write_To_Queue; pragma Inline (Write_To_Queue); --- -- Write to Standart Error -- procedure Write_To_Standard_Error; pragma Inline (Write_To_Standard_Error); --- -- Write to Standart Error -- procedure Write_To_Standard_Output; pragma Inline (Write_To_Standard_Output); --- -- Write to queue - not supported yet. -- procedure Write_To_File; pragma Inline (Write_To_File); --- -- Set Filename for Trace File -- procedure Write_To_File (New_Filename : in String); --- -- Check the Trace Destination -- function Trace_Destination return Destination; pragma Inline (Trace_Destination); --- -- Enable the write prefix -- procedure Enable_Write_Prefix; pragma Inline (Enable_Write_Prefix); --- -- Disable_ the write prefix -- procedure Disable_Write_Prefix; pragma Inline (Disable_Write_Prefix); --- -- Check the write prefix flag -- function Is_Write_Prefix_Enabled return Boolean; pragma Inline (Is_Write_Prefix_Enabled); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- --: @param Text String to be written procedure Write (Text : in String); --- -- Write an Address. -- --: @param Text String to be written procedure Write (Text : in String; An_Address : in System.Address); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- --: @param Text String to be written procedure Write (Text : in Ada.Strings.Unbounded.Unbounded_String); --- -- Write an Exception to the Trace -- --: @param An_Exception String to be written procedure Write (An_Exception : in Ada.Exceptions.Exception_Occurrence); --- -- Write an Exception to the Trace -- --: @param An_Exception Exception to be written --: @param Entity Procedure in which the exception was caught --: @param Source Source File in which Entity is located. procedure Write (An_Exception : in Ada.Exceptions.Exception_Occurrence; Entity : in String; Source : in String); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- --: @param Text String to be written procedure Write_Wide (Text : in Wide_String); --- -- Create a memory dump, S -- --: @param An_Address String to be written --: @param A_Size Size in Storage_Elements. procedure Write_Dump (An_Address : in System.Address; Size_In_Byte : in System.Storage_Elements.Storage_Count); --- -- Create a memory dump. This Dump takes size in bits. -- --: @param An_Address String to be written --: @param A_Size Size in Bits - i.E. for 'Size. procedure Write_Dump (An_Address : in System.Address; Size_In_Bits : in Integer); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- --: @param Text String to be written procedure Write_Error (Text : in String); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- --: @param Text String to be written procedure Write_Error (Text : in Ada.Strings.Unbounded.Unbounded_String); --- -- Write an Exception to the Trace -- --: @param An_Exception String to be written procedure Write_Error (An_Exception : in Ada.Exceptions.Exception_Occurrence); --- -- Write an Exception to the Trace -- --: @param An_Exception String to be written --: @param Entity Procedure in which the exception was caught --: @param Source Source File in which Entity is located. procedure Write_Error (An_Exception : in Ada.Exceptions.Exception_Occurrence; Entity : in String; Source : in String); --- -- When verbose is aktivated then an empty line is written to Standart_Output -- procedure Write_Info; --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- -- When verbose is aktivated then the string is written to Standart_Output as well. -- --: @param Text String to be written procedure Write_Info (Text : in String); --- -- When verbose is aktivated then the character is written to Standart_Output. -- --: @param Text character to be written procedure Write_Info (Text : in Character); --- -- Write an IString using writeFormattedString after adding the appropriate padding for indentation. -- -- When verbose is aktivated then the string is written to Standart_Output as well. -- --: @param Text String to be written procedure Write_Info (Text : in Ada.Strings.Unbounded.Unbounded_String); --- -- Write Help for Commandline Options parsed from Trace -- procedure Write_Commandline_Help; private --- -- Ada Class Library -- Trace -- -- Instanz Data -- --: @field Name_Length Lenght of trace String --: @field Trace_Name Trace String -- type Object (Name_Length : Positive) is new AdaCL.Base.Object with record Trace_Name : String (1 .. Name_Length); end record; --- -- Trace Copy. -- --: @param This Object itself. -- overriding procedure Adjust (This : in out Object); --- -- Trace end of function -- --: @param This Object itself. -- overriding procedure Finalize (This : in out Object); end AdaCL.Trace; ---------------------------------------------------------------- {{{ ---------- --: vim: set textwidth=0 nowrap tabstop=8 shiftwidth=3 softtabstop=3 expandtab : --: vim: set filetype=ada fileencoding=utf-8 fileformat=unix foldmethod=expr : --: vim: set spell spelllang=en_gb