-----------------------------------------------------------------------
--  AWA tests - AWA Tests Framework
--  Copyright (C) 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Task_Termination;
with Ada.Task_Identification;
with Ada.Exceptions;
with Ada.Unchecked_Deallocation;

with ASF.Server.Tests;
with ASF.Server.Web;
with ASF.Converters.Dates;

with ASF.Tests;

with AWA.Converters.Dates;
with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");

      if Add_Modules then
         declare
            Ctx    : AWA.Services.Contexts.Service_Context;
            Users : constant AWA.Users.Modules.User_Module_Access := AWA.Tests.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

-----------------------------------------------------------------------
--  AWA tests - AWA Tests Framework
--  Copyright (C) 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Task_Termination;
with Ada.Task_Identification;
with Ada.Exceptions;
with Ada.Unchecked_Deallocation;

with ASF.Server.Tests;
with ASF.Server.Web;

with ASF.Tests;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

Remove dependencies to AWA modules

Remove dependencies to AWA modules


-----------------------------------------------------------------------
--  AWA tests - AWA Tests Framework
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Task_Termination;
with Ada.Task_Identification;
with Ada.Exceptions;
with Ada.Unchecked_Deallocation;

with ASF.Server.Tests;

with Util.Log.Loggers;

with ASF.Tests;

with AWA.Applications.Factory;
with AWA.Tests.Helpers.Users;
package body AWA.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Tests");

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   --  ------------------------------
   --  Cleanup after the test execution.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      pragma Unreferenced (T);
   begin
      AWA.Tests.Helpers.Users.Tear_Down;
   end Tear_Down;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Application.Close;
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      pragma Unreferenced (Add_Modules);
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new Test_Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
      Application.Start;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name => "files", Server => App.Files'Unchecked_Access);
      App.Add_Servlet (Name => "ajax", Server => App.Ajax'Unchecked_Access);
      App.Add_Servlet (Name => "measures", Server => App.Measures'Unchecked_Access);
--        App.Add_Servlet (Name => "auth", Server => App.Auth'Unchecked_Access);
--        App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Dump'Unchecked_Access);
      App.Add_Filter (Name => "measures", Filter => App.Measures'Unchecked_Access);
      App.Add_Filter (Name => "service", Filter => App.Service_Filter'Unchecked_Access);
   end Initialize_Filters;

end AWA.Tests;

-----------------------------------------------------------------------
--  AWA tests - AWA Tests Framework
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Task_Termination;
with Ada.Task_Identification;
with Ada.Exceptions;
with Ada.Unchecked_Deallocation;

with ASF.Server.Tests;

with Util.Log.Loggers;

with ASF.Tests;

with AWA.Applications.Factory;
with AWA.Tests.Helpers.Users;
package body AWA.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Tests");

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   --  ------------------------------
   --  Cleanup after the test execution.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      pragma Unreferenced (T);
   begin
      AWA.Tests.Helpers.Users.Tear_Down;
   end Tear_Down;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Application.Close;
         Free (Application);
      end if;
      ASF.Tests.Finish (Status);
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      pragma Unreferenced (Add_Modules);
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new Test_Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
      Application.Start;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name => "files", Server => App.Files'Unchecked_Access);
      App.Add_Servlet (Name => "ajax", Server => App.Ajax'Unchecked_Access);
      App.Add_Servlet (Name => "measures", Server => App.Measures'Unchecked_Access);
--        App.Add_Servlet (Name => "auth", Server => App.Auth'Unchecked_Access);
--        App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Dump'Unchecked_Access);
      App.Add_Filter (Name => "measures", Filter => App.Measures'Unchecked_Access);
      App.Add_Filter (Name => "service", Filter => App.Service_Filter'Unchecked_Access);
   end Initialize_Filters;

end AWA.Tests;

Call ASF.Tests.Finish (Status) to avoid memory leak in the unit test


-----------------------------------------------------------------------
--  asf-views -- Views
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ASF.Views package defines the abstractions to represent
--  an XHTML view that can be instantiated to create the JSF component
--  tree.  The ASF.Views are read only once and they are shared
--  by the JSF component trees that are instantiated from it.
--
--  The XHTML view is read using a SAX parser which creates nodes
--  and attributes to represent the view.
--
--  The ASF.Views is composed of nodes represented by Tag_Node
--  and attributes represented by Tag_Attribute.  In a sense, this
--  is very close to an XML DOM tree.
package ASF.Views is

   --  ------------------------------
   --  Source line information
   --  ------------------------------
   type File_Info (<>) is limited private;
   type File_Info_Access is access all File_Info;

   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access;

   --  Get the relative path name
   function Relative_Path (File : in File_Info) return String;

   type Line_Info is private;

   --  Get the line number
   function Line (Info : in Line_Info) return Natural;
   pragma Inline (Line);

   --  Get the source file
   function File (Info : in Line_Info) return String;
   pragma Inline (File);

private
   type File_Info (Length : Natural) is limited record
      Path         : String (1 .. Length);
      Relative_Pos : Natural;
   end record;

   NO_FILE : aliased File_Info := File_Info '(Length => 0, Path => "", Relative_Pos => 0);

   type Line_Info is record
      Line   : Natural := 0;
      Column : Natural := 0;
      File   : File_Info_Access := NO_FILE'Access;
   end record;

end ASF.Views;

-----------------------------------------------------------------------
--  asf-views -- Views
--  Copyright (C) 2009, 2010, 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ASF.Views package defines the abstractions to represent
--  an XHTML view that can be instantiated to create the JSF component
--  tree.  The ASF.Views are read only once and they are shared
--  by the JSF component trees that are instantiated from it.
--
--  The XHTML view is read using a SAX parser which creates nodes
--  and attributes to represent the view.
--
--  The ASF.Views is composed of nodes represented by Tag_Node
--  and attributes represented by Tag_Attribute.  In a sense, this
--  is very close to an XML DOM tree.
package ASF.Views is

   --  ------------------------------
   --  Source line information
   --  ------------------------------
   type File_Info (<>) is limited private;
   type File_Info_Access is access all File_Info;

   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access;

   --  Get the relative path name
   function Relative_Path (File : in File_Info) return String;

   type Line_Info is private;

   --  Get the line number
   function Line (Info : in Line_Info) return Natural;
   pragma Inline (Line);

   --  Get the source file
   function File (Info : in Line_Info) return String;
   pragma Inline (File);

private
   type File_Info (Length : Natural) is limited record
      Relative_Pos : Natural;
      Path         : String (1 .. Length);
   end record;

   NO_FILE : aliased File_Info := File_Info '(Length => 0, Path => "", Relative_Pos => 0);

   type Line_Info is record
      Line   : Natural := 0;
      Column : Natural := 0;
      File   : File_Info_Access := NO_FILE'Access;
   end record;

end ASF.Views;

Reorder the File_Info record

Reorder the File_Info record


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;

with MAT.Events;
with MAT.Types;
with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers");

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Manager_Base) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
   end Initialize;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Manager_Base)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message) is
      use type Interfaces.Unsigned_64;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : access MAT.Events.Frame_Info := Client.Frame;
   begin
      Frame.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_ID =>
                  Frame.Thread := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Natural (Count) loop
                     if Count < Frame.Depth then
                        Frame.Frame (I) := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      Frame.Time := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time_Sec), 32);
      Frame.Time := Frame.Time or Interfaces.Unsigned_64 (Time_Usec);
      Frame.Cur_Depth := Count;
   end Read_Probe;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      Log.Debug ("Dispatch message {0} - size {1}",
                 MAT.Types.Uint16'Image (Event),
                 Natural'Image (Msg.Size));

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Events.Insert (Event, Client.Frame.all);
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access,
                      Client.Frame.all, Msg);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);
      Frame : Message_Handler;

      procedure Add_Handler (Key : in String;
                             Element : in out Message_Handler) is
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler) is
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Reader_Maps.Has_Element (Pos) then
               Client.Readers.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
   begin
      Client.Read_Event_Definitions (Msg);

      Client.Frame := new MAT.Events.Frame_Info (512);
   exception
         when E : others =>
         Log.Error ("Exception while reading headers ", E);
   end Read_Headers;

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;

with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers");

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Manager_Base) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
   end Initialize;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Manager_Base)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message) is
      use type Interfaces.Unsigned_64;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Frame.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_ID =>
                  Frame.Thread := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop
                     if Count < Frame.Depth then
                        Frame.Frame (I) := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      Frame.Time := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time_Sec), 32);
      Frame.Time := Frame.Time or Interfaces.Unsigned_64 (Time_Usec);
      Frame.Cur_Depth := Count;
   end Read_Probe;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      Log.Debug ("Dispatch message {0} - size {1}",
                 MAT.Types.Uint16'Image (Event),
                 Natural'Image (Msg.Size));

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Events.Insert (Event, Client.Frame.all);
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access,
                      Client.Frame.all, Msg);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);
      Frame : Message_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Reader_Maps.Has_Element (Pos) then
               Client.Readers.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
   begin
      Client.Read_Event_Definitions (Msg);

      Client.Frame := new MAT.Events.Frame_Info (512);
   exception
         when E : others =>
         Log.Error ("Exception while reading headers ", E);
   end Read_Headers;

end MAT.Readers;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Finalization;

with System;

with Util.Streams.Buffered;

with MAT.Types;
with MAT.Events;
with MAT.Events.Targets;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message_Type is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;
   subtype Message is Message_Type;

   type Reader_List_Type is limited interface;
   type Reader_List_Type_Access is access all Reader_List_Type'Class;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (List   : in out Reader_List_Type;
                         Reader : in out Manager_Base'Class) is abstract;

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Finalization;

with System;

with Util.Streams.Buffered;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message_Type is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;
   subtype Message is Message_Type;

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

end MAT.Readers;

Remove the Reader_List_Type interface

Remove the Reader_List_Type interface


-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

   type Target_Type_Access is access all Target_Type'Class;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

end MAT.Targets;

-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

end MAT.Targets;

Change Target_Type to a private type and declare the Console function


-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  Copyright (C) 2009, 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Log.Loggers;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
               Name   : constant String := Util.Beans.Objects.To_String (N.Name);
            begin
               if Name'Length = 0 then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Name,
                                  Bundle => Bundle);
               end if;
            end;

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, App.all'Access,
                                                Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      Reader.Add_Mapping ("faces-config", AMapper'Access);
      Reader.Add_Mapping ("module", AMapper'Access);
      Reader.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Application_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Reader, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
end ASF.Applications.Main.Configs;

-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  Copyright (C) 2009, 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Log.Loggers;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, App.all'Access,
                                                Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      Reader.Add_Mapping ("faces-config", AMapper'Access);
      Reader.Add_Mapping ("module", AMapper'Access);
      Reader.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Application_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Reader, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
end ASF.Applications.Main.Configs;

Fix reading configuration and setup of application bundles