diff --git a/.gitignore b/.gitignore index 7c14f3f5..76327624 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ _build boot.exe .merlin boot.ml +*.corrected diff --git a/test/expect-tests/expect_test.mll b/test/expect-tests/expect_test.mll new file mode 100644 index 00000000..e4625dc8 --- /dev/null +++ b/test/expect-tests/expect_test.mll @@ -0,0 +1,128 @@ +{ +open StdLabels +open Printf +} + +rule code txt start = parse + | "[%%expect{|\n" { + let pos = start.Lexing.pos_cnum in + let len = Lexing.lexeme_start lexbuf - pos in + let s = String.sub txt ~pos ~len in + Lexing.new_line lexbuf; + (start, s) :: expectation txt lexbuf + } + | [^'\n']*'\n' { + Lexing.new_line lexbuf; + code txt start lexbuf + } + | eof { + let pos = start.Lexing.pos_cnum in + let len = String.length txt - pos in + if pos > 0 then begin + let s = String.sub txt ~pos ~len in + if String.trim s = "" then + [] + else + [(start, s)] + end else + [] + } + +and expectation txt = parse + | "|}]\n" { + Lexing.new_line lexbuf; + code txt lexbuf.lex_curr_p lexbuf + } + | [^'\n']*'\n' { + Lexing.new_line lexbuf; + expectation txt lexbuf + } + +{ +module Print_diff = struct + let patdiff_cmd ~use_color = + let args = + List.concat [ + ["-keep-whitespace"]; + ["-location-style omake"]; + (if use_color then ["-unrefined"] else ["-ascii"]); + ] + in + String.concat ~sep:" " ("patdiff" :: args) + + let print ?diff_command ?(use_color=false) ~file1 ~file2 () = + let exec cmd = + let cmd = + Printf.sprintf "%s %s %s 1>&2" cmd (Filename.quote file1) (Filename.quote file2) + in + match Sys.command cmd with + | 0 -> true + | 1 -> false + | n -> Printf.eprintf "%S exited with code %d\n" cmd n; exit 2 + in + match diff_command with + | Some s -> ignore (exec s : bool) + | None -> + if exec (patdiff_cmd ~use_color) then ( + Printf.eprintf "File \"%s\", line 1, characters 0-0:\n%!" file1; + ignore (exec "diff -u" : bool); + ) +end + +let main () = + let fn = Sys.argv.(1) in + let ic = open_in_bin fn in + let len = in_channel_length ic in + let txt = really_input_string ic len in + close_in ic; + let chunks = + let lexbuf = Lexing.from_string txt in + lexbuf.lex_curr_p <- + { pos_fname = fn + ; pos_cnum = 0 + ; pos_lnum = 1 + ; pos_bol = 0 + }; + code txt lexbuf.lex_curr_p lexbuf + in + + Toploop.initialize_toplevel_env (); + List.iter + [ "src" + ; "vendor/re" + ] + ~f:(Topdirs.dir_directory); + + let buf = Buffer.create (len + 1024) in + let ppf = Format.formatter_of_buffer buf in + List.iter chunks ~f:(fun (pos, s) -> + Format.fprintf ppf "%s[%%%%expect{|@." s; + let lexbuf = Lexing.from_string s in + lexbuf.lex_curr_p <- pos; + let phrases = !Toploop.parse_use_file lexbuf in + List.iter phrases ~f:(fun phr -> + ignore (Toploop.execute_phrase true ppf phr : bool)); + Format.fprintf ppf "@?|}]@."); + let res = Buffer.contents buf in + + let corrected_fn = fn ^ ".corrected" in + (* Temporary hack: *) + Sys.chdir "../.."; + if txt <> res then begin + let oc = open_out_bin corrected_fn in + output_string oc res; + close_out oc; + Print_diff.print () ~file1:fn ~file2:corrected_fn; + exit 1 + end else begin + if Sys.file_exists corrected_fn then Sys.remove corrected_fn; + exit 0 + end + +let () = + try + main () + with exn -> + Location.report_exception Format.err_formatter exn; + exit 1 +} diff --git a/test/expect-tests/findlib-db/bar/META b/test/expect-tests/findlib-db/bar/META new file mode 100644 index 00000000..e69de29b diff --git a/test/expect-tests/findlib-db/baz/META b/test/expect-tests/findlib-db/baz/META new file mode 100644 index 00000000..e69de29b diff --git a/test/expect-tests/findlib-db/foo/META b/test/expect-tests/findlib-db/foo/META new file mode 100644 index 00000000..e141935c --- /dev/null +++ b/test/expect-tests/findlib-db/foo/META @@ -0,0 +1,2 @@ +requires = "bar" +requires(ppx_driver) = "baz" diff --git a/test/expect-tests/jbuild b/test/expect-tests/jbuild new file mode 100644 index 00000000..08409113 --- /dev/null +++ b/test/expect-tests/jbuild @@ -0,0 +1,17 @@ +(jbuild_version 1) + +(executable + ((name expect_test) + (modules (expect_test)) + (link_flags (-linkall)) + (libraries (unix jbuilder compiler-libs.toplevel)))) + +(ocamllex (expect_test)) + +(alias + ((name runtest) + (deps (tests.mlt + (glob_files ${ROOT}/src/*.cmi) + (glob_files ${ROOT}/vendor/re/*.cmi) + (files_recursively_in findlib-db))) + (action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<}))))) diff --git a/test/expect-tests/tests.mlt b/test/expect-tests/tests.mlt new file mode 100644 index 00000000..77dff60f --- /dev/null +++ b/test/expect-tests/tests.mlt @@ -0,0 +1,39 @@ +(* -*- tuareg -*- *) + +#warnings "-40";; + +open Jbuilder + +let print_pkg ppf pkg = + Format.fprintf ppf "" pkg.Findlib.name +;; + +#install_printer print_pkg;; + +[%%expect{| +val print_pkg : Format.formatter -> Jbuilder.Findlib.package -> unit = +|}] + +let findlib = + let cwd = Path.absolute (Sys.getcwd ()) in + Findlib.create + ~stdlib_dir:cwd + ~path:[Path.relative cwd "test/expect-tests/findlib-db"] +;; + +[%%expect{| +val findlib : Jbuilder.Findlib.t = +|}] + +let pkg = Findlib.find_exn findlib ~required_by:[] "foo" + +[%%expect{| +val pkg : Jbuilder.Findlib.package = +|}] + +(* "foo" should depend on "baz" *) +pkg.requires;; + +[%%expect{| +- : Jbuilder.Findlib.package list = [] +|}] diff --git a/test/expect-tests/toplevel.ml b/test/expect-tests/toplevel.ml new file mode 100644 index 00000000..8dcc82bb --- /dev/null +++ b/test/expect-tests/toplevel.ml @@ -0,0 +1 @@ +Topmain.main ()