-----------------------------------------------------------------------
-- AWA tests - AWA Tests Framework
-- Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 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 Util.Log.Loggers;
with ASF.Tests;
with Servlet.Server;
with Servlet.Tests;
with ASF.Applications;
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
Servlet.Server.Set_Context (Application.all'Access);
null;
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
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;
C : ASF.Applications.Config;
Empty : Util.Properties.Manager;
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;
C.Copy (Props);
Application.Initialize (C, Factory);
Application.Set_Global ("contextPath", "/asfunit");
Servlet.Tests.Initialize (Empty, "/asfunit", Application.all'Access);
Application.Add_Filter ("service", Service_Filter'Access);
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
Servlet.Server.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);
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;