-----------------------------------------------------------------------
--  events-tests -- Unit tests for AWA events
--  Copyright (C) 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.Test_Caller;
with Util.Beans.Methods;
with Util.Log.Loggers;
with Util.Measures;
with Util.Concurrent.Counters;

with EL.Beans;
with EL.Expressions;
with EL.Contexts.Default;

with ASF.Applications;
with ASF.Servlets.Faces;

with AWA.Applications;
with AWA.Applications.Configs;
with AWA.Applications.Factory;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;

with AWA.Events.Queues;
with AWA.Events.Services;

package body AWA.Events.Services.Tests is

   use AWA.Events.Services;

   use Util.Log;

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

   package Event_Test_4 is new AWA.Events.Definition (Name => "event-test-4");
   package Event_Test_1 is new AWA.Events.Definition (Name => "event-test-1");
   package Event_Test_3 is new AWA.Events.Definition (Name => "event-test-3");
   package Event_Test_2 is new AWA.Events.Definition (Name => "event-test-2");
   package Event_Test_5 is new AWA.Events.Definition (Name => "event-test-5");

   package Caller is new Util.Test_Caller (Test, "Events.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Events.Get_Event_Name",
                       Test_Get_Event_Name'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Find_Event_Index",
                       Test_Find_Event'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Add_Action",
                       Test_Add_Action'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous",
                       Test_Dispatch_Synchronous'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Fifo",
                       Test_Dispatch_Fifo'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Persist",
                       Test_Dispatch_Persist'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous_Dyn",
                       Test_Dispatch_Synchronous_Dyn'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous_Raise",
                       Test_Dispatch_Synchronous_Raise'Access);
   end Add_Tests;

   type Action_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Count           : Natural := 0;
      Priority        : Integer := 0;
      Raise_Exception : Boolean := False;
   end record;
   type Action_Bean_Access is access all Action_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Action_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Action_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   function Get_Method_Bindings (From : in Action_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   procedure Event_Action (From  : in out Action_Bean;
                           Event : in AWA.Events.Module_Event'Class);

   function Create_Action_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   package Event_Action_Binding is
     new AWA.Events.Action_Method.Bind (Bean => Action_Bean,
                                        Method => Event_Action,
                                        Name   => "send");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Event_Action_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Action_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Action_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "priority" then
         From.Priority := Util.Beans.Objects.To_Integer (Value);
      elsif Name = "raise_exception" then
         From.Raise_Exception := Util.Beans.Objects.To_Boolean (Value);
      end if;
   end Set_Value;

   overriding
   function Get_Method_Bindings (From : in Action_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

   Action_Exception : exception;
   Global_Counter   : Util.Concurrent.Counters.Counter;

   procedure Event_Action (From  : in out Action_Bean;
                           Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Event);
   begin
      if From.Raise_Exception then
         raise Action_Exception with "Raising an exception from the event action bean";
      end if;
      From.Count := From.Count + 1;
      Util.Concurrent.Counters.Increment (Global_Counter);
   end Event_Action;

   function Create_Action_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Action_Bean_Access := new Action_Bean;
   begin
      return Result.all'Access;
   end Create_Action_Bean;

   --  ------------------------------
   --  Test searching an event name in the definition list.
   --  ------------------------------
   procedure Test_Find_Event (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, Integer (Event_Test_4.Kind),
                                Integer (Find_Event_Index ("event-test-4")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_5.Kind),
                                Integer (Find_Event_Index ("event-test-5")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_1.Kind),
                                Integer (Find_Event_Index ("event-test-1")), "Find_Event");
   end Test_Find_Event;

   --  ------------------------------
   --  Test the Get_Event_Type_Name internal operation.
   --  ------------------------------
   procedure Test_Get_Event_Name (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "event-test-1", Get_Event_Type_Name (Event_Test_1.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-2", Get_Event_Type_Name (Event_Test_2.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-3", Get_Event_Type_Name (Event_Test_3.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-4", Get_Event_Type_Name (Event_Test_4.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-5", Get_Event_Type_Name (Event_Test_5.Kind).all,
                                "Get_Event_Type_Name");
   end Test_Get_Event_Name;

   --  ------------------------------
   --  Test creation and initialization of event manager.
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      App     : constant AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
   begin
      Manager.Initialize (App.all'Access);
      T.Assert (Manager.Actions /= null, "Initialization failed");
   end Test_Initialize;

   --  ------------------------------
   --  Test adding an action.
   --  ------------------------------
   procedure Test_Add_Action (T : in out Test) is
      App     : constant AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Ctx     : EL.Contexts.Default.Default_Context;
      Action  : constant EL.Expressions.Method_Expression
        := EL.Expressions.Create_Expression ("#{a.send}", Ctx);
      Props   : EL.Beans.Param_Vectors.Vector;
      Queue   : Queue_Ref;
      Index   : constant Event_Index := Find_Event_Index ("event-test-4");
   begin
      Manager.Initialize (App.all'Access);

      Queue := AWA.Events.Queues.Create_Queue ("test", "fifo", Props, Ctx);
      Manager.Add_Queue (Queue);
      for I in 1 .. 10 loop
         Manager.Add_Action (Event  => "event-test-4",
                             Queue  => Queue,
                             Action => Action,
                             Params => Props);
         Util.Tests.Assert_Equals (T, 1, Integer (Manager.Actions (Index).Queues.Length),
                                   "Add_Action failed");
      end loop;

   end Test_Add_Action;

   --  ------------------------------
   --  Test dispatching events
   --  ------------------------------
   procedure Dispatch_Event (T            : in out Test;
                             Kind         : in Event_Index;
                             Expect_Count : in Natural;
                             Expect_Prio  : in Natural) is

      Factory : AWA.Applications.Factory.Application_Factory;
      Conf    : ASF.Applications.Config;
      Ctx     : aliased EL.Contexts.Default.Default_Context;
      Path    : constant String := Util.Tests.Get_Test_Path ("regtests/config/event-test.xml");
      Action  : aliased Action_Bean;
   begin
      Conf.Set ("database", Util.Tests.Get_Parameter ("database"));

      declare
         App   : aliased AWA.Tests.Test_Application;
         S     : Util.Measures.Stamp;
         Faces : aliased ASF.Servlets.Faces.Faces_Servlet;
         SC    : AWA.Services.Contexts.Service_Context;
      begin
         App.Initialize (Conf    => Conf,
                         Factory => Factory);
         App.Set_Global ("event_test",
           Util.Beans.Objects.To_Object (Action'Unchecked_Access,
             Util.Beans.Objects.STATIC));

         SC.Set_Context (App'Unchecked_Access, null);

         App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
         App.Register_Class ("AWA.Events.Tests.Event_Action",
                             Create_Action_Bean'Access);
         AWA.Applications.Configs.Read_Configuration (App     => App,
                                                      File    => Path,
                                                      Context => Ctx'Unchecked_Access);
         Util.Measures.Report (S, "Initialize AWA application and read config");
         App.Start;
         Util.Measures.Report (S, "Start event tasks");

         for I in 1 .. 100 loop
            declare
               Event : Module_Event;
            begin
               Event.Set_Event_Kind (Kind);
               Event.Set_Parameter ("prio", "3");
               Event.Set_Parameter ("template", "def");
               App.Send_Event (Event);
            end;
         end loop;
         Util.Measures.Report (S, "Send 100 events");
      end;

      Log.Info ("Action count: {0}", Natural'Image (Action.Count));
      Log.Info ("Priority: {0}", Integer'Image (Action.Priority));
      Util.Tests.Assert_Equals (T, Expect_Prio, Action.Priority,
                                "prio parameter not transmitted (global bean)");
      Util.Tests.Assert_Equals (T, Expect_Count, Action.Count,
                                "invalid number of calls for the action (global bean)");
   end Dispatch_Event;

   --  ------------------------------
   --  Test dispatching synchronous event to a global bean.
   --  ------------------------------
   procedure Test_Dispatch_Synchronous (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_1.Kind, 500, 3);
   end Test_Dispatch_Synchronous;

   --  ------------------------------
   --  Test dispatching event through a fifo queue.
   --  ------------------------------
   procedure Test_Dispatch_Fifo (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_2.Kind, 200, 3);
   end Test_Dispatch_Fifo;

   --  ------------------------------
   --  Test dispatching event through a database queue.
   --  ------------------------------
   procedure Test_Dispatch_Persist (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_5.Kind, 100, 3);
   end Test_Dispatch_Persist;

   --  ------------------------------
   --  Test dispatching synchronous event to a dynamic bean (created on demand).
   --  ------------------------------
   procedure Test_Dispatch_Synchronous_Dyn (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_3.Kind, 0, 0);
   end Test_Dispatch_Synchronous_Dyn;

   --  ------------------------------
   --  Test dispatching synchronous event to a dynamic bean and raise an exception in the action.
   --  ------------------------------
   procedure Test_Dispatch_Synchronous_Raise (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_4.Kind, 0, 0);
   end Test_Dispatch_Synchronous_Raise;

end AWA.Events.Services.Tests;

-----------------------------------------------------------------------
--  events-tests -- Unit tests for AWA events
--  Copyright (C) 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.Test_Caller;
with Util.Beans.Methods;
with Util.Log.Loggers;
with Util.Measures;
with Util.Concurrent.Counters;

with EL.Beans;
with EL.Expressions;
with EL.Contexts.Default;

with ASF.Applications;
with ASF.Servlets.Faces;

with AWA.Applications;
with AWA.Applications.Configs;
with AWA.Applications.Factory;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;

with AWA.Events.Queues;
with AWA.Events.Services;

package body AWA.Events.Services.Tests is

   use AWA.Events.Services;

   use Util.Log;

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

   package Event_Test_4 is new AWA.Events.Definition (Name => "event-test-4");
   package Event_Test_1 is new AWA.Events.Definition (Name => "event-test-1");
   package Event_Test_3 is new AWA.Events.Definition (Name => "event-test-3");
   package Event_Test_2 is new AWA.Events.Definition (Name => "event-test-2");
   package Event_Test_5 is new AWA.Events.Definition (Name => "event-test-5");

   package Caller is new Util.Test_Caller (Test, "Events.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Events.Get_Event_Name",
                       Test_Get_Event_Name'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Find_Event_Index",
                       Test_Find_Event'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Add_Action",
                       Test_Add_Action'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous",
                       Test_Dispatch_Synchronous'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Fifo",
                       Test_Dispatch_Fifo'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Persist",
                       Test_Dispatch_Persist'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous_Dyn",
                       Test_Dispatch_Synchronous_Dyn'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch_Synchronous_Raise",
                       Test_Dispatch_Synchronous_Raise'Access);
   end Add_Tests;

   type Action_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Count           : Natural := 0;
      Priority        : Integer := 0;
      Raise_Exception : Boolean := False;
   end record;
   type Action_Bean_Access is access all Action_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Action_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Action_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   function Get_Method_Bindings (From : in Action_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   procedure Event_Action (From  : in out Action_Bean;
                           Event : in AWA.Events.Module_Event'Class);

   function Create_Action_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   package Event_Action_Binding is
     new AWA.Events.Action_Method.Bind (Bean => Action_Bean,
                                        Method => Event_Action,
                                        Name   => "send");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Event_Action_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Action_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Action_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "priority" then
         From.Priority := Util.Beans.Objects.To_Integer (Value);
      elsif Name = "raise_exception" then
         From.Raise_Exception := Util.Beans.Objects.To_Boolean (Value);
      end if;
   end Set_Value;

   overriding
   function Get_Method_Bindings (From : in Action_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

   Action_Exception : exception;
   Global_Counter   : Util.Concurrent.Counters.Counter;

   procedure Event_Action (From  : in out Action_Bean;
                           Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Event);
   begin
      if From.Raise_Exception then
         raise Action_Exception with "Raising an exception from the event action bean";
      end if;
      From.Count := From.Count + 1;
      Util.Concurrent.Counters.Increment (Global_Counter);
   end Event_Action;

   function Create_Action_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Action_Bean_Access := new Action_Bean;
   begin
      return Result.all'Access;
   end Create_Action_Bean;

   --  ------------------------------
   --  Test searching an event name in the definition list.
   --  ------------------------------
   procedure Test_Find_Event (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, Integer (Event_Test_4.Kind),
                                Integer (Find_Event_Index ("event-test-4")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_5.Kind),
                                Integer (Find_Event_Index ("event-test-5")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_1.Kind),
                                Integer (Find_Event_Index ("event-test-1")), "Find_Event");
   end Test_Find_Event;

   --  ------------------------------
   --  Test the Get_Event_Type_Name internal operation.
   --  ------------------------------
   procedure Test_Get_Event_Name (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, "event-test-1", Get_Event_Type_Name (Event_Test_1.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-2", Get_Event_Type_Name (Event_Test_2.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-3", Get_Event_Type_Name (Event_Test_3.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-4", Get_Event_Type_Name (Event_Test_4.Kind).all,
                                "Get_Event_Type_Name");
      Util.Tests.Assert_Equals (T, "event-test-5", Get_Event_Type_Name (Event_Test_5.Kind).all,
                                "Get_Event_Type_Name");
   end Test_Get_Event_Name;

   --  ------------------------------
   --  Test creation and initialization of event manager.
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      App     : constant AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
   begin
      Manager.Initialize (App.all'Access);
      T.Assert (Manager.Actions /= null, "Initialization failed");
   end Test_Initialize;

   --  ------------------------------
   --  Test adding an action.
   --  ------------------------------
   procedure Test_Add_Action (T : in out Test) is
      App     : constant AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Ctx     : EL.Contexts.Default.Default_Context;
      Action  : constant EL.Expressions.Method_Expression
        := EL.Expressions.Create_Expression ("#{a.send}", Ctx);
      Props   : EL.Beans.Param_Vectors.Vector;
      Queue   : Queue_Ref;
      Index   : constant Event_Index := Find_Event_Index ("event-test-4");
   begin
      Manager.Initialize (App.all'Access);

      Queue := AWA.Events.Queues.Create_Queue ("test", "fifo", Props, Ctx);
      Manager.Add_Queue (Queue);
      for I in 1 .. 10 loop
         Manager.Add_Action (Event  => "event-test-4",
                             Queue  => Queue,
                             Action => Action,
                             Params => Props);
         Util.Tests.Assert_Equals (T, 1, Integer (Manager.Actions (Index).Queues.Length),
                                   "Add_Action failed");
      end loop;

   end Test_Add_Action;

   --  ------------------------------
   --  Test dispatching events
   --  ------------------------------
   procedure Dispatch_Event (T            : in out Test;
                             Kind         : in Event_Index;
                             Expect_Count : in Natural;
                             Expect_Prio  : in Natural) is

      Factory : AWA.Applications.Factory.Application_Factory;
      Conf    : ASF.Applications.Config;
      Ctx     : aliased EL.Contexts.Default.Default_Context;
      Path    : constant String := Util.Tests.Get_Test_Path ("regtests/config/event-test.xml");
      Action  : aliased Action_Bean;
   begin
      Conf.Set ("database", Util.Tests.Get_Parameter ("database"));

      declare
         App   : aliased AWA.Tests.Test_Application;
         S     : Util.Measures.Stamp;
         Faces : aliased ASF.Servlets.Faces.Faces_Servlet;
         SC    : AWA.Services.Contexts.Service_Context;
      begin
         App.Initialize (Conf    => Conf,
                         Factory => Factory);
         App.Set_Global ("event_test",
           Util.Beans.Objects.To_Object (Action'Unchecked_Access,
             Util.Beans.Objects.STATIC));

         SC.Set_Context (App'Unchecked_Access, null);

         App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
         App.Register_Class ("AWA.Events.Tests.Event_Action",
                             Create_Action_Bean'Access);
         AWA.Applications.Configs.Read_Configuration (App     => App,
                                                      File    => Path,
                                                      Context => Ctx'Unchecked_Access);
         Util.Measures.Report (S, "Initialize AWA application and read config");
         App.Start;
         Util.Measures.Report (S, "Start event tasks");

         for I in 1 .. 100 loop
            declare
               Event : Module_Event;
            begin
               Event.Set_Event_Kind (Kind);
               Event.Set_Parameter ("prio", "3");
               Event.Set_Parameter ("template", "def");
               App.Send_Event (Event);
            end;
         end loop;
         Util.Measures.Report (S, "Send 100 events");

         --  Wait for the dispatcher to process the events but do not wait more than 10 secs.
         for I in 1 .. 10_000 loop
            exit when Action.Count = Expect_Count;

            delay 0.1;
         end loop;
      end;

      Log.Info ("Action count: {0}", Natural'Image (Action.Count));
      Log.Info ("Priority: {0}", Integer'Image (Action.Priority));
      Util.Tests.Assert_Equals (T, Expect_Count, Action.Count,
                                "invalid number of calls for the action (global bean)");
      Util.Tests.Assert_Equals (T, Expect_Prio, Action.Priority,
                                "prio parameter not transmitted (global bean)");
   end Dispatch_Event;

   --  ------------------------------
   --  Test dispatching synchronous event to a global bean.
   --  ------------------------------
   procedure Test_Dispatch_Synchronous (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_1.Kind, 500, 3);
   end Test_Dispatch_Synchronous;

   --  ------------------------------
   --  Test dispatching event through a fifo queue.
   --  ------------------------------
   procedure Test_Dispatch_Fifo (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_2.Kind, 200, 3);
   end Test_Dispatch_Fifo;

   --  ------------------------------
   --  Test dispatching event through a database queue.
   --  ------------------------------
   procedure Test_Dispatch_Persist (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_5.Kind, 100, 3);
   end Test_Dispatch_Persist;

   --  ------------------------------
   --  Test dispatching synchronous event to a dynamic bean (created on demand).
   --  ------------------------------
   procedure Test_Dispatch_Synchronous_Dyn (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_3.Kind, 0, 0);
   end Test_Dispatch_Synchronous_Dyn;

   --  ------------------------------
   --  Test dispatching synchronous event to a dynamic bean and raise an exception in the action.
   --  ------------------------------
   procedure Test_Dispatch_Synchronous_Raise (T : in out Test) is
   begin
      T.Dispatch_Event (Event_Test_4.Kind, 0, 0);
   end Test_Dispatch_Synchronous_Raise;

end AWA.Events.Services.Tests;

Fix random failures that could happen because we check for the action result too quickly. Wait for the events to have been dispatched.


-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 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 ASF.Applications;

with Security.Permissions;

with AWA.Modules;
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

   --  Initialize the wikis module.
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

private

   type Wiki_Module is new AWA.Modules.Module with null record;

end AWA.Wikis.Modules;

-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 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 ASF.Applications;

with Security.Permissions;

with ADO;
with AWA.Modules;
with AWA.Wikis.Models;
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

   --  Initialize the wikis module.
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

   --  Save the wiki space.
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Load the wiki space.
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier);

private

   type Wiki_Module is new AWA.Modules.Module with null record;

end AWA.Wikis.Modules;

Declare Save_Wiki_Space and Load_Wiki_Space procedures


-----------------------------------------------------------------------
--  html.messages -- Faces messages
--  Copyright (C) 2011, 2012, 2013, 2017 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 ASF.Utils;
with ASF.Applications.Messages;
with ASF.Components.Base;

--  The ASF.Components.Html.Messages package implements the h:message
--  and h:messages components.
package body ASF.Components.Html.Messages is

   use ASF.Components.Base;
   use ASF.Applications.Messages;

   MSG_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;

   FATAL_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   ERROR_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   WARN_ATTRIBUTE_NAMES   : Util.Strings.String_Set.Set;

   INFO_ATTRIBUTE_NAMES   : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Check whether the UI component whose name is given in Name has some messages
   --  associated with it.
   --  ------------------------------
   function Has_Message (Name : in Util.Beans.Objects.Object) return Util.Beans.Objects.Object is
      Context  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return Util.Beans.Objects.To_Object (False);
      end if;
      declare
         Id   : constant String := Util.Beans.Objects.To_String (Name);
         Msgs : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         return Util.Beans.Objects.To_Object (Applications.Messages.Vectors.Has_Element (Msgs));
      end;
   end Has_Message;

   --  ------------------------------
   --  Write a single message enclosed by the tag represented by Tag.
   --  ------------------------------
   procedure Write_Message (UI           : in UIHtmlComponent'Class;
                            Message      : in ASF.Applications.Messages.Message;
                            Mode         : in Message_Mode;
                            Show_Detail  : in Boolean;
                            Show_Summary : in Boolean;
                            Context      : in out Faces_Context'Class) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
   begin
      case Mode is
         when SPAN_NO_STYLE =>
            Writer.Start_Element ("span");

         when SPAN =>
            Writer.Start_Element ("span");
            UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);

         when LIST =>
            Writer.Start_Element ("li");

         when TABLE =>
            Writer.Start_Element ("tr");

      end case;

      case Get_Severity (Message) is
         when FATAL =>
            UI.Render_Attributes (Context, FATAL_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when ERROR =>
            UI.Render_Attributes (Context, ERROR_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when WARN =>
            UI.Render_Attributes (Context, WARN_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when INFO | NONE =>
            UI.Render_Attributes (Context, INFO_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

      end case;

      if Mode = TABLE then
         Writer.Start_Element ("td");
      end if;
      if Show_Summary then
         Writer.Write_Text (Get_Summary (Message));
      end if;
      if Show_Detail then
         Writer.Write_Text (Get_Detail (Message));
      end if;
      case Mode is
         when SPAN | SPAN_NO_STYLE =>
            Writer.End_Element ("span");

         when LIST =>
            Writer.End_Element ("li");

         when TABLE =>
            Writer.End_Element ("td");
            Writer.End_Element ("tr");

      end case;
   end Write_Message;

   --  ------------------------------
   --  Render a list of messages each of them being enclosed by the Tag element.
   --  ------------------------------
   procedure Write_Messages (UI       : in UIHtmlComponent'Class;
                             Mode     : in Message_Mode;
                             Context  : in out Faces_Context'Class;
                             Messages : in out ASF.Applications.Messages.Vectors.Cursor) is

      procedure Process_Message (Message : in ASF.Applications.Messages.Message);

      Show_Detail  : constant Boolean := UI.Get_Attribute ("showDetail", Context, False);
      Show_Summary : constant Boolean := UI.Get_Attribute ("showSummary", Context, True);

      procedure Process_Message (Message : in ASF.Applications.Messages.Message) is
      begin
         Write_Message (UI, Message, Mode, Show_Detail, Show_Summary, Context);
      end Process_Message;

   begin
      while ASF.Applications.Messages.Vectors.Has_Element (Messages) loop
         Vectors.Query_Element (Messages, Process_Message'Access);
         Vectors.Next (Messages);
      end loop;
   end Write_Messages;

   --  ------------------------------
   --  Encode the begining of the h:message component.
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIMessage;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Name     : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "for");
         Messages : ASF.Applications.Messages.Vectors.Cursor;
      begin
         --  No specification of 'for' attribute, render the global messages.
         if Util.Beans.Objects.Is_Null (Name) then
            Messages := Context.Get_Messages ("");
         else
            declare
               Id     : constant String := Util.Beans.Objects.To_String (Name);
               Target : constant UIComponent_Access := UI.Find (Id => Id);
            begin
               --  If the component does not exist, report an error in the logs.
               if Target = null then
                  UI.Log_Error ("Cannot find component {0}", Id);
               else
                  Messages := Context.Get_Messages (Id);
               end if;
            end;
         end if;

         --  If we have some message, render the first one (as specified by <h:message>).
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            declare
               Show_Detail  : constant Boolean := UI.Get_Attribute ("showDetail", Context, True);
               Show_Summary : constant Boolean := UI.Get_Attribute ("showSummary", Context, False);
            begin
               Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                              SPAN, Show_Detail, Show_Summary, Context);
            end;
         end if;
      end;
   end Encode_Begin;

   --  Encode the end of the h:message component.
   procedure Encode_End (UI      : in UIMessage;
                         Context : in out Faces_Context'Class) is
   begin
      null;
   end Encode_End;

   --  ------------------------------
   --  Encode the begining of the h:message component.
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIMessages;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         declare
            Name     : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "for");
            Messages : ASF.Applications.Messages.Vectors.Cursor;
         begin
            --  No specification of 'for' attribute, render the global messages.
            if Util.Beans.Objects.Is_Null (Name) then
               if UI.Get_Attribute ("globalOnly", Context) then
                  Messages := Context.Get_Messages ("");
               end if;
            else
               declare
                  Id     : constant String := Util.Beans.Objects.To_String (Name);
                  Target : constant UIComponent_Access := UI.Find (Id => Id);
               begin
                  --  If the component does not exist, report an error in the logs.
                  if Target = null then
                     UI.Log_Error ("Cannot find component {0}", Id);
                  else
                     Messages := Context.Get_Messages (Id);
                  end if;
               end;
            end if;

            --  If we have some message, render them.
            if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
               declare
                  Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
                  Layout : constant String
                    := Util.Beans.Objects.To_String (UI.Get_Attribute (Context, "layout"));
               begin
                  if Layout = "table" then
                     Writer.Start_Element ("table");
                     UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);
                     Write_Messages (UI, TABLE, Context, Messages);
                     Writer.End_Element ("table");
                  else
                     Writer.Start_Element ("ul");
                     UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);
                     Write_Messages (UI, LIST, Context, Messages);
                     Writer.End_Element ("ul");
                  end if;
               end;
            end if;
         end;
      end if;
   end Encode_Begin;

   --  Encode the end of the h:message component.
   procedure Encode_End (UI      : in UIMessages;
                         Context : in out Faces_Context'Class) is
   begin
      null;
   end Encode_End;

   FATAL_CLASS_ATTR       : aliased constant String := "fatalClass";
   FATAL_STYLE_CLASS_ATTR : aliased constant String := "fatalStyle";

   ERROR_CLASS_ATTR       : aliased constant String := "errorClass";
   ERROR_STYLE_CLASS_ATTR : aliased constant String := "errorStyle";

   WARN_CLASS_ATTR        : aliased constant String := "warnClass";
   WARN_STYLE_CLASS_ATTR  : aliased constant String := "warnStyle";

   INFO_CLASS_ATTR        : aliased constant String := "infoClass";
   INFO_STYLE_CLASS_ATTR  : aliased constant String := "infoStyle";

begin
   ASF.Utils.Set_Text_Attributes (MSG_ATTRIBUTE_NAMES);
--     ASF.Utils.Set_Text_Attributes (WARN_ATTRIBUTE_NAMES);
--     ASF.Utils.Set_Text_Attributes (INFO_ATTRIBUTE_NAMES);
--
--     ASF.Utils.Set_Text_Attributes (FATAL_ATTRIBUTE_NAMES);
   FATAL_ATTRIBUTE_NAMES.Insert (FATAL_CLASS_ATTR'Access);
   FATAL_ATTRIBUTE_NAMES.Insert (FATAL_STYLE_CLASS_ATTR'Access);

   ERROR_ATTRIBUTE_NAMES.Insert (ERROR_CLASS_ATTR'Access);
   ERROR_ATTRIBUTE_NAMES.Insert (ERROR_STYLE_CLASS_ATTR'Access);

   WARN_ATTRIBUTE_NAMES.Insert (WARN_CLASS_ATTR'Access);
   WARN_ATTRIBUTE_NAMES.Insert (WARN_STYLE_CLASS_ATTR'Access);

   INFO_ATTRIBUTE_NAMES.Insert (INFO_CLASS_ATTR'Access);
   INFO_ATTRIBUTE_NAMES.Insert (INFO_STYLE_CLASS_ATTR'Access);
end ASF.Components.Html.Messages;

-----------------------------------------------------------------------
--  html.messages -- Faces messages
--  Copyright (C) 2011, 2012, 2013, 2017 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 ASF.Utils;
with ASF.Applications.Messages;
with ASF.Components.Base;

--  The ASF.Components.Html.Messages package implements the h:message
--  and h:messages components.
package body ASF.Components.Html.Messages is

   use ASF.Components.Base;
   use ASF.Applications.Messages;

   MSG_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;

   FATAL_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   ERROR_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   WARN_ATTRIBUTE_NAMES   : Util.Strings.String_Set.Set;

   INFO_ATTRIBUTE_NAMES   : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Check whether the UI component whose name is given in Name has some messages
   --  associated with it.
   --  ------------------------------
   function Has_Message (Name : in Util.Beans.Objects.Object) return Util.Beans.Objects.Object is
      Context  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return Util.Beans.Objects.To_Object (False);
      end if;
      declare
         Id   : constant String := Util.Beans.Objects.To_String (Name);
         Msgs : constant ASF.Applications.Messages.Vectors.Cursor := Context.Get_Messages (Id);
      begin
         return Util.Beans.Objects.To_Object (Applications.Messages.Vectors.Has_Element (Msgs));
      end;
   end Has_Message;

   --  ------------------------------
   --  Write a single message enclosed by the tag represented by Tag.
   --  ------------------------------
   procedure Write_Message (UI           : in UIHtmlComponent'Class;
                            Message      : in ASF.Applications.Messages.Message;
                            Mode         : in Message_Mode;
                            Show_Detail  : in Boolean;
                            Show_Summary : in Boolean;
                            Context      : in out Faces_Context'Class) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
   begin
      case Mode is
         when SPAN_NO_STYLE =>
            Writer.Start_Element ("span");

         when SPAN =>
            Writer.Start_Element ("span");
            UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);

         when LIST =>
            Writer.Start_Element ("li");

         when TABLE =>
            Writer.Start_Element ("tr");

      end case;

      case Get_Severity (Message) is
         when FATAL =>
            UI.Render_Attributes (Context, FATAL_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when ERROR =>
            UI.Render_Attributes (Context, ERROR_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when WARN =>
            UI.Render_Attributes (Context, WARN_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

         when INFO | NONE =>
            UI.Render_Attributes (Context, INFO_ATTRIBUTE_NAMES, Writer,
                                  Write_Id => Mode /= SPAN_NO_STYLE);

      end case;

      if Mode = TABLE then
         Writer.Start_Element ("td");
      end if;
      if Show_Summary then
         Writer.Write_Text (Get_Summary (Message));
      end if;
      if Show_Detail then
         Writer.Write_Text (Get_Detail (Message));
      end if;
      case Mode is
         when SPAN | SPAN_NO_STYLE =>
            Writer.End_Element ("span");

         when LIST =>
            Writer.End_Element ("li");

         when TABLE =>
            Writer.End_Element ("td");
            Writer.End_Element ("tr");

      end case;
   end Write_Message;

   --  ------------------------------
   --  Render a list of messages each of them being enclosed by the Tag element.
   --  ------------------------------
   procedure Write_Messages (UI       : in UIHtmlComponent'Class;
                             Mode     : in Message_Mode;
                             Context  : in out Faces_Context'Class;
                             Messages : in out ASF.Applications.Messages.Vectors.Cursor) is

      procedure Process_Message (Message : in ASF.Applications.Messages.Message);

      Show_Detail  : constant Boolean := UI.Get_Attribute ("showDetail", Context, False);
      Show_Summary : constant Boolean := UI.Get_Attribute ("showSummary", Context, True);

      procedure Process_Message (Message : in ASF.Applications.Messages.Message) is
      begin
         Write_Message (UI, Message, Mode, Show_Detail, Show_Summary, Context);
      end Process_Message;

   begin
      while ASF.Applications.Messages.Vectors.Has_Element (Messages) loop
         Vectors.Query_Element (Messages, Process_Message'Access);
         Vectors.Next (Messages);
      end loop;
   end Write_Messages;

   --  ------------------------------
   --  Encode the begining of the h:message component.
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIMessage;
                           Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Name     : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "for");
         Messages : ASF.Applications.Messages.Vectors.Cursor;
      begin
         --  No specification of 'for' attribute, render the global messages.
         if Util.Beans.Objects.Is_Null (Name) then
            Messages := Context.Get_Messages ("");
         else
            declare
               Id     : constant String := Util.Beans.Objects.To_String (Name);
               Target : constant UIComponent_Access := UI.Find (Id => Id);
            begin
               --  If the component does not exist, report an error in the logs.
               if Target = null then
                  UI.Log_Error ("Cannot find component '{0}'", Id);
               else
                  Messages := Context.Get_Messages (Id);
               end if;
            end;
         end if;

         --  If we have some message, render the first one (as specified by <h:message>).
         if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
            declare
               Show_Detail  : constant Boolean := UI.Get_Attribute ("showDetail", Context, True);
               Show_Summary : constant Boolean := UI.Get_Attribute ("showSummary", Context, False);
            begin
               Write_Message (UI, ASF.Applications.Messages.Vectors.Element (Messages),
                              SPAN, Show_Detail, Show_Summary, Context);
            end;
         end if;
      end;
   end Encode_Begin;

   --  Encode the end of the h:message component.
   procedure Encode_End (UI      : in UIMessage;
                         Context : in out Faces_Context'Class) is
   begin
      null;
   end Encode_End;

   --  ------------------------------
   --  Encode the begining of the h:message component.
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIMessages;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         declare
            Name     : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, "for");
            Messages : ASF.Applications.Messages.Vectors.Cursor;
         begin
            --  No specification of 'for' attribute, render the global messages.
            if Util.Beans.Objects.Is_Null (Name) then
               if UI.Get_Attribute ("globalOnly", Context) then
                  Messages := Context.Get_Messages ("");
               end if;
            else
               declare
                  Id     : constant String := Util.Beans.Objects.To_String (Name);
                  Target : constant UIComponent_Access := UI.Find (Id => Id);
               begin
                  --  If the component does not exist, report an error in the logs.
                  if Target = null then
                     UI.Log_Error ("Cannot find component '{0}'", Id);
                  else
                     Messages := Context.Get_Messages (Id);
                  end if;
               end;
            end if;

            --  If we have some message, render them.
            if ASF.Applications.Messages.Vectors.Has_Element (Messages) then
               declare
                  Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
                  Layout : constant String
                    := Util.Beans.Objects.To_String (UI.Get_Attribute (Context, "layout"));
               begin
                  if Layout = "table" then
                     Writer.Start_Element ("table");
                     UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);
                     Write_Messages (UI, TABLE, Context, Messages);
                     Writer.End_Element ("table");
                  else
                     Writer.Start_Element ("ul");
                     UI.Render_Attributes (Context, MSG_ATTRIBUTE_NAMES, Writer);
                     Write_Messages (UI, LIST, Context, Messages);
                     Writer.End_Element ("ul");
                  end if;
               end;
            end if;
         end;
      end if;
   end Encode_Begin;

   --  Encode the end of the h:message component.
   procedure Encode_End (UI      : in UIMessages;
                         Context : in out Faces_Context'Class) is
   begin
      null;
   end Encode_End;

   FATAL_CLASS_ATTR       : aliased constant String := "fatalClass";
   FATAL_STYLE_CLASS_ATTR : aliased constant String := "fatalStyle";

   ERROR_CLASS_ATTR       : aliased constant String := "errorClass";
   ERROR_STYLE_CLASS_ATTR : aliased constant String := "errorStyle";

   WARN_CLASS_ATTR        : aliased constant String := "warnClass";
   WARN_STYLE_CLASS_ATTR  : aliased constant String := "warnStyle";

   INFO_CLASS_ATTR        : aliased constant String := "infoClass";
   INFO_STYLE_CLASS_ATTR  : aliased constant String := "infoStyle";

begin
   ASF.Utils.Set_Text_Attributes (MSG_ATTRIBUTE_NAMES);
--     ASF.Utils.Set_Text_Attributes (WARN_ATTRIBUTE_NAMES);
--     ASF.Utils.Set_Text_Attributes (INFO_ATTRIBUTE_NAMES);
--
--     ASF.Utils.Set_Text_Attributes (FATAL_ATTRIBUTE_NAMES);
   FATAL_ATTRIBUTE_NAMES.Insert (FATAL_CLASS_ATTR'Access);
   FATAL_ATTRIBUTE_NAMES.Insert (FATAL_STYLE_CLASS_ATTR'Access);

   ERROR_ATTRIBUTE_NAMES.Insert (ERROR_CLASS_ATTR'Access);
   ERROR_ATTRIBUTE_NAMES.Insert (ERROR_STYLE_CLASS_ATTR'Access);

   WARN_ATTRIBUTE_NAMES.Insert (WARN_CLASS_ATTR'Access);
   WARN_ATTRIBUTE_NAMES.Insert (WARN_STYLE_CLASS_ATTR'Access);

   INFO_ATTRIBUTE_NAMES.Insert (INFO_CLASS_ATTR'Access);
   INFO_ATTRIBUTE_NAMES.Insert (INFO_STYLE_CLASS_ATTR'Access);
end ASF.Components.Html.Messages;

Add quotes arround component name in error message to better identify the component name from the message itself


-----------------------------------------------------------------------
--  gen-model-xmi -- UML-XMI model
--  Copyright (C) 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.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Vectors;

with Util.Beans.Objects;

with Gen.Model.Tables;
package Gen.Model.XMI is

   use Ada.Strings.Unbounded;

   type Element_Type is (XMI_UNKNOWN,
                         XMI_PACKAGE,
                         XMI_CLASS,
                         XMI_ASSOCIATION,
                         XMI_ASSOCIATION_END,
                         XMI_ATTRIBUTE,
                         XMI_OPERATION,
                         XMI_ENUMERATION,
                         XMI_ENUMERATION_LITERAL,
                         XMI_TAGGED_VALUE,
                         XMI_TAG_DEFINITION,
                         XMI_DATA_TYPE,
                         XMI_STEREOTYPE,
                         XMI_COMMENT);

   --  Defines the visibility of an element (a package, class, attribute, operation).
   type Visibility_Type is (VISIBILITY_PUBLIC,
                            VISIBILITY_PACKAGE,
                            VISIBILITY_PROTECTED,
                            VISIBILITY_PRIVATE);

   --  Defines whether an attribute or association changes.
   type Changeability_Type is (CHANGEABILITY_INSERT,
                               CHANGEABILITY_CHANGEABLE,
                               CHANGEABILITY_FROZEN);

   type Model_Element;
   type Tagged_Value_Element;
   type Model_Element_Access is access all Model_Element'Class;
   type Tagged_Value_Element_Access is access all Tagged_Value_Element'Class;

   --  Define a list of model elements.
   package Model_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Model_Element_Access);

   subtype Model_Vector is Model_Vectors.Vector;

   subtype Model_Cursor is Model_Vectors.Cursor;

   --  Define a map to search an element from its XMI ID.
   package Model_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Model_Element_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Model_Map_Cursor is Model_Map.Cursor;
   type Model_Map_Access is access all Model_Map.Map;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : in Model_Map_Cursor) return Boolean
                         renames Model_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : in Model_Map_Cursor) return Model_Element_Access
                     renames Model_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Model_Map_Cursor)
                   renames Model_Map.Next;

   --  Iterate on the model element of the type <tt>On</tt> and execute the <tt>Process</tt>
   --  procedure.
   procedure Iterate (Model   : in Model_Map.Map;
                      On      : in Element_Type;
                      Process : not null access procedure (Id   : in Unbounded_String;
                                                           Node : in Model_Element_Access));

   --  Generic procedure to iterate over the XMI elements of a vector
   --  and having the entity name <b>name</b>.
   generic
      type T (<>) is limited private;
   procedure Iterate_Elements (Closure : in out T;
                               List    : in Model_Vector;
                               Process : not null access
                                 procedure (Closure : in out T;
                                            Node    : in Model_Element_Access));

   --  Map of UML models indexed on the model name.
   package UML_Model_Map is new
     Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                 Element_Type    => Model_Map.Map,
                                 Hash            => Ada.Strings.Unbounded.Hash,
                                 Equivalent_Keys => "=",
                                 "="             => Model_Map."=");
   subtype UML_Model is UML_Model_Map.Map;

   type Search_Type is (BY_NAME, BY_ID);

   --  Find the model element with the given XMI id.
   --  Returns null if the model element is not found.
   function Find (Model : in Model_Map.Map;
                  Key   : in String;
                  Mode  : in Search_Type := BY_ID) return Model_Element_Access;

   --  Find the model element within all loaded UML models.
   --  Returns null if the model element is not found.
   function Find (Model   : in UML_Model;
                  Current : in Model_Map.Map;
                  Id      : in Ada.Strings.Unbounded.Unbounded_String)
                  return Model_Element_Access;

   --  Dump the XMI model elements.
   procedure Dump (Map : in Model_Map.Map);

   --  Reconcile all the UML model elements by resolving all the references to UML elements.
   procedure Reconcile (Model : in out UML_Model);

   --  ------------------------------
   --  Model Element
   --  ------------------------------
   type Model_Element (Model : Model_Map_Access) is abstract new Definition with record
      --  Element XMI id.
      XMI_Id        : Ada.Strings.Unbounded.Unbounded_String;

      --  List of tagged values for the element.
      Tagged_Values : Model_Vector;

      --  Elements contained.
      Elements      : Model_Vector;

      --  Stereotypes associated with the element.
      Stereotypes   : Model_Vector;

      --  The parent model element;
      Parent        : Model_Element_Access;
   end record;

   --  Get the element type.
   function Get_Type (Node : in Model_Element) return Element_Type is abstract;

   --  Reconcile the element by resolving the references to other elements in the model.
   procedure Reconcile (Node  : in out Model_Element;
                        Model : in UML_Model);

   --  Find the element with the given name.  If the name is a qualified name, navigate
   --  down the package/class to find the appropriate element.
   --  Returns null if the element was not found.
   function Find (Node : in Model_Element;
                  Name : in String) return Model_Element_Access;

   --  Set the model name.
   procedure Set_Name (Node  : in out Model_Element;
                       Value : in Util.Beans.Objects.Object);

   --  Set the model XMI unique id.
   procedure Set_XMI_Id (Node  : in out Model_Element;
                         Value : in Util.Beans.Objects.Object);

   --  Find the tag value element with the given name.
   --  Returns null if there is no such tag.
   function Find_Tag_Value (Node : in Model_Element;
                            Name : in String) return Tagged_Value_Element_Access;

   --  Get the documentation and comment associated with the model element.
   --  Returns the empty string if there is no comment.
   function Get_Comment (Node : in Model_Element) return String;

   --  Get the full qualified name for the element.
   function Get_Qualified_Name (Node : in Model_Element) return String;

   --  Find from the model file identified by <tt>Name</tt>, the model element with the
   --  identifier or name represented by <tt>Key</tt>.
   --  Returns null if the model element is not found.
   generic
      type Element_Type is new Model_Element with private;
      type Element_Type_Access is access all Element_Type'Class;
   function Find_Element (Model   : in UML_Model;
                          Name    : in String;
                          Key     : in String;
                          Mode    : in Search_Type := BY_ID)
                          return Element_Type_Access;

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Ref_Type_Element is new Model_Element with record
      Href : Unbounded_String;
      Ref  : Model_Element_Access;
   end record;
   type Ref_Type_Element_Access is access all Ref_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Ref_Type_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Ref_Type_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Data_Type_Element is new Model_Element with null record;
   type Data_Type_Element_Access is access all Data_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Data_Type_Element) return Element_Type;

   --  ------------------------------
   --  Enum
   --  ------------------------------
   type Enum_Element is new Model_Element with null record;
   type Enum_Element_Access is access all Enum_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Enum_Element) return Element_Type;

   procedure Add_Literal (Node : in out Enum_Element;
                          Id   : in Util.Beans.Objects.Object;
                          Name : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Literal
   --  ------------------------------
   --  The literal describes a possible value for an enum.
   type Literal_Element is new Model_Element with null record;
   type Literal_Element_Access is access all Literal_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Literal_Element) return Element_Type;

   --  ------------------------------
   --  Stereotype
   --  ------------------------------

   type Stereotype_Element is new Model_Element with null record;
   type Stereotype_Element_Access is access all Stereotype_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Stereotype_Element) return Element_Type;

   --  Returns True if the model element has the stereotype with the given name.
   function Has_Stereotype (Node       : in Model_Element'Class;
                            Stereotype : in Stereotype_Element_Access) return Boolean;

   --  ------------------------------
   --  Comment
   --  ------------------------------
   type Comment_Element is new Model_Element with record
      Text       : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Comment_Element_Access is access all Comment_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Comment_Element) return Element_Type;

   --  ------------------------------
   --  An operation
   --  ------------------------------
   type Operation_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Operation_Element_Access is access all Operation_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Operation_Element) return Element_Type;

   --  ------------------------------
   --  An attribute
   --  ------------------------------
   type Attribute_Element is new Model_Element with record
      Ref_Id             : Ada.Strings.Unbounded.Unbounded_String;
      Data_Type          : Data_Type_Element_Access;
      Visibility         : Visibility_Type := VISIBILITY_PUBLIC;
      Changeability      : Changeability_Type := CHANGEABILITY_CHANGEABLE;
      Initial_Value      : Util.Beans.Objects.Object;
      Multiplicity_Lower : Integer := 0;
      Multiplicity_Upper : Integer := 1;
   end record;
   type Attribute_Element_Access is access all Attribute_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Attribute_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Attribute_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  An association end
   --  ------------------------------
   type Association_End_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_End_Element_Access is access all Association_End_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_End_Element) return Element_Type;

   --  ------------------------------
   --  An association
   --  ------------------------------
   type Association_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_Element_Access is access all Association_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_Element) return Element_Type;

   --  ------------------------------
   --  Tag Definition
   --  ------------------------------
   TAG_DOCUMENTATION : constant String := "documentation";
   TAG_AUTHOR        : constant String := "author";

   type Tag_Definition_Element is new Model_Element with record
      Multiplicity_Lower : Natural := 0;
      Multiplicity_Upper : Natural := 0;
   end record;
   type Tag_Definition_Element_Access is access all Tag_Definition_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tag_Definition_Element) return Element_Type;

   --  ------------------------------
   --  Tagged value
   --  ------------------------------
   type Tagged_Value_Element is new Model_Element with record
      Value      : Ada.Strings.Unbounded.Unbounded_String;
      Value_Type : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Tag_Def    : Tag_Definition_Element_Access;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tagged_Value_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Tagged_Value_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  A class
   --  ------------------------------
   type Class_Element is new Model_Element with record
      Operations   : Model_Vector;
      Attributes   : Model_Vector;
      Associations : Model_Vector;
      Visibility   : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Class_Element_Access is access all Class_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Class_Element) return Element_Type;

   --  ------------------------------
   --  A package
   --  ------------------------------
   type Package_Element;
   type Package_Element_Access is access all Package_Element'Class;

   type Package_Element is new Model_Element with record
      Classes      : Model_Vector;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Package_Element) return Element_Type;

end Gen.Model.XMI;

-----------------------------------------------------------------------
--  gen-model-xmi -- UML-XMI model
--  Copyright (C) 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.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Vectors;

with Util.Beans.Objects;

with Gen.Model.Tables;
package Gen.Model.XMI is

   use Ada.Strings.Unbounded;

   type Element_Type is (XMI_UNKNOWN,
                         XMI_PACKAGE,
                         XMI_CLASS,
                         XMI_ASSOCIATION,
                         XMI_ASSOCIATION_END,
                         XMI_ATTRIBUTE,
                         XMI_OPERATION,
                         XMI_ENUMERATION,
                         XMI_ENUMERATION_LITERAL,
                         XMI_TAGGED_VALUE,
                         XMI_TAG_DEFINITION,
                         XMI_DATA_TYPE,
                         XMI_STEREOTYPE,
                         XMI_COMMENT);

   --  Defines the visibility of an element (a package, class, attribute, operation).
   type Visibility_Type is (VISIBILITY_PUBLIC,
                            VISIBILITY_PACKAGE,
                            VISIBILITY_PROTECTED,
                            VISIBILITY_PRIVATE);

   --  Defines whether an attribute or association changes.
   type Changeability_Type is (CHANGEABILITY_INSERT,
                               CHANGEABILITY_CHANGEABLE,
                               CHANGEABILITY_FROZEN);

   type Model_Element;
   type Tagged_Value_Element;
   type Model_Element_Access is access all Model_Element'Class;
   type Tagged_Value_Element_Access is access all Tagged_Value_Element'Class;

   --  Define a list of model elements.
   package Model_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Model_Element_Access);

   subtype Model_Vector is Model_Vectors.Vector;

   subtype Model_Cursor is Model_Vectors.Cursor;

   --  Define a map to search an element from its XMI ID.
   package Model_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Model_Element_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Model_Map_Cursor is Model_Map.Cursor;
   type Model_Map_Access is access all Model_Map.Map;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : in Model_Map_Cursor) return Boolean
                         renames Model_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : in Model_Map_Cursor) return Model_Element_Access
                     renames Model_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Model_Map_Cursor)
                   renames Model_Map.Next;

   --  Iterate on the model element of the type <tt>On</tt> and execute the <tt>Process</tt>
   --  procedure.
   procedure Iterate (Model   : in Model_Map.Map;
                      On      : in Element_Type;
                      Process : not null access procedure (Id   : in Unbounded_String;
                                                           Node : in Model_Element_Access));

   --  Generic procedure to iterate over the XMI elements of a vector
   --  and having the entity name <b>name</b>.
   generic
      type T (<>) is limited private;
   procedure Iterate_Elements (Closure : in out T;
                               List    : in Model_Vector;
                               Process : not null access
                                 procedure (Closure : in out T;
                                            Node    : in Model_Element_Access));

   --  Map of UML models indexed on the model name.
   package UML_Model_Map is new
     Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                 Element_Type    => Model_Map.Map,
                                 Hash            => Ada.Strings.Unbounded.Hash,
                                 Equivalent_Keys => "=",
                                 "="             => Model_Map."=");
   subtype UML_Model is UML_Model_Map.Map;

   type Search_Type is (BY_NAME, BY_ID);

   --  Find the model element with the given XMI id.
   --  Returns null if the model element is not found.
   function Find (Model : in Model_Map.Map;
                  Key   : in String;
                  Mode  : in Search_Type := BY_ID) return Model_Element_Access;

   --  Find the model element within all loaded UML models.
   --  Returns null if the model element is not found.
   function Find (Model   : in UML_Model;
                  Current : in Model_Map.Map;
                  Id      : in Ada.Strings.Unbounded.Unbounded_String)
                  return Model_Element_Access;

   --  Dump the XMI model elements.
   procedure Dump (Map : in Model_Map.Map);

   --  Reconcile all the UML model elements by resolving all the references to UML elements.
   procedure Reconcile (Model : in out UML_Model);

   --  ------------------------------
   --  Model Element
   --  ------------------------------
   type Model_Element (Model : Model_Map_Access) is abstract new Definition with record
      --  Element XMI id.
      XMI_Id        : Ada.Strings.Unbounded.Unbounded_String;

      --  List of tagged values for the element.
      Tagged_Values : Model_Vector;

      --  Elements contained.
      Elements      : Model_Vector;

      --  Stereotypes associated with the element.
      Stereotypes   : Model_Vector;

      --  The parent model element;
      Parent        : Model_Element_Access;
   end record;

   --  Get the element type.
   function Get_Type (Node : in Model_Element) return Element_Type is abstract;

   --  Reconcile the element by resolving the references to other elements in the model.
   procedure Reconcile (Node  : in out Model_Element;
                        Model : in UML_Model);

   --  Find the element with the given name.  If the name is a qualified name, navigate
   --  down the package/class to find the appropriate element.
   --  Returns null if the element was not found.
   function Find (Node : in Model_Element;
                  Name : in String) return Model_Element_Access;

   --  Set the model name.
   procedure Set_Name (Node  : in out Model_Element;
                       Value : in Util.Beans.Objects.Object);

   --  Set the model XMI unique id.
   procedure Set_XMI_Id (Node  : in out Model_Element;
                         Value : in Util.Beans.Objects.Object);

   --  Find the tag value element with the given name.
   --  Returns null if there is no such tag.
   function Find_Tag_Value (Node : in Model_Element;
                            Name : in String) return Tagged_Value_Element_Access;

   --  Get the documentation and comment associated with the model element.
   --  Returns the empty string if there is no comment.
   function Get_Comment (Node : in Model_Element) return String;

   --  Get the full qualified name for the element.
   function Get_Qualified_Name (Node : in Model_Element) return String;

   --  Find from the model file identified by <tt>Name</tt>, the model element with the
   --  identifier or name represented by <tt>Key</tt>.
   --  Returns null if the model element is not found.
   generic
      type Element_Type is new Model_Element with private;
      type Element_Type_Access is access all Element_Type'Class;
   function Find_Element (Model   : in UML_Model;
                          Name    : in String;
                          Key     : in String;
                          Mode    : in Search_Type := BY_ID)
                          return Element_Type_Access;

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Ref_Type_Element is new Model_Element with record
      Href : Unbounded_String;
      Ref  : Model_Element_Access;
   end record;
   type Ref_Type_Element_Access is access all Ref_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Ref_Type_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Ref_Type_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  Data type
   --  ------------------------------
   type Data_Type_Element is new Model_Element with null record;
   type Data_Type_Element_Access is access all Data_Type_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Data_Type_Element) return Element_Type;

   --  ------------------------------
   --  Enum
   --  ------------------------------
   type Enum_Element is new Data_Type_Element with null record;
   type Enum_Element_Access is access all Enum_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Enum_Element) return Element_Type;

   procedure Add_Literal (Node : in out Enum_Element;
                          Id   : in Util.Beans.Objects.Object;
                          Name : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Literal
   --  ------------------------------
   --  The literal describes a possible value for an enum.
   type Literal_Element is new Model_Element with null record;
   type Literal_Element_Access is access all Literal_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Literal_Element) return Element_Type;

   --  ------------------------------
   --  Stereotype
   --  ------------------------------

   type Stereotype_Element is new Model_Element with null record;
   type Stereotype_Element_Access is access all Stereotype_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Stereotype_Element) return Element_Type;

   --  Returns True if the model element has the stereotype with the given name.
   function Has_Stereotype (Node       : in Model_Element'Class;
                            Stereotype : in Stereotype_Element_Access) return Boolean;

   --  ------------------------------
   --  Comment
   --  ------------------------------
   type Comment_Element is new Model_Element with record
      Text       : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Comment_Element_Access is access all Comment_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Comment_Element) return Element_Type;

   --  ------------------------------
   --  An operation
   --  ------------------------------
   type Operation_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Operation_Element_Access is access all Operation_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Operation_Element) return Element_Type;

   --  ------------------------------
   --  An attribute
   --  ------------------------------
   type Attribute_Element is new Model_Element with record
      Ref_Id             : Ada.Strings.Unbounded.Unbounded_String;
      Data_Type          : Data_Type_Element_Access;
      Visibility         : Visibility_Type := VISIBILITY_PUBLIC;
      Changeability      : Changeability_Type := CHANGEABILITY_CHANGEABLE;
      Initial_Value      : Util.Beans.Objects.Object;
      Multiplicity_Lower : Integer := 0;
      Multiplicity_Upper : Integer := 1;
   end record;
   type Attribute_Element_Access is access all Attribute_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Attribute_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Attribute_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  An association end
   --  ------------------------------
   type Association_End_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_End_Element_Access is access all Association_End_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_End_Element) return Element_Type;

   --  ------------------------------
   --  An association
   --  ------------------------------
   type Association_Element is new Model_Element with record
      Visibility : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Association_Element_Access is access all Association_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Association_Element) return Element_Type;

   --  ------------------------------
   --  Tag Definition
   --  ------------------------------
   TAG_DOCUMENTATION : constant String := "documentation";
   TAG_AUTHOR        : constant String := "author";

   type Tag_Definition_Element is new Model_Element with record
      Multiplicity_Lower : Natural := 0;
      Multiplicity_Upper : Natural := 0;
   end record;
   type Tag_Definition_Element_Access is access all Tag_Definition_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tag_Definition_Element) return Element_Type;

   --  ------------------------------
   --  Tagged value
   --  ------------------------------
   type Tagged_Value_Element is new Model_Element with record
      Value      : Ada.Strings.Unbounded.Unbounded_String;
      Value_Type : Ada.Strings.Unbounded.Unbounded_String;
      Ref_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Tag_Def    : Tag_Definition_Element_Access;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Tagged_Value_Element) return Element_Type;

   --  Reconcile the element by resolving the references to other elements in the model.
   overriding
   procedure Reconcile (Node  : in out Tagged_Value_Element;
                        Model : in UML_Model);

   --  ------------------------------
   --  A class
   --  ------------------------------
   type Class_Element is new Model_Element with record
      Operations   : Model_Vector;
      Attributes   : Model_Vector;
      Associations : Model_Vector;
      Visibility   : Visibility_Type := VISIBILITY_PUBLIC;
   end record;
   type Class_Element_Access is access all Class_Element'Class;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Class_Element) return Element_Type;

   --  ------------------------------
   --  A package
   --  ------------------------------
   type Package_Element;
   type Package_Element_Access is access all Package_Element'Class;

   type Package_Element is new Model_Element with record
      Classes      : Model_Vector;
   end record;

   --  Get the element type.
   overriding
   function Get_Type (Node : in Package_Element) return Element_Type;

end Gen.Model.XMI;

Make the enumeration a data type

Make the enumeration a data type