1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184 | -----------------------------------------------------------------------
-- 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 <b>Initialize</b>.
-- 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 <b>Initialize</b>.
-- 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;
|