My ocaml setting is the following :
ocaml 4.01.0
opam 1.1.2
qtest 2.0.1 (opam list qtest)
quickcheck 1.0.0
The source code with test inlined :
let rec foo x0 f = function
[] -> 0
| x::xs -> f x (foo x0 f xs);;
(*$T foo
foo 0 (+) [1;2] = 3
*)
qtest -o footest2.ml extract foo.ml
Then unfortunately, footest2.ml fails to compile:
corebuild footest2.native -pkg quickcheck
let ___tests = ref []
let ___add test = ___tests := test::!___tests
open OUnit;;
module Q = Quickcheck;;let ( ==> ) = Q.( ==> );;
Random.self_init()
module Test__environment_0 = struct
open Foo;;
let _test_2 = "foo" >::: [
"foo.ml:6" >:: (
#6 "foo.ml"
let foo = foo in fun () -> OUnit.assert_bool "foo.ml:6: foo 0 (+) [1;2] = 3" (
#6 "foo.ml"
foo 0 (+) [1;2] = 3));
];; let _ = ___add _test_2;;
end
let _ = exit (Runner.run ("" >::: List.rev !___tests))
the error being: "Error: Unbound module Quickcheck"
Indeed, it should be QuickCheck instead of Quickcheck - after fixing this, I got the error : Error: Unbound value Q.==>.
After removal of :
let ( ==> ) = Q.( ==> );;
The compilation fails later :
Error: Unbound module Runner.
But no module called "Runner"...
Any idea to get this working?
Try using the package QTest2Lib instead of qtest or quickcheck:
corebuild footest2.native -pkg QTest2Lib
Related
I try to understand a strange behaviour of some functions of a module that rely on a variable of this module masked by the signature of this module. I would like to print this variable at some points of the program, but since it is masked, I do not known how to access it.
Moreover, this module is part of a big project that I do not want to modify and recompile myself.
Is it possible to access this variable for debugging purposes ? Even doing temporarily dirty things ?
EDIT: here some representative code
module type S = sig val f : unit -> unit end
module M : S = struct let x = ref 0 let f () = Format.printf "%d#." !x; incr x end
How to access M.x ?
Of course you can!
First, you can just hide the signature for a while :
module type S = sig val f : unit -> unit end
module M (* : S *) = struct
let x = ref 0
let f () = Format.printf "%d#." !x; incr x
end
Or you can show x in the signature :
module type S = sig
val x : int ref
val f : unit -> unit
end
module M : S = struct
let x = ref 0
let f () = Format.printf "%d#." !x; incr x
end
As you prefer. In both cases, M.x will be available outside the module.
You can even define a function print_x like this :
module type S = sig
val print_x : unit -> unit
val f : unit -> unit
end
module M : S = struct
let x = ref 0
let print_x () = Format.printf "%d#." !x
let f () = Format.printf "%d#." !x; incr x
end
and use M.print_x () wherever you want.
I'm following Real World OCaml to get started with the language, and, at one point, I am to make use of s-expressions in a module signature. Here's my mli file:
open Core.Std
(** Configuration type for query handlers *)
type config with sexp
(** Name of the query handler *)
val name : string
(** Query handler abstract type *)
type t
(** Create a query handler from an existing [config] *)
val create : config -> t
(** Evaluate a query, where both input and output an s-expressions. *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
But, when compiling an implementation of that interface, I get the following error:
File "Query_Handler.mli", line 4, characters 12-16:
Error: Syntax error
Command exited with code 2.
So I opened utop to try with sexp on a simpler example:
module type Test = sig
type t with sexp
end;;
But I get the following error:
Error: Parse Error: "end" expected after [sig_items] (in [module type])
However, sexplib is installed and neither the book nor my searches on the Internet mention any "prerequisites" for using this syntax.
I feel like I'm missing something. Any idea? :(
This is because the sexp library had been rewritten to use Extension Point, instead of Camlp4.
open Core.Std
module type Query_handler = sig
(** Configuration for a query handler. Note that this can be
Converted to and from an s-expression *)
type config [##deriving sexp]
(** The name of the query-handling service *)
val name : string
(** The state of the query handler *)
type t
(** Create a new query handler from a config *)
val create : config -> t
(** Evaluate a given query, where both input and output are
s-expressions *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
end
module Unique = struct
type config = int [##deriving sexp]
type t = { mutable next_id: int }
let name = "unique"
let create start_at = { next_id = start_at }
let eval t sexp =
match Or_error.try_with (fun () -> unit_of_sexp sexp) with
| Error _ as err -> err
| Ok () ->
let response = Ok (Int.sexp_of_t t.next_id) in
t.next_id <- t.next_id + 1;
response
end
module List_dir = struct
type config = string [##deriving sexp]
type t = { cwd: string }
(** [is_abs p] Returns true if [p] is an absolute path *)
let is_abs p =
String.length p > 0 && p.[0] = '/'
let name = "ls"
let create cwd = { cwd }
let eval t sexp =
match Or_error.try_with (fun () -> string_of_sexp sexp) with
| Error _ as err -> err
| Ok dir ->
let dir =
if is_abs dir then dir
else Filename.concat t.cwd dir
in
Ok (Array.sexp_of_t String.sexp_of_t (Sys.readdir dir))
end
module type Query_handler_instance = sig
module Query_handler : Query_handler
val this : Query_handler.t
end
let build_instance (type a)
(module Q : Query_handler with type config = a)
config =
(module struct
module Query_handler = Q
let this = Q.create config
end : Query_handler_instance)
let build_dispatch_table handlers =
let table = String.Table.create () in
List.iter handlers
~f:(fun ((module I : Query_handler_instance) as instance) ->
Hashtbl.replace table ~key:I.Query_handler.name ~data:instance);
table
let dispatch dispatch_table name_and_query =
match name_and_query with
| Sexp.List [Sexp.Atom name; query] ->
begin match Hashtbl.find dispatch_table name with
| None ->
Or_error.error "Could not find matching handler"
name String.sexp_of_t
| Some (module I : Query_handler_instance) ->
I.Query_handler.eval I.this query
end
| _ ->
Or_error.error_string "malformed query"
let rec cli dispatch_table =
printf ">>> %!";
let result =
match In_channel.input_line stdin with
| None -> `Stop
| Some line ->
match Or_error.try_with (fun () -> Sexp.of_string line) with
| Error e -> `Continue (Error.to_string_hum e)
| Ok query ->
begin match dispatch dispatch_table query with
| Error e -> `Continue (Error.to_string_hum e)
| Ok s -> `Continue (Sexp.to_string_hum s)
end;
in
match result with
| `Stop -> ()
| `Continue msg ->
printf "%s\n%!" msg;
cli dispatch_table
let unique_instance = build_instance (module Unique) 0
let list_dir_instance = build_instance (module List_dir) "/var"
module Loader = struct
type config = (module Query_handler) list sexp_opaque [##deriving sexp]
type t = { known : (module Query_handler) String.Table.t
; active : (module Query_handler_instance) String.Table.t
}
let name ="loader"
let create known_list =
let active = String.Table.create () in
let known = String.Table.create () in
List.iter known_list
~f:(fun ((module Q : Query_handler) as q) ->
Hashtbl.replace known ~key:Q.name ~data:q);
{ known; active }
let load t handler_name config =
if Hashtbl.mem t.active handler_name then
Or_error.error "Can't re-register an active handler"
handler_name String.sexp_of_t
else
match Hashtbl.find t.known handler_name with
| None ->
Or_error.error "Unknown handler" handler_name String.sexp_of_t
| Some (module Q : Query_handler) ->
let instance =
(module struct
module Query_handler = Q
let this = Q.create (Q.config_of_sexp config)
end : Query_handler_instance)
in
Hashtbl.replace t.active ~key:handler_name ~data:instance;
Ok Sexp.unit
let unload t handler_name =
if not (Hashtbl.mem t.active handler_name) then
Or_error.error "Handler not active" handler_name String.sexp_of_t
else if handler_name = name then
Or_error.error_string "It's unwise to unload yourself"
else (
Hashtbl.remove t.active handler_name;
Ok Sexp.unit
)
type request =
| Load of string * Sexp.t
| Unload of string
| Known_services
| Active_services [##deriving sexp]
let eval t sexp =
match Or_error.try_with (fun () -> request_of_sexp sexp) with
| Error _ as err -> err
| Ok resp ->
match resp with
| Load (name,config) -> load t name config
| Unload name -> unload t name
| Known_services ->
Ok [%sexp ((Hashtbl.keys t.known ) : string list)]
| Active_services ->
Ok [%sexp ((Hashtbl.keys t.active) : string list)]
end
This is my ~/.ocamlinit; just comment out the camlp4. utop should work happy.
#use "topfind";;
#warnings "+9"
#thread;;
(*camlp4;;*)
#require "core.top";;
#require "core_extended";;
#require "core_bench";;
#require "ppx_jane";;
#require "ctypes";;
#require "ctypes.foreign";;
Taken from the chapter 18 of the Real World OCaml book, I'm trying to break down the example given.
My scope, to just make the GET call and print something of the JSON we get back.
This is my code ( it's supposed to be a subset of the example given )
(* libraries *)
open Core.Std
open Async.Std
(* Generate a DuckDuckGo search URI from a query string *)
let query_uri query =
let base_uri = Uri.of_string "http://api.duckduckgo.com/?format=json" in
Uri.add_query_param base_uri ("q", [query])
(* Extract the "Definition" or "Abstract" field from the DuckDuckGo results *)
let get_definition_from_json json_string =
match Yojson.Safe.from_string json_string with
| `Assoc kv_list ->
let find key =
begin match List.Assoc.find kv_list key with
| None | Some (`String "") -> None
| Some s -> Some (Yojson.Safe.to_string s)
end
in
begin match find "Abstract" with
| Some _ as x -> x
| None -> find "Definition"
end
| _ -> None
(* Execute the DuckDuckGo search *)
let get_definition word =
print_endline ("get_definition word:" ^ word);
Cohttp_async.Client.get (query_uri word)
>>= fun (_, body) ->
Pipe.to_list (Cohttp_async.Body.to_pipe body)
>>| fun strings ->
(word, get_definition_from_json (String.concat strings))
(* run *)
let () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
My issue is that I get this error when compiling:
ocaml setup.ml -build
Finished, 0 targets (0 cached) in 00:00:00.
+ /Users/antouank/.opam/system/bin/ocamlfind ocamlc -c -g -annot -bin-annot -thread -package yojson -package threads -package textwrap -package re2 -package core -package cohttp.async -I src -o src/main.cmo src/main.ml
File "src/main.ml", line 48, characters 18-41:
Error: This expression has type unit but an expression was expected of type
'a Async.Std.Deferred.t = 'a Async_kernel.Deferred0.t
Command exited with code 2.
Compilation unsuccessful after building 2 targets (0 cached) in 00:00:00.
E: Failure("Command ''/usr/local/bin/ocamlbuild' src/main.native -use-ocamlfind -tag debug' terminated with error code 10")
make: *** [build] Error 1
How can I get the string out of that Deferred, and what does that error mean exactly?
In the book, the example is run with a weird Command wrap, so I cannot see how to pull it out.
The problem in your definition of run is that the anonymous function
fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
)
is not correctly typed to be used with a monadic operator >>=. It has type string * string -> unit while the >>= would here expect a function of type string * string -> unit Deferred.t.
If you look at the example of an echo server in the very same chapter, it will suggest the following approach:
let run () =
get_definition "OCaml"
>>= fun (word, def) ->
print_endline ("- word: " ^ word);
(
match def with
| None -> print_endline "[EMPTY]"
| Some str -> print_endline str
);
Deferred.return()
let () =
ignore(run ());
never_returns (Scheduler.go ())
I do not really get how to use bracket setup and tear-down with OUnit (version 2).
Anyone feel like supplying a full example ?
Here is the OUnit2.bracket function documentation:
val bracket : (test_ctxt -> 'a) ->
('a -> test_ctxt -> unit) -> test_ctxt -> 'a
bracket set_up tear_down test_ctxt set up an object
and register it to be tore down in test_ctxt.
You setup a test suite like this:
let test_suite =
"suite" >::: [
"test1" >:: test1_fun
]
And run it like this:
let _ =
run_test_tt_main test_suite
Where do I put the bracket in this workflow ?
Link to OUnit documentation.
The file test_stack.ml in ounit-2.0.0/examples test bracket for OUnit version 1, so that's not useful.
OK, got it after having a look at this file: TestLog.ml
This example will systematically destroy the hashtables after each test as a teardown function.
open ListLabels (* map with label *)
let test_sentence test_ctxt =
assert_equal "Foo" "Foo"
(** In my case, clear a hashtable after each test *)
let tear_down () test_ctxt =
Hashtbl.clear Globals.flags_tbl
(** List of test cases as (name, function) tuples *)
let test_list = [
"sentence", test_sentence;
]
(** Test suite for all tags *)
let tag_test_suite =
"tags" >::: (map test_list ~f:(fun (name, test_fn) ->
name >:: (fun test_ctxt ->
bracket ignore tear_down test_ctxt;
test_fn test_ctxt
)
))
For example, there is a function that testing if a list is monotonically increasing, the source code and testing cases is:
open Printf
let rec mon_inc (numbers : int list) : bool =
match numbers with
| [] -> true
| _ :: [] -> true
| hdn :: tln -> (hdn <= (List.hd tln)) && mon_inc(tln)
let a = [1;2;5;5;8]
let b = [1;2;5;4;8]
let c = [8]
let d = []
let e = [7;8]
let () =
printf "The answer of [1;2;5;5;8]: %B\n" (mon_inc a)
let () =
printf "The answer of [1;2;5;4;8]: %B\n" (mon_inc b)
let () =
printf "The answer of [8]: %B\n" (mon_inc c)
let () =
printf "The answer of []: %B\n" (mon_inc d)
let () =
printf "The answer of [7;8]: %B\n" (mon_inc e)
Compile and run the code:
$ corebuild inc.native
$ ./inc.native
The answer of [1;2;5;5;8]: true
The answer of [1;2;5;4;8]: false
The answer of [8]: true
The answer of []: true
The answer of [7;8]: true
However, when I want to use this function in utop, it shows:
utop # #use "inc.ml";;
File "inc.ml", line 7, characters 29-40:
Error: This expression has type int option
but an expression was expected of type int
This is probably due to your toplevel opening Core, which provides a List.hd that returns an option. In this particular case you can resolve the issue by changing how you match to remove the List.hd entirely:
let rec mon_inc = function
| []
| _::[] -> true
| x::y::rest -> x <= y && mon_inc rest
This is because you have opened Core.Std module in a top-level.
Core.Std is an overlay over a OCaml's standard library with a different interface. For example, in a standard library function List.hd returns a value of type 'a and raises an exception if list is empty. In Janestreet's version function List.hd has a different type - it returns 'a option, it evaluates to None if the list is empty, and to Some value if it is not. Consider adding
open Core.Std
to the top of inc.ml.