Simon Génier pushed to branch master at Stefan / Typer
Commits: c0df7b8b by Simon Génier at 2020-12-02T11:36:56-05:00 Cosmetic changes to utest_main.ml.
Some of these changes bring the style more in line with the GNU coding standard that is used for Typer. - Reindent file to 2 spaces. - Break lines before a operator. - Break lines before 80 columns.
Others are my attempts to improve readability. - Use functions specialized on refs in Arg. - Remove superfluous parenthesis. - Extract large fun expressions to local let bindings.
- - - - - 077b4494 by Simon Génier at 2020-12-02T12:05:43-05:00 Utest_main now also handle Windows paths.
- - - - - a4cc1ea7 by Simon Génier at 2020-12-03T12:13:32-05:00 Merge branch 'utests-main-windows'
- - - - -
1 changed file:
- tests/utest_main.ml
Changes:
===================================== tests/utest_main.ml ===================================== @@ -3,7 +3,7 @@ * * --------------------------------------------------------------------------- * - * Copyright (C) 2011-2018 Free Software Foundation, Inc. + * Copyright (C) 2011-2020 Free Software Foundation, Inc. * * Author: Pierre Delaunay pierre.delaunay@hec.ca * Keywords: languages, lisp, dependent types. @@ -30,32 +30,34 @@ * * --------------------------------------------------------------------------- *)
-open Fmt +(** Search *_test.byte executable and run them. + Usage: + ./utest_main tests_folder root_folder *)
-let cut_name str = - String.sub str 0 (String.length str - 12) +open Fmt
let global_verbose_lvl = ref 5 -let global_sample_dir = ref "./" -let global_tests_dir = ref "./_build/tests/" +let global_sample_dir = ref "." +let global_tests_dir = ref (Filename.concat "_build" "tests") let global_fsection = ref "" let global_ftitle = ref "" let global_filter = ref false
-let arg_defs = [ +let arg_defs = + [ ("--verbose", - Arg.Int (fun g -> global_verbose_lvl := g), " Set verbose level"); + Arg.Set_int global_verbose_lvl, " Set verbose level"); ("--samples", - Arg.String (fun g -> global_sample_dir := g), " Set sample directory"); + Arg.Set_string global_sample_dir, " Set sample directory"); ("--tests", - Arg.String (fun g -> global_tests_dir := g), " Set tests directory"); + Arg.Set_string global_tests_dir, " Set tests directory"); (* Allow users to select which test to run *) ("--fsection", Arg.String (fun g -> global_fsection := String.uppercase_ascii g; - global_filter := true), " Set test filter"); + global_filter := true), " Set test filter"); ("--ftitle", Arg.String (fun g -> global_ftitle := String.uppercase_ascii g; - global_filter := true), " Set test filter"); + global_filter := true), " Set test filter"); ]
@@ -69,99 +71,114 @@ let cut_byte str = String.sub str 0 ((String.length str) - 10) let cut_native str = String.sub str 0 ((String.length str) - 12)
let cut_name str = - if (Filename.check_suffix str "_test.byte") - then (cut_byte str) - else (cut_native str) + if Filename.check_suffix str "_test.byte" + then cut_byte str + else cut_native str
let print_file_name i n name pass = - let line_size = 80 - (String.length (cut_name name)) - 16 in - let name = cut_name name in - - (if pass then print_string green else print_string red); - print_string " ("; - ralign_print_int i 2; print_string "/"; - ralign_print_int n 2; print_string ") "; - print_string name; - print_string (make_line '.' line_size); - if pass then print_string "..OK\n" else print_string "FAIL\n"; - print_string reset + let line_size = 80 - (String.length (cut_name name)) - 16 in + let name = cut_name name in + + (if pass then print_string green else print_string red); + print_string " ("; + ralign_print_int i 2; print_string "/"; + ralign_print_int n 2; print_string ") "; + print_string name; + print_string (make_line '.' line_size); + if pass then print_string "..OK\n" else print_string "FAIL\n"; + print_string reset
let must_run str = - not (!global_filter) + not !global_filter || String.uppercase_ascii (cut_name str) = !global_fsection
-(* search *_test.byte executable en run them - Usage: - ./utest_main tests_folder root_folder *) let main () = - parse_args (); - - print_string "\n"; - calign_print_string " Running Unit Test " 80; - print_string "\n\n"; - - (*print_string ("[ ] Test folder: " ^ folder ^ "\n"); *) - - (* get tests files *) - let folder = !global_tests_dir in - let root_folder = !global_sample_dir in - - let files = try Sys.readdir folder - with e ->( - print_string ("The folder: " ^ (! global_tests_dir) ^ " does not exist.\n" ^ - "Have you tried "./utests --tests= ./tests" ?\n"); - raise e; - ) in - - let check name = - if (Filename.check_suffix name "_test.byte") || - (Filename.check_suffix name "_test.native") then true else false in - - (* select files that are executable tests *) - let files = Array.fold_left - (fun acc elem -> if check elem then elem::acc else acc) - [] files in - - let files_n = List.length files in - - (if files_n = 0 then ( - print_string "No tests were found. Did you compiled them? \n")); - - let exit_code = ref 0 in - let failed_test = ref 0 in - let tests_n = ref 0 in - let test_args = - ["--samples"; root_folder; - "--verbose"; (string_of_int !global_verbose_lvl)] @ - (if not (!global_ftitle = "") then - ["--ftitle"; !global_ftitle] else []) in - - List.iter (fun file -> - flush stdout; - - if must_run file then ( - tests_n := !tests_n + 1; - let command = String.concat " " (List.map Filename.quote - ((folder ^ file)::test_args)) in - exit_code := Sys.command command; - - (if !exit_code != 0 then( - (if verbose 1 then print_file_name (!tests_n) files_n file false); - failed_test := !failed_test + 1) - else - (if verbose 1 then print_file_name (!tests_n) files_n file true); - ); - - (if verbose 2 then print_newline ()); - - ); - - ) files; - - print_string "\n\n"; - print_string " Test Ran : "; print_int !tests_n; - print_string "\n Test Failed : "; print_int !failed_test; - print_string "\n Test Passed : "; print_int (!tests_n - !failed_test); - print_endline "\n" + parse_args (); + + print_string "\n"; + calign_print_string " Running Unit Test " 80; + print_string "\n\n"; + + (*print_string ("[ ] Test folder: " ^ folder ^ "\n"); *) + + (* get tests files *) + let folder = !global_tests_dir in + let root_folder = !global_sample_dir in + + let files = + try Sys.readdir folder + with + | e + -> (print_string ("The folder: " ^ !global_tests_dir + ^ " does not exist.\n" + ^ "Have you tried "./utests --tests= ./tests" ?\n"); + raise e) + in + + let check name = + Filename.check_suffix name "_test.byte" + || Filename.check_suffix name "_test.native" + in + + (* select files that are executable tests *) + let files = Array.fold_left + (fun acc elem -> if check elem then elem::acc else acc) + [] files in + + let files_n = List.length files in + + (if files_n = 0 then + print_string "No tests were found. Did you compiled them? \n"); + + let exit_code = ref 0 in + let failed_test = ref 0 in + let tests_n = ref 0 in + let test_args = + ["--samples"; root_folder; + "--verbose"; string_of_int !global_verbose_lvl] + @ (if not (!global_ftitle = "") then + ["--ftitle"; !global_ftitle] else []) in + + let run_file test_path = + flush stdout; + + tests_n := !tests_n + 1; + let command_parts = Filename.concat folder test_path :: test_args in + let command_parts = + if Sys.os_type = "Win32" + then + (* I wish Filename.quote could be used on Windows. + + It would be appropriate if Ocaml spawned the process through the C + API, but Sys.command passes does it through the shell, which is + cmd.exe and has its own quoting rules. Ocaml has + Filename.quote_command, which does the right thing on every platform, + but it is only available since Ocaml 4.10. Until then, let's hope the + command does not need to be escaped. *) + command_parts + else List.map Filename.quote command_parts + in + + print_endline (String.concat " " command_parts); + exit_code := Sys.command (String.concat " " command_parts); + + (if !exit_code != 0 + then + ((if verbose 1 then print_file_name !tests_n files_n test_path false); + failed_test := !failed_test + 1) + else + (if verbose 1 then print_file_name !tests_n files_n test_path true); + ); + + (if verbose 2 then print_newline ()); + in + + List.iter run_file (List.filter must_run files); + + print_string "\n\n"; + print_string " Test Ran : "; print_int !tests_n; + print_string "\n Test Failed : "; print_int !failed_test; + print_string "\n Test Passed : "; print_int (!tests_n - !failed_test); + print_endline "\n"
let _ = main ();
View it on GitLab: https://gitlab.com/monnier/typer/-/compare/f73bc318925edbcb397217538a9a526b4...