Skip to content

Upstream port: new ocamltest language #2444

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Merged
merged 4 commits into from
Apr 15, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
The table of contents is too big for display.
Diff view
Diff view
  •  
  •  
  •  
20 changes: 19 additions & 1 deletion ocaml/ocamltest/.depend
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,7 @@ main.cmo : \
tsl_semantics.cmi \
tsl_parser.cmi \
tsl_lexer.cmi \
translate.cmi \
tests.cmi \
result.cmi \
options.cmi \
Expand All @@ -107,6 +108,7 @@ main.cmx : \
tsl_semantics.cmx \
tsl_parser.cmx \
tsl_lexer.cmx \
translate.cmx \
tests.cmx \
result.cmx \
options.cmx \
Expand Down Expand Up @@ -366,15 +368,18 @@ ocamltest_unix.cmx : \
ocamltest_unix.cmi :
options.cmo : \
variables.cmi \
translate.cmi \
tests.cmi \
actions.cmi \
options.cmi
options.cmx : \
variables.cmx \
translate.cmx \
tests.cmx \
actions.cmx \
options.cmi
options.cmi :
options.cmi : \
translate.cmi
result.cmo : \
result.cmi
result.cmx : \
Expand Down Expand Up @@ -407,6 +412,19 @@ tests.cmi : \
result.cmi \
environments.cmi \
actions.cmi
translate.cmo : \
tsl_semantics.cmi \
tsl_parser.cmi \
tsl_lexer.cmi \
tsl_ast.cmi \
translate.cmi
translate.cmx : \
tsl_semantics.cmx \
tsl_parser.cmx \
tsl_lexer.cmx \
tsl_ast.cmx \
translate.cmi
translate.cmi :
tsl_ast.cmo : \
tsl_ast.cmi
tsl_ast.cmx : \
Expand Down
3 changes: 2 additions & 1 deletion ocaml/ocamltest/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,8 @@ core := \
tsl_semantics.mli tsl_semantics.ml \
builtin_variables.mli builtin_variables.ml \
actions_helpers.mli actions_helpers.ml \
builtin_actions.mli builtin_actions.ml
builtin_actions.mli builtin_actions.ml \
translate.mli translate.ml

ocaml_plugin := \
ocaml_backends.mli ocaml_backends.ml \
Expand Down
58 changes: 28 additions & 30 deletions ocaml/ocamltest/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,46 +22,36 @@ type behavior =
| Skip_all_tests
| Run of Environments.t

(*
let first_token filename =
let input_channel = open_in filename in
let lexbuf = Lexing.from_channel input_channel in
Location.init lexbuf filename;
let token =
try Tsl_lexer.token lexbuf with e -> close_in input_channel; raise e
in close_in input_channel; token

let is_test filename =
match first_token filename with
| exception _ -> false
| Tsl_parser.TSL_BEGIN_C_STYLE | TSL_BEGIN_OCAML_STYLE -> true
| _ -> false
*)

(* this primitive announce should be used for tests
that were aborted on system error before ocamltest
could parse them *)
let announce_test_error test_filename error =
Printf.printf " ... testing '%s' => unexpected error (%s)\n%!"
(Filename.basename test_filename) error

let tsl_block_of_file test_filename =
exception Syntax_error of Lexing.position

let tsl_parse_file test_filename =
let input_channel = open_in test_filename in
let lexbuf = Lexing.from_channel input_channel in
Location.init lexbuf test_filename;
match Tsl_parser.tsl_block Tsl_lexer.token lexbuf with
match Tsl_parser.tsl_script Tsl_lexer.token lexbuf with
| exception Parsing.Parse_error ->
raise (Syntax_error lexbuf.Lexing.lex_start_p)
| exception e -> close_in input_channel; raise e
| _ as tsl_block -> close_in input_channel; tsl_block

let tsl_block_of_file_safe test_filename =
try tsl_block_of_file test_filename with
let tsl_parse_file_safe test_filename =
try tsl_parse_file test_filename with
| Sys_error message ->
Printf.eprintf "%s\n%!" message;
announce_test_error test_filename message;
exit 1
| Parsing.Parse_error ->
Printf.eprintf "Could not read test block in %s\n%!" test_filename;
announce_test_error test_filename "could not read test block";
| Syntax_error p ->
let open Lexing in
Printf.eprintf "%s:%d.%d: syntax error in test script\n%!"
test_filename p.pos_lnum (p.pos_cnum - p.pos_bol);
announce_test_error test_filename "could not read test script";
exit 1

let print_usage () =
Expand Down Expand Up @@ -131,8 +121,8 @@ let init_tests_to_skip () =
let test_file test_filename =
let start = if Options.show_timings then Unix.gettimeofday () else 0.0 in
let skip_test = List.mem test_filename !tests_to_skip in
let tsl_block = tsl_block_of_file_safe test_filename in
let (rootenv_statements, test_trees) = test_trees_of_tsl_block tsl_block in
let tsl_ast = tsl_parse_file_safe test_filename in
let (rootenv_statements, test_trees) = test_trees_of_tsl_ast tsl_ast in
let test_trees = match test_trees with
| [] ->
let default_tests = Tests.default_tests() in
Expand Down Expand Up @@ -221,10 +211,12 @@ let test_file test_filename =
Printf.eprintf "Wall clock: %s took %.02fs\n%!"
test_filename wall_clock_duration

let is_test s =
match tsl_block_of_file s with
| _ -> true
| exception _ -> false
let is_test filename =
let input_channel = open_in filename in
let lexbuf = Lexing.from_channel input_channel in
Fun.protect ~finally:(fun () -> close_in input_channel) begin fun () ->
Tsl_lexer.is_test lexbuf
end

let ignored s =
s = "" || s.[0] = '_' || s.[0] = '.'
Expand Down Expand Up @@ -277,6 +269,12 @@ let () =
let doit f x = work_done := true; f x in
List.iter (doit find_test_dirs) Options.find_test_dirs;
List.iter (doit list_tests) Options.list_tests;
List.iter (doit test_file) Options.files_to_test;
let do_file =
if Options.translate then
Translate.file ~style:Options.style ~compact:Options.compact
else
test_file
in
List.iter (doit do_file) Options.files_to_test;
if not !work_done then print_usage();
if !failed || not !work_done then exit 1
Loading