Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 252 lines (228 sloc) 6.915 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 Testing module for SchedulerKer
20 @author Cedric Soulas
21 *)
22 (*
23 IMPORTANT:
24 Because of side effects, each test is intended to be executed in a distinct processus
25 *)
26
27 module O = SchedulerKer.Operation
28 module P = SchedulerKer.Priority
29 module D = SchedulerKer.Descriptor
30 exception Ok_exception
31
32 let print = Logger.notice
33
34 module Operation =
35 struct
36 let id1, id2 = Unix.stdin, Unix.stdout
37 let operation = O.make ()
38
39 let key n id d =
40 let d = match d with
41 | O.In -> 0
42 | O.Out -> 1
43 in
44 n * 100 + (Obj.magic id) * 10 + d
45
46 let add n id d =
47 let s = Printf.sprintf "(%d, %s) (%d) #%d" (Obj.magic id) (O.direction_to_string d) n (key n id d) in
48 print "Add %s" s;
49 O.add operation id d (key n id d)(fun () -> print "Process add %s" s) (fun e -> print "Error raised: %s (%s)" (Printexc.to_string e) s)
50 let remove n id d =
51 print "Remove #%d" (key n id d);
52 O.remove operation (key n id d)
53 let remove_id id =
54 print "Remove id %d" (Obj.magic id);
55 O.remove_id operation id
56 let process id d =
57 print "Processing...";
58 O.process operation id d
59 let process_id_error id =
60 print "Processing id...";
61 O.process_id_error operation id
62 let process_all l =
63 let l = O.process_all operation l in
64 assert (l = [])
65 let wait () =
66 O.wait operation 500
67
68 let test_add () =
69 assert ((O.is_empty operation) = true);
70 add 1 id1 O.In;
71 assert ((O.mem operation id1 O.In) = true);
72 (* Simple test *)
73 process_all [| (id1, [Epoll.In]) |];
74 add 1 id1 O.Out;
75 assert ((O.length operation) = 2);
76 (* Processing once more is ok *)
77 process_all [| (id1, [Epoll.In]) |];
78 (* Processing two directions for the same id *)
79 process_all [| (id1, [Epoll.In; Epoll.Out]) |];
80 add 1 id2 O.In;
81 process_all [| (id1, [Epoll.In; Epoll.Out]); (id2, [Epoll.In]) |];
82 add 2 id2 O.In;
83 (* The two (id2, In) count for 1 *)
84 assert ((O.length operation) = 3);
85 remove 1 id2 O.In;
86 (* The second id2 operation have to be executed *)
87 process_all [| (id2, [Epoll.In]) |];
88 add 3 id2 O.In;
89 (* Still the second id2 *)
90 process_all [| (id2, [Epoll.In]) |];
91 remove 2 id2 O.In;
92 (* Now the third one *)
93 process_all [| (id2, [Epoll.In]) |]
94
95 let test_remove () =
96 add 1 id1 O.In;
97 add 2 id1 O.In;
98 (* Process id1, just for In here *)
99 print "One Scheduler.Connection_closed will be raised:";
100 process_id_error id1 Scheduler.Connection_closed;
101 (* Still the first id1 *)
102 process_all [| (id1, [Epoll.In]) |];
103 remove 1 id1 O.In;
104 add 1 id1 O.Out;
105 (* Process the second In and the first Out *)
106 print "Two Scheduler.Connection_closed will be raised:";
107 process_id_error id1 Scheduler.Connection_closed
108
109 let test_exc () =
110 (* Raise an exception *)
111 begin
112 try
113 process id1 O.Out;
114 with
115 | O.Not_found (id, d) ->
116 print "OK, exception raised";
117 assert (id = id1);
118 assert (d = O.Out)
119 | e -> raise e
120 end;
121 add 1 id1 O.In;
122 (* This one is ok *)
123 process_all [| (id1, [Epoll.In]) |];
124 remove 1 id1 O.In;
125 (* Raise an exception *)
126 begin
127 try
128 process_all [| (id1, [Epoll.In]) |];
129 with
130 | O.Not_found (id, d) ->
131 print "OK, exception raised";
132 assert (id = id1);
133 assert (d = O.In)
134 | e -> raise e
135 end
136
137 let test_wait () =
138 (* Nothing to wait for *)
139 let a = wait () in
140 assert (Array.length a = 0);
141 add 1 id2 O.Out;
142 add 2 id2 O.Out;
143 let a = wait () in
144 assert (Array.length a = 1);
145 process_all a;
146 remove 1 id2 O.Out;
147 (* Process the second Out *)
148 process_all a;
149 let a = wait () in
150 assert (Array.length a = 1);
151 (* Process the second Out *)
152 process_all a;
153 add 3 id2 O.Out;
154 (* Process the second Out *)
155 process_all a;
156 remove_id id2;
157 let a = wait () in
158 assert (Array.length a = 0);
159 (* Nothing to process *)
160 print "Nothing to process...";
161 process_all a;
162 print "Nothing to process: OK";
163 add 4 id2 O.Out;
164 let a = wait () in
165 assert (Array.length a = 1);
166 (* Process the fourth Out *)
167 process_all a;
168 (* Remove the last candidate *)
169 remove 4 id2 O.Out;
170 let a = wait () in
171 assert (Array.length a = 0);
172 (* Nothing to process *)
173 print "Nothing to process...";
174 process_all a;
175 print "Nothing to process: OK";
176
177 end
178 module Priority =
179 struct
180
181 let priority = P.make ()
182 let add key t =
183 print "Add %d" t;
184 P.add priority key (Time.milliseconds t) (fun () -> print "Process add %d" t)
185 let remove s k =
186 P.remove priority k;
187 print "%s" s
188 let process () =
189 Unix.sleep 1;
190 (* Little approximation for constant message *)
191 let t = ((P.process priority) / 100) * 100 in
192 print "Process return %d. Length: %d\n" t (P.length priority)
193
194 let test_add () =
195 (* Simple adding test *)
196 add 1 500;
197 add 2 3500;
198 print "";
199
200 process ();
201 (* Adding but removing later *)
202 add 3 1500;
203 print "";
204
205 process ();
206 add 4 2500;
207 print "";
208 remove "Remove add 1500" 3;
209
210 process ();
211 (* Adding 0 that have to be called *before* the add 3500 *)
212 (* Note: P.Const.priority_max_successive = 1 *)
213 add 5 0;
214 (* Adding 600 that have to be called *after* the add 3500 (which became urgent) *)
215 add 6 600;
216 process ();
217 process ();
218 process ();
219 process ();
220 process ();
221 process ();
222 print "Process is_empty: %b" (P.is_empty priority)
223
224 let test_exc () =
225 let _ = P.add priority 500 (Time.milliseconds 3) (fun () -> raise Ok_exception) in
226 process ()
227
228 end
229
230 module Descriptor =
231 struct
232 let d = D.make ()
233 let id1, id2 = Unix.stdin, Unix.stdout
234
235 let test () =
236 assert ((D.length d) = 0);
237 assert ((D.is_empty d) = true);
238 let key1 = D.add d id1 in
239 assert ((D.mem d id1 key1) = D.Alive);
240 let key2 = D.add d id1 in
241 assert (key1 != key2);
242 assert ((D.length d) = 1);
243 let _ = D.add d id2 in
244 assert ((D.length d) = 2);
245 assert ((D.mem d id1 key2) = D.Alive);
246 assert ((D.mem d id1 key1) = D.Replaced);
247 D.remove d id1;
248 assert ((D.mem d id1 key1) = D.Closed);
249 assert ((D.mem d id1 key2) = D.Closed);
250 print "Test OK"
251 end
Something went wrong with that request. Please try again.