Skip to content
This repository
tag: v1495
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 252 lines (228 sloc) 6.915 kb
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 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(*
Testing module for SchedulerKer
@author Cedric Soulas
*)
(*
IMPORTANT:
Because of side effects, each test is intended to be executed in a distinct processus
*)

module O = SchedulerKer.Operation
module P = SchedulerKer.Priority
module D = SchedulerKer.Descriptor
exception Ok_exception

let print = Logger.notice

module Operation =
struct
  let id1, id2 = Unix.stdin, Unix.stdout
  let operation = O.make ()

  let key n id d =
    let d = match d with
      | O.In -> 0
      | O.Out -> 1
    in
    n * 100 + (Obj.magic id) * 10 + d

  let add n id d =
    let s = Printf.sprintf "(%d, %s) (%d) #%d" (Obj.magic id) (O.direction_to_string d) n (key n id d) in
    print "Add %s" s;
    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)
  let remove n id d =
    print "Remove #%d" (key n id d);
    O.remove operation (key n id d)
  let remove_id id =
    print "Remove id %d" (Obj.magic id);
    O.remove_id operation id
  let process id d =
    print "Processing...";
    O.process operation id d
  let process_id_error id =
    print "Processing id...";
    O.process_id_error operation id
  let process_all l =
    let l = O.process_all operation l in
    assert (l = [])
  let wait () =
    O.wait operation 500

  let test_add () =
    assert ((O.is_empty operation) = true);
    add 1 id1 O.In;
    assert ((O.mem operation id1 O.In) = true);
    (* Simple test *)
    process_all [| (id1, [Epoll.In]) |];
    add 1 id1 O.Out;
    assert ((O.length operation) = 2);
    (* Processing once more is ok *)
    process_all [| (id1, [Epoll.In]) |];
    (* Processing two directions for the same id *)
    process_all [| (id1, [Epoll.In; Epoll.Out]) |];
    add 1 id2 O.In;
    process_all [| (id1, [Epoll.In; Epoll.Out]); (id2, [Epoll.In]) |];
    add 2 id2 O.In;
    (* The two (id2, In) count for 1 *)
    assert ((O.length operation) = 3);
    remove 1 id2 O.In;
    (* The second id2 operation have to be executed *)
    process_all [| (id2, [Epoll.In]) |];
    add 3 id2 O.In;
    (* Still the second id2 *)
    process_all [| (id2, [Epoll.In]) |];
    remove 2 id2 O.In;
    (* Now the third one *)
    process_all [| (id2, [Epoll.In]) |]

  let test_remove () =
    add 1 id1 O.In;
    add 2 id1 O.In;
    (* Process id1, just for In here *)
    print "One Scheduler.Connection_closed will be raised:";
    process_id_error id1 Scheduler.Connection_closed;
    (* Still the first id1 *)
    process_all [| (id1, [Epoll.In]) |];
    remove 1 id1 O.In;
    add 1 id1 O.Out;
    (* Process the second In and the first Out *)
    print "Two Scheduler.Connection_closed will be raised:";
    process_id_error id1 Scheduler.Connection_closed

  let test_exc () =
    (* Raise an exception *)
    begin
      try
        process id1 O.Out;
      with
      | O.Not_found (id, d) ->
          print "OK, exception raised";
          assert (id = id1);
          assert (d = O.Out)
      | e -> raise e
    end;
    add 1 id1 O.In;
    (* This one is ok *)
    process_all [| (id1, [Epoll.In]) |];
    remove 1 id1 O.In;
    (* Raise an exception *)
    begin
      try
        process_all [| (id1, [Epoll.In]) |];
      with
      | O.Not_found (id, d) ->
          print "OK, exception raised";
          assert (id = id1);
          assert (d = O.In)
      | e -> raise e
    end

  let test_wait () =
    (* Nothing to wait for *)
    let a = wait () in
    assert (Array.length a = 0);
    add 1 id2 O.Out;
    add 2 id2 O.Out;
    let a = wait () in
    assert (Array.length a = 1);
    process_all a;
    remove 1 id2 O.Out;
    (* Process the second Out *)
    process_all a;
    let a = wait () in
    assert (Array.length a = 1);
    (* Process the second Out *)
    process_all a;
    add 3 id2 O.Out;
    (* Process the second Out *)
    process_all a;
    remove_id id2;
    let a = wait () in
    assert (Array.length a = 0);
    (* Nothing to process *)
    print "Nothing to process...";
    process_all a;
    print "Nothing to process: OK";
    add 4 id2 O.Out;
    let a = wait () in
    assert (Array.length a = 1);
    (* Process the fourth Out *)
    process_all a;
    (* Remove the last candidate *)
    remove 4 id2 O.Out;
    let a = wait () in
    assert (Array.length a = 0);
    (* Nothing to process *)
    print "Nothing to process...";
    process_all a;
    print "Nothing to process: OK";

end
module Priority =
struct

  let priority = P.make ()
  let add key t =
    print "Add %d" t;
    P.add priority key (Time.milliseconds t) (fun () -> print "Process add %d" t)
  let remove s k =
    P.remove priority k;
    print "%s" s
  let process () =
    Unix.sleep 1;
    (* Little approximation for constant message *)
    let t = ((P.process priority) / 100) * 100 in
    print "Process return %d. Length: %d\n" t (P.length priority)

  let test_add () =
    (* Simple adding test *)
    add 1 500;
    add 2 3500;
    print "";

    process ();
    (* Adding but removing later *)
    add 3 1500;
    print "";

    process ();
    add 4 2500;
    print "";
    remove "Remove add 1500" 3;

    process ();
    (* Adding 0 that have to be called *before* the add 3500 *)
    (* Note: P.Const.priority_max_successive = 1 *)
    add 5 0;
    (* Adding 600 that have to be called *after* the add 3500 (which became urgent) *)
    add 6 600;
    process ();
    process ();
    process ();
    process ();
    process ();
    process ();
    print "Process is_empty: %b" (P.is_empty priority)

  let test_exc () =
    let _ = P.add priority 500 (Time.milliseconds 3) (fun () -> raise Ok_exception) in
    process ()

end

module Descriptor =
struct
  let d = D.make ()
  let id1, id2 = Unix.stdin, Unix.stdout

  let test () =
    assert ((D.length d) = 0);
    assert ((D.is_empty d) = true);
    let key1 = D.add d id1 in
    assert ((D.mem d id1 key1) = D.Alive);
    let key2 = D.add d id1 in
    assert (key1 != key2);
    assert ((D.length d) = 1);
    let _ = D.add d id2 in
    assert ((D.length d) = 2);
    assert ((D.mem d id1 key2) = D.Alive);
    assert ((D.mem d id1 key1) = D.Replaced);
    D.remove d id1;
    assert ((D.mem d id1 key1) = D.Closed);
    assert ((D.mem d id1 key2) = D.Closed);
    print "Test OK"
end
Something went wrong with that request. Please try again.