parvel / tests.ml

The default branch has multiple heads

open Printf;
module IO = Parvel_IO;
(* module P = Parvel.Make(Parvel_IO); *)
module P = Parvel;
open Parvel_ops;

value ( >>= ) m f = IO.bind f m
;


value do_run () =
  try
    match IO.runIO & P.run_programs () with
    [ `Ok () -> ()
    | `Error e -> printf "do_run: %s\n%!" & Printexc.to_string e
    ]
  with
  [ e -> printf "do_run: uncaught exception: %s\n%!" & Printexc.to_string e ]
;


value func_something n =
  IO.printf "do_something: %.2f\n%!" n >>= fun () ->
  Lwt_unix.sleep n >>= fun () ->
  IO.printf "do_something: %.2f done\n%!" n >>= fun () ->
  P.server_return ()
;

value func_something_state (n, state) =
  let state_string =
    sprintf "previous waits: [%s]" &
    String.concat "; " &
    List.map (sprintf "%.2f") &
    state
  in
  IO.printf "do_something: %.2f\n%!" n >>= fun () ->
  Lwt_unix.sleep n >>= fun () ->
  IO.printf "do_something: %.2f done (%s)\n%!" n state_string >>= fun () ->
  P.server_return ((), [n :: state])
;



value () = P.register_program `Main "tests/io_main" & fun () ->
(*
  P.create_process (loop do_something) >>= fun serv ->
*)
  let servf = P.add_state_to_server (P.noinit func_something_state) [] in
  P.create_server servf >>= fun serv ->
  P.call_io serv 0.5 >>= fun () ->
  P.call_io serv 1.5 >>= fun () ->
  P.call_io serv 2.5 >>= fun () ->
  IO.printf "io_main: awake\n" >>= fun () ->
  IO.printf "done\n%!"
;


value _io_main_stateless () =
(*
  P.create_process (loop do_something) >>= fun serv ->
*)
  P.create_server (P.noinit func_something) >>= fun serv ->
  P.call_io serv 0.5 >>= fun () ->
  P.call_io serv 1.5 >>= fun () ->
  P.call_io serv 2.5 >>= fun () ->
  IO.printf "io_main: awake\n" >>= fun () ->
  IO.printf "done\n%!"
;


value _io_main () =
  IO.printf "1\n%!" >>= fun () ->
  Lwt_unix.sleep 4.0 >>= fun () ->
  IO.printf "2\n%!" >>= fun () ->
  IO.return ()
;


value _io_main =
  Lwt_unix.sleep 4.0
;


value () =
  ( printf "go!\n%!"
  ; do_run ()
  )
;



value () = P.register_program `Main "tests2/io_main" & fun () ->

  let st = Random.State.make [| 740 ; 666 |] in
  let prob p = (Random.State.float st 1. < p) in

  let worker_number = ref (-1) in

  let worker_sleep = 0.01 in

  let worker_factory _context =
    let () = incr worker_number in
    let worker_number = worker_number.val in
    let print msg =
      Printf.printf "w%i:%s %!" worker_number
        (match msg with
         [ `Msg n -> Printf.sprintf "m%i" n
         | `Exit -> "exit"
         | `Killed -> "killed"
         | `Exited -> "`Exited???"
         ])
    in
    IO.return worker_disp
    where rec worker_disp = fun
      [ P.Msg n ->
          if prob 0.1
          then
            ( print `Exit
            ; P.process_exit ()
            )
          else
            ( print (`Msg n)
            ; Lwt_unix.sleep worker_sleep >>= fun () ->
              P.process_continue worker_disp
            )
      | P.Cmd `Shutdown ->
          ( print `Killed
          ; P.process_exit ()
          )
      | P.Cmd (`Exited _) ->
          ( print `Exited
          ; P.process_continue worker_disp
          )
      ]
  in

  let messages_rev = ref [] in
  let dbg msg =
    (* messages_rev.val := [msg :: messages_rev.val] *)
    ignore msg
  in

  let workers_factory_limited =
    P.process_limit ~dbg ~nmax:3 worker_factory in

  P.create_process workers_factory_limited >>= fun workers ->

  (
   send_messages 0 >>= fun () ->
   P.send workers (P.Cmd `Shutdown) >>= fun () ->
   IO.printf "sent shutdown\n" >>= fun () ->
   IO.flush Lwt_io.stdout >>= fun () ->
   Lwt_unix.sleep 2.0 >>= fun () ->
   let () = Printf.printf " .\n%!" in
   let () =
    if messages_rev.val <> []
    then
     ( Printf.printf "debug messages:\n"
     ; List.iter (Printf.printf "> %s\n") (List.rev messages_rev.val)
     ; Printf.printf "\n%!"
     )
    else
     ()
   in
   IO.return ()
  )

  where rec send_messages i =
    if i >= 200
    then
      IO.return ()
    else
      P.send workers (P.Msg i) >>= fun () ->
      send_messages (i + 1)
;


value () =
  ( printf "go 2!\n%!"
  ; do_run ()
  )
;


value run_n_processes n f_process_factory f_init_msg =
   loop 0
  where rec loop i =
    if i >= n
    then IO.return ()
    else
      P.create_process (f_process_factory i) >>= fun p ->
      P.send p (f_init_msg p) >>= fun () ->
      loop (i + 1)
;



value () = P.register_program `Main "tests3/io_main" & fun () ->

  let worker_sleep = 0.02 in
  let clients_count = 10 in
  let client_messages = 20 in
  let client_sleep = 0.02 in


  let worker_factory context =
    let () =
      ( P.mq_set_block_limit context 4
      ; P.mq_set_fail_limit context 3
      )
    in
    IO.return worker_disp
    where rec worker_disp = fun
      [ () ->
          ( Printf.printf "[%!"
          ; Lwt_unix.sleep worker_sleep >>= fun () ->
            P.server_return ()
          )
      ]

  in

  P.create_server worker_factory >>= fun worker ->

  let f_client_factory n _context =
    let () = Printf.printf "(c%i)%!" n in
    let get_call_res = Printf.sprintf "[%i" n in
    let got_call_res = Printf.sprintf "%i]" n in
    IO.return client_disp
    where rec client_disp = fun
     [ P.Msg () ->
        let rec loop left =
         if left <= 0
         then
           let () = Printf.printf "<fin%i>%!" n in
           IO.return ()
         else
          (IO.catch
             (fun () ->
                let () = Printf.printf "%s%!" get_call_res in
                P.call worker () >>= fun
                [ P.CR_Ok () -> IO.return got_call_res
                | P.CR_Error _ -> IO.return "?"
                ]
             )
             (fun [ IO.Mq.Full -> IO.return "!"
                  | e -> IO.error e
                  ])
          ) >>= fun str ->
          let () = Printf.printf "%s%!" str in
          Lwt_unix.sleep client_sleep >>= fun () ->
          loop (left - 1)
        in
          loop client_messages >>= fun () ->
          P.process_exit ()
     | P.Cmd _ ->
         let () = Printf.printf "#%!" in
         P.process_exit ()
     ]
  in

    run_n_processes clients_count
      f_client_factory (fun _ -> P.Msg ())
    >>= fun () ->
    Lwt_unix.sleep 10. >>= fun () ->
    ( Printf.printf "\n%!"
    ; IO.return ()
    )
;


value () =
  ( printf "go 3!\n%!"
  ; do_run ()
  )
;


module T4
 =
  struct

    module Port = Parvel_lwt.Port
    ;


value () = P.register_program `Main "tests4/io_main" & fun () ->

  let receiver_factory = P.noinit &
    receive_msg
    where rec receive_msg msg =
      let cont () = P.process_continue receive_msg in
      let pr_out title txt =
        IO.printf "T4: receiver: %s: %S\n" title txt >>= cont in
      match msg with
      [ P.Msg a ->
          match a with
          [ Port.Stdout txt -> pr_out "stdout" txt
          | Port.Stderr txt -> pr_out "stderr" txt
          | Port.Exited st ->
              let pr msg =
                IO.printf "T4: receiver: exited: %s\n" msg >>= fun () ->
                P.process_exit ()
              in
              match st with
              [ Unix.WEXITED rc -> pr & sprintf "WEXITED %i" rc
              | Unix.WSIGNALED sn -> pr & sprintf "WSIGNALED %i" sn
              | Unix.WSTOPPED sn -> pr & sprintf "WSTOPPED %i" sn
              ]
          ]
      | P.Cmd (_ : [> ]) ->
          cont ()
      ]
  in

  P.create_process receiver_factory >>= fun receiver_proc ->

  let raddrt = P.addrt_of_proc receiver_proc in

  Port.run (Port.Shell "nc google.com 80") raddrt >>= fun port ->
  let req = "GET / HTTP/1.1\r\nHost: google.com\r\n\r\n" in
  let send txt = P.send port (P.Msg (Port.Stdin txt)) in
  send req >>= fun () ->
  Lwt_unix.sleep 4. >>= fun () ->
  send "" >>= fun () ->
  IO.return ()
;

  end
;


value () =
  ( printf "go 4!\n%!"
  ; do_run ()
  )
;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.