I have some tests on infinite lazy structures that might run indefinitely if the tested function is not correctly implemented, but I can’t find in the OUnit docs how to set a timeout on tests.
If you're using OUnit2, the following should work:
let tests =
"suite" >::: [OUnitTest.TestCase (
OUnitTest.Short,
(fun _ -> assert_equal 2 (1+1))
);
OUnitTest.TestCase (
OUnitTest.Long,
(fun _ -> assert_equal 4 (2+2))
)]
The type test_length is defined as:
type test_length =
| Immediate
| Short
| Long
| Huge
| Custom_length of float
I don't think that oUnit provides this functionality. I remember having to do this a while back and this is the quick hack I've come up with:
let race seconds ~f =
let ch = Event.new_channel () in
let timeout = Thread.create (fun () ->
Thread.delay seconds;
`Time_out |> Event.send ch |> Event.sync
) () in
let tf = Thread.create (fun () ->
`Result (f ()) |> Event.send ch |> Event.sync) () in
let res = ch |> Event.receive |> Event.sync in
try
Thread.kill timeout;
Thread.kill tf;
res
with _ -> res
let () =
let big_sum () =
let arr = Array.init 1_000_000 (fun x -> x) in
Array.fold_left (+) 0 arr in
match race 0.0001 ~f:big_sum with
| `Time_out -> print_endline "time to upgrade";
| `Result x -> Printf.printf "sum is: %d\n" x
This worked well enough for my use case but I'd definitely would not recommend using this if only because race will not work as you'd expect if ~f does no allocations or calls Thread.yield manually.
Related
can you help me out, i made this program to get an output from some .txt file like this :
john:3:uk
paul:18:us
#load "str.cma"
let f_test = "/home/test.txt" ;;
(*
Recursive Reading function
*)
let read_lines f_test : string list =
if Sys.file_exists (f_test) then
begin
let ic = open_in f_test in
try
let try_read () =
try Some (input_line ic) with End_of_file -> None in
let rec loop acc = match try_read () with
| Some s -> loop (s :: acc)
| None -> close_in_noerr ic; List.rev acc in
loop []
with e ->
close_in_noerr ic;
[]
end
else
[]
;;
(*Using Records*)
type user =
{
name : string;
age : int;
country : string;
};;
(*
Function to separated info in list
*)
let rec splitinfo ?(sep=":") l = match l with
| [] -> []
| x::xs -> (Str.split (Str.regexp ":") x)::splitinfo xs;;
(*
Function to get users position
*)
let get_user l:user =
let age = int_of_string (List.nth l 1) in
let user_name = List.nth l 0 in
{
name = user_name;
age = age ;
country = List.nth l 2;
};;
(*
Function to check some parameter is valid
*)
let par1 u: int =
if (u.age = 3) then
1
else
0;;
(*
Reporting function
*)
let report_statistics list_users =
let child = ref 0 in
let teenager = ref 0 in
let adult = ref 0 in print_string (" ----- -- Stats -- ----- \n" ) ;
List.iter (
fun user_l -> (
match user_l with
| [] -> print_string("> no user <\n")
| _ ->
let user = get_user user_l in
if (par1 user = 1) then (
print_string (" "^ user.name ^" --> Child \n" ) ;
child := !child + 1;
)
else
print_string (" "^ user.name ^" --> Other \n" );
)
) list_users;
print_string ("------- List ---- ");
print_newline();
print_string ("Child " );
print_int(!child);
print_newline();
print_string ("Teenager ") ;
print_int(!teenager);
print_newline();
print_string ("Adult ");
print_int(!adult);
print_newline();
;;
The program compile but doesn't output any result ...
What am i missing ?
I kept the function to check parameters simple so i can understand it better but can't figure it out why it isn't outputing any result
Can you help me out here ?
Thanks in advance :)
The code as given defines some functions such as read_lines and report_statistics. But there are no calls to these functions.
If there is no other OCaml source involved, this is probably your problem. You need to call the functions.
It is fairly customary to have a "main" function that does the work of an OCaml program, and then (this is key) you have to actually call the main function:
let main () =
(* Call the functions that do the work of the program *)
let () = main ()
I have many times forgotten this last line and then nothing happens when I run the program.
I am reading a repository and I encountered this function in the body of some Yojson json parsing code:
let load_problems channel =
let open Yojson.Basic.Util in
let j = Yojson.Basic.from_channel channel in
...
let rec unpack x =
try magical (x |> to_int) with _ ->
try magical (x |> to_float) with _ ->
try magical (x |> to_bool) with _ ->
try
let v = x |> to_string in
if String.length v = 1 then magical v.[0] else magical v
with _ ->
try
x |> to_list |> List.map ~f:unpack |> magical
with _ -> raise (Failure "could not unpack")
in
...
where magical = Obj.magic. I understand what Obj.magic is (it's the equivalent to Unsafe.Coerce in Haskell), but I don't see why a type coercion is necessary here. The Yojson.Basic.Util functions the author uses should already either succeed or fail to do this conversion. Any intuition?
EDIT:
I feel I was depriving #glennsl of context, so here is the immediately following passage in which unpack is used:
let tf = j |> member "tasks" |> to_list |> List.map ~f:(fun j ->
let e = j |> member "examples" |> to_list in
let task_type = j |> member "request" |> deserialize_type in
let examples = e |> List.map ~f:(fun ex -> (ex |> member "inputs" |> to_list |> List.map ~f:unpack,
ex |> member "output" |> unpack)) in
let maximum_frontier = j |> member "maximumFrontier" |> to_int in
let name = j |> member "name" |> to_string in
let task =
(try
let special = j |> member "specialTask" |> to_string in
match special |> Hashtbl.find task_handler with
| Some(handler) -> handler (j |> member "extras")
| None -> (Printf.eprintf " (ocaml) FATAL: Could not find handler for %s\n" special;
exit 1)
with _ -> supervised_task) ~timeout:timeout name task_type examples
in
(task, maximum_frontier))
in
There are a number of different task_handlers, but the one I happen to be concerned with is defined as follows:
(fun extras ?timeout:(timeout = 0.001) name ty examples ->
let open Yojson.Basic.Util in
let cost_matters =
try
extras |> member "costMatters" |> to_bool
with _ -> assert false
in
let by = match examples with
| [([0],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| [([1],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| _ -> failwith "not a turtle task" in
{ name = name ;
task_type = ty ;
log_likelihood =
(fun p ->
try
match run_recent_logo ~timeout p with
| Some(bx,cost) when (LogoLib.LogoInterpreter.fp_equal bx by 0) ->
(if cost_matters then (0.-.cost)*.10. else 0.)
| _ -> log 0.
with (* We have to be a bit careful with exceptions if the
* synthesized program generated an exception, then we just
* terminate w/ false but if the enumeration timeout was
* triggered during program evaluation, we need to pass the
* exception on
*)
| UnknownPrimitive(n) -> raise (Failure ("Unknown primitive: "^n))
| EnumerationTimeout -> raise EnumerationTimeout
| _ -> log 0.0)
});;
The author also uses ;; in a lot of files..another quirk.
I'm trying to write a function that tries to evaluate a function, but stops after a specific timeout.
I tried to use Deferred.any, which returns a deferred that is fulfilled when one of the underlying deferred is fulfilled.
type 'a output = OK of 'a | Exn of exn
let fun_test msg f eq (inp,ans) =
let outp = wait_for (Deferred.any
[ return (try OK (f inp) with e -> Exn e)
; (after (Core.Std.sec 0.0) >>| (fun () -> Exn TIMEOUT))])
in {msg = msg;inp = inp;outp = outp;ans = ans;pass = eq outp ans}
I was not sure how to extract a value from the deferred monad, so I wrote a function 'wait_for' which just spins until the underlying value is determined.
let rec wait_for x =
match Deferred.peek x with
| None -> wait_for x
| Some done -> done;;
This did not work. After reading through the Async chapter of Real World OCaml, I realized I needed to start the scheduler. However I'm not sure where I would call Schedule.go in my code. I do not see where the type go : ?raise_unhandled_exn:bool -> unit -> Core.Std.never_returns would fit into code where you actually want your asynchronous code to return. The documentation for go says "Async programs do not exit until shutdown is called."
I was beginning to doubt I had taken the entirely wrong approach to the problem until I found a very similar solution to that same problem on this Cornell website
let timeout (thunk:unit -> 'a Deferred.t) (n:float) : ('a option) Deferred.t
= Deferred.any
[ after (sec n) >>| (fun () -> None) ;
thunk () >>= (fun x -> Some x) ]
Anyway, I'm not quite sure my use of wait_for is correct. Is there a canonical way to extract a value from the deferred monad? Also how do I start the scheduler?
Update:
I tried writing a timeout function using only Core.Std.Thread and Core.Std.Mutex.
let rec wait_for lck ptr =
Core.Std.Thread.delay 0.25;
Core.Std.Mutex.lock lck;
(match !ptr with
| None -> Core.Std.Mutex.unlock lck; wait_for lck ptr
| Some x -> Core.Std.Mutex.unlock lck; x);;
let timeout t f =
let lck = Core.Std.Mutex.create () in
let ptr = ref None in
let _ = Core.Std.Thread.create
(fun () -> Core.Std.Thread.delay t;
Core.Std.Mutex.lock lck;
(match !ptr with
| None -> ptr := Some (Exn TIMEOUT)
| Some _ -> ());
Core.Std.Mutex.unlock lck;) () in
let _ = Core.Std.Thread.create
(fun () -> let x = f () in
Core.Std.Mutex.lock lck;
(match !ptr with
| None -> ptr := Some x
| Some _ -> ());
Core.Std.Mutex.unlock lck;) () in
wait_for lck ptr
I think this is pretty close to working. It works on computations like let rec loop x = print_string ".\n"; loop x, but it does not work on computations like let rec loop x = loop x. I believe the problem right now is that if the computation f () loops infinitely, then its thread is never preempted, so none of other threads can notice the timeout has expired. If the thread does IO like printing a string, then the thread does get preempted. Also I don't know how to kill a thread, I couldn't find such a function in the documentation for Core.Std.Thread
The solution I came up with is
let kill pid sign =
try Unix.kill pid sign with
| Unix.Unix_error (e,f,p) -> debug_print ((Unix.error_message e)^"|"^f^"|"^p)
| e -> raise e;;
let timeout f arg time default =
let pipe_r,pipe_w = Unix.pipe () in
(match Unix.fork () with
| 0 -> let x = Some (f arg) in
let oc = Unix.out_channel_of_descr pipe_w in
Marshal.to_channel oc x [];
close_out oc;
exit 0
| pid0 ->
(match Unix.fork () with
| 0 -> Unix.sleep time;
kill pid0 Sys.sigkill;
let oc = Unix.out_channel_of_descr pipe_w in
Marshal.to_channel oc default [];
close_out oc;
exit 0
| pid1 -> let ic = Unix.in_channel_of_descr pipe_r in
let result = (Marshal.from_channel ic : 'b option) in
result ));;
I think I might be creating two zombie processes with this though. But it is the only solution that works on let rec loop x = loop x when compiled using ocamlopt (The solution using Unix.alarm given here works when compiled with ocamlc but not when compiled with ocamlopt).
I have a homework where i need to write 2 communication servers, one which generates natural numbers and the other which prints them. the generating server will be sending to the printing server. The servers should communicate over the shared channel chan.The main function should spawn a thread for each server.
`
val sender = fn : int -> unit
val receiver = fn : unit -> 'a
val main = fn : unit -> unit
`
And so far this is code i have written:
`
datatype 'a inflist = NIL
| CONS of 'a * (unit -> 'a inflist);
fun HD (CONS(a,b)) = a
| HD NIL = raise Subscript;
fun TL (CONS(a,b)) = b()
| TL NIL = raise Subscript;
fun NULL NIL = true
| NULL _ = false;
fun TAKE(xs, 0) = []
| TAKE(NIL, n) = raise Subscript
| TAKE(CONS(x,xf), n) = x::TAKE(xf(), n-1);
fun FROMN n = CONS (n,fn () => FROMN (n+1));
val natnumber = FROMN 0;
fun printGenList f (h::t) = (f h; printGenList f t);
fun printList l = printGenList (fn(e) => print(Int.toString(e)^" ")) l;
fun printPairList l = printGenList (fn(e,f) => print("("^Int.toString(e)^", "^Int.toString(f)^") ")) l;
CM.make "$cml/cml.cm";
open CML;
val chan: int chan = channel();
fun gen ch () = send (ch, printList(TAKE(natnumber,101)));
fun printnat ch () = recv (ch);
fun main () =
let
val ch = channel() :int chan ;
val _ = spawn (gen ch);
val _ = spawn (printnat ch);
in
()
end;
`
But i am not getting the output. Am i going wrong in my syntax or the logic?
I am new to SML and Concurrent ML. Please help me.
Why are you using a infinite list? There are simpler ways to implement this.
I'm playing around with async in F#. Does this look right, or am I mangling things?
let time f =
let before = System.DateTime.Now
f () |> ignore
let after = System.DateTime.Now
after - before;;
let rec fib = function 0 | 1 -> 1
| n -> fib (n - 1) + fib (n - 2);;
let source = [45; 40; 45; 40]
let synchronous = time <| fun () -> List.map fib source
let para = time <| fun () -> source
|> List.map (fun n -> async {ignore <| fib n})
|> Async.Parallel
|> Async.RunSynchronously
In particular, how do I return results from an async block? Do I have to use mutable state?
Update: here's another approach:
#r "FSharp.PowerPack.Parallel.Seq.dll"
open Microsoft.FSharp.Collections
let pseq = time <| fun () -> source
|> PSeq.map fib
|> PSeq.toList
Firstly, it's a bit of an anti-pattern to use async for parallel CPU processing. See these questions and answers for more information:
Why shouldn't I use F# asynchronous workflows for parallelism?
Task Parallel Library vs Async Workflows
Secondly, your fib function should be re-written to be tail recursive, here's an example from here (including changing to BigInt):
let fib n =
let rec loop acc1 acc2 = function
| n when n = 0I -> acc1
| n -> loop acc2 (acc1 + acc2) (n - 1I)
loop 0I 1I n
Finally, the full code:
let source = [| 45I; 40I; 45I; 40I |]
let sync = time <| fun () -> Array.map fib source
let para = time <| fun () -> Array.Parallel.map fib source
Note that in both cases an Array of the results is returned, you're just throwing it away in your time function. How about a time function that returns both the time and the result?
let time f =
let watch = new System.Diagnostics.Stopwatch()
watch.Start()
let res = f ()
watch.Stop()
(res, watch.ElapsedMilliseconds)
Usage remains the same, but now showing results:
printfn "Sync: %A in %ims" (fst sync) (snd sync)
printfn "Para: %A in %ims" (fst para) (snd para)