Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ocamltest: introduce the result module 

This module contains types describing test results and functions to
build and use them.

Before this commit, only successful actions were returning an environemnt.
Starting from this commit, actions always return an environemnt, no matter
their result.

This will make it possible to write negations over tests.
master
Sébastien Hinderer 2018-02-04 19:27:15 +01:00
parent b2321e12b7
commit 8c75ba867f
13 changed files with 277 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
ocamltest/.depend
View File

@ -8,20 +8,20 @@ run_stubs.$(O): run_stubs.c run.h ../byterun/caml/misc.h \
../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
../byterun/caml/io.h ../byterun/caml/osdeps.h ../byterun/caml/memory.h
actions.cmo : environments.cmi actions.cmi
actions.cmx : environments.cmx actions.cmi
actions.cmi : environments.cmi
actions_helpers.cmo : variables.cmi run_command.cmi ocamltest_stdlib.cmi \
filecompare.cmi environments.cmi builtin_variables.cmi actions.cmi \
actions_helpers.cmi
actions_helpers.cmx : variables.cmx run_command.cmx ocamltest_stdlib.cmx \
filecompare.cmx environments.cmx builtin_variables.cmx actions.cmx \
actions_helpers.cmi
actions_helpers.cmi : variables.cmi environments.cmi actions.cmi
builtin_actions.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
actions.cmo : result.cmi environments.cmi actions.cmi
actions.cmx : result.cmx environments.cmx actions.cmi
actions.cmi : result.cmi environments.cmi
actions_helpers.cmo : variables.cmi run_command.cmi result.cmi \
ocamltest_stdlib.cmi filecompare.cmi environments.cmi \
builtin_variables.cmi actions_helpers.cmi
actions_helpers.cmx : variables.cmx run_command.cmx result.cmx \
ocamltest_stdlib.cmx filecompare.cmx environments.cmx \
builtin_variables.cmx actions_helpers.cmi
actions_helpers.cmi : variables.cmi result.cmi environments.cmi actions.cmi
builtin_actions.cmo : result.cmi ocamltest_stdlib.cmi ocamltest_config.cmi \
environments.cmi builtin_variables.cmi actions_helpers.cmi actions.cmi \
builtin_actions.cmi
builtin_actions.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
builtin_actions.cmx : result.cmx ocamltest_stdlib.cmx ocamltest_config.cmx \
environments.cmx builtin_variables.cmx actions_helpers.cmx actions.cmx \
builtin_actions.cmi
builtin_actions.cmi : actions.cmi
@ -38,18 +38,18 @@ filetype.cmo : filetype.cmi
filetype.cmx : filetype.cmi
filetype.cmi :
main.cmo : tsl_semantics.cmi tsl_parser.cmi tsl_lexer.cmi tests.cmi \
options.cmi ocamltest_stdlib.cmi environments.cmi builtin_variables.cmi \
actions_helpers.cmi actions.cmi main.cmi
result.cmi options.cmi ocamltest_stdlib.cmi environments.cmi \
builtin_variables.cmi actions_helpers.cmi actions.cmi main.cmi
main.cmx : tsl_semantics.cmx tsl_parser.cmx tsl_lexer.cmx tests.cmx \
options.cmx ocamltest_stdlib.cmx environments.cmx builtin_variables.cmx \
actions_helpers.cmx actions.cmx main.cmi
result.cmx options.cmx ocamltest_stdlib.cmx environments.cmx \
builtin_variables.cmx actions_helpers.cmx actions.cmx main.cmi
main.cmi :
ocaml_actions.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
ocaml_actions.cmo : result.cmi ocamltest_stdlib.cmi ocamltest_config.cmi \
ocaml_variables.cmi ocaml_flags.cmi ocaml_files.cmi ocaml_directories.cmi \
ocaml_compilers.cmi ocaml_commands.cmi ocaml_backends.cmi filetype.cmi \
filecompare.cmi environments.cmi builtin_variables.cmi \
actions_helpers.cmi actions.cmi ocaml_actions.cmi
ocaml_actions.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
ocaml_actions.cmx : result.cmx ocamltest_stdlib.cmx ocamltest_config.cmx \
ocaml_variables.cmx ocaml_flags.cmx ocaml_files.cmx ocaml_directories.cmx \
ocaml_compilers.cmx ocaml_commands.cmx ocaml_backends.cmx filetype.cmx \
filecompare.cmx environments.cmx builtin_variables.cmx \
@ -61,13 +61,13 @@ ocaml_backends.cmi : ocamltest_stdlib.cmi
ocaml_commands.cmo : ocaml_files.cmi ocaml_commands.cmi
ocaml_commands.cmx : ocaml_files.cmx ocaml_commands.cmi
ocaml_commands.cmi :
ocaml_compilers.cmo : variables.cmi ocaml_variables.cmi ocaml_files.cmi \
ocaml_commands.cmi ocaml_backends.cmi environments.cmi \
ocaml_compilers.cmo : variables.cmi ocamltest_stdlib.cmi ocaml_variables.cmi \
ocaml_files.cmi ocaml_commands.cmi ocaml_backends.cmi environments.cmi \
ocaml_compilers.cmi
ocaml_compilers.cmx : variables.cmx ocaml_variables.cmx ocaml_files.cmx \
ocaml_commands.cmx ocaml_backends.cmx environments.cmx \
ocaml_compilers.cmx : variables.cmx ocamltest_stdlib.cmx ocaml_variables.cmx \
ocaml_files.cmx ocaml_commands.cmx ocaml_backends.cmx environments.cmx \
ocaml_compilers.cmi
ocaml_compilers.cmi : variables.cmi environments.cmi
ocaml_compilers.cmi : variables.cmi ocamltest_stdlib.cmi environments.cmi
ocaml_directories.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
ocaml_directories.cmi
ocaml_directories.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
@ -105,12 +105,15 @@ ocamltest_stdlib.cmi :
options.cmo : tests.cmi actions.cmi options.cmi
options.cmx : tests.cmx actions.cmx options.cmi
options.cmi :
result.cmo : result.cmi
result.cmx : result.cmi
result.cmi :
run_command.cmo : ocamltest_stdlib.cmi run_command.cmi
run_command.cmx : ocamltest_stdlib.cmx run_command.cmi
run_command.cmi :
tests.cmo : actions.cmi tests.cmi
tests.cmx : actions.cmx tests.cmi
tests.cmi : environments.cmi actions.cmi
tests.cmo : result.cmi actions.cmi tests.cmi
tests.cmx : result.cmx actions.cmx tests.cmi
tests.cmi : result.cmi environments.cmi actions.cmi
tsl_ast.cmo : tsl_ast.cmi
tsl_ast.cmx : tsl_ast.cmi
tsl_ast.cmi :

1
ocamltest/Makefile
View File

@ -50,6 +50,7 @@ core := \
filecompare.mli filecompare.ml \
variables.mli variables.ml \
environments.mli environments.ml \
result.mli result.ml \
actions.mli actions.ml \
tests.mli tests.ml \
tsl_ast.mli tsl_ast.ml \

16
ocamltest/actions.ml
View File

@ -15,21 +15,7 @@
(* Definition of actions, basic blocks for tests *)
type result =
| Pass of Environments.t
| Fail of string
| Skip of string
let string_of_reason prefix reason =
if reason="" then prefix
else prefix ^ " (" ^ reason ^ ")"
let string_of_result = function
| Pass _ -> "Pass"
| Fail reason -> string_of_reason "Fail" reason
| Skip reason -> string_of_reason "Skip" reason
type code = out_channel -> Environments.t -> result
type code = out_channel -> Environments.t -> Result.t * Environments.t
type t = {
name : string;

11
ocamltest/actions.mli
View File

@ -15,14 +15,7 @@
(* Definition of actions, basic blocks for tests *)
type result =
| Pass of Environments.t
| Fail of string
| Skip of string
val string_of_result : result -> string
type code = out_channel -> Environments.t -> result
type code = out_channel -> Environments.t -> Result.t * Environments.t
type t
@ -42,6 +35,6 @@ val set_hook : string -> code -> unit
val clear_hook : string -> unit
val clear_all_hooks : unit -> unit
val run : out_channel -> Environments.t -> t -> result
val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
module ActionSet : Set.S with type elt = t

41
ocamltest/actions_helpers.ml
View File

@ -16,13 +16,14 @@
(* Helper functions when writing actions *)
open Ocamltest_stdlib
open Actions
let pass_or_skip test log_on_pass log_on_skip log env =
if test then begin
Printf.fprintf log "%s%!" log_on_pass;
Pass env
end else Skip log_on_skip
let pass_or_skip test pass_reason skip_reason _log env =
let open Result in
let result =
if test
then pass_with_reason pass_reason
else skip_with_reason skip_reason in
(result, env)
let mkreason what commandline exitcode =
Printf.sprintf "%s: command\n%s\nfailed with exit code %d"
@ -69,7 +70,7 @@ let setup_build_env add_testfile additional_files (_log : out_channel) env =
else some_files in
setup_symlinks (test_source_directory env) build_dir files;
Sys.chdir build_dir;
Pass env
(Result.pass, env)
let setup_simple_build_env add_testfile additional_files log env =
let build_env = Environments.add
@ -146,7 +147,7 @@ let run
| None ->
let msg = Printf.sprintf "%s: variable %s is undefined"
log_message (Variables.name_of_variable prog_variable) in
Fail msg
(Result.fail_with_reason msg, env)
| Some program ->
let arguments = match args_variable with
| None -> ""
@ -174,13 +175,12 @@ let run
if redirect_output
then Environments.add Builtin_variables.output output env
else env in
Pass newenv
(Result.pass, newenv)
| _ as exitcode ->
let reason = mkreason what (String.concat " " commandline) exitcode in
if exitcode = 125 && can_skip
then Skip (mkreason
what (String.concat " " commandline) exitcode)
else Fail (mkreason
what (String.concat " " commandline) exitcode)
then (Result.skip_with_reason reason, execution_env)
else (Result.fail_with_reason reason, execution_env)
let run_program =
run
@ -222,11 +222,14 @@ let run_hook hook_name log input_env =
match exit_status with
| 0 ->
let modifiers = Environments.modifiers_of_file response_file in
Pass (Environments.apply_modifiers hookenv modifiers)
let modified_env = Environments.apply_modifiers hookenv modifiers in
(Result.pass, modified_env)
| _ ->
Printf.fprintf log "Hook returned %d" exit_status;
let reason = String.trim (Sys.string_of_file response_file) in
if exit_status=125 then Skip reason else Fail reason
if exit_status=125
then (Result.skip_with_reason reason, hookenv)
else (Result.fail_with_reason reason, hookenv)
let check_output kind_of_output output_variable reference_variable log env =
let reference_filename = Environments.safe_lookup reference_variable env in
@ -240,7 +243,7 @@ let check_output kind_of_output output_variable reference_variable log env =
Filecompare.output_filename = output_filename
} in
match Filecompare.check_file files with
| Filecompare.Same -> Pass env
| Filecompare.Same -> (Result.pass, env)
| Filecompare.Different ->
let diff = Filecompare.diff files in
let diffstr = match diff with
@ -249,7 +252,7 @@ let check_output kind_of_output output_variable reference_variable log env =
let reason =
Printf.sprintf "%s output %s differs from reference %s: \n%s\n"
kind_of_output output_filename reference_filename diffstr in
(Fail reason)
(Result.fail_with_reason reason, env)
| Filecompare.Unexpected_output ->
let banner = String.make 40 '=' in
let unexpected_output = Sys.string_of_file output_filename in
@ -259,8 +262,8 @@ let check_output kind_of_output output_variable reference_variable log env =
"The file %s was expected to be empty because there is no \
reference file %s but it is not:\n%s\n"
output_filename reference_filename unexpected_output_with_banners in
(Fail reason)
(Result.fail_with_reason reason, env)
| Filecompare.Error (commandline, exitcode) ->
let reason = Printf.sprintf "The command %s failed with status %d"
commandline exitcode in
(Fail reason)
(Result.fail_with_reason reason, env)

3
ocamltest/actions_helpers.mli
View File

@ -16,7 +16,8 @@
(* Helper functions when writing actions *)
val pass_or_skip
: bool -> string -> string -> out_channel -> Environments.t -> Actions.result
: bool -> string -> string -> out_channel -> Environments.t
-> Result.t * Environments.t
val mkreason : string -> string -> int -> string

21
ocamltest/builtin_actions.ml
View File

@ -20,33 +20,38 @@ open Actions
let pass = make
"pass"
(fun log env ->
Printf.fprintf log "The pass action always succeeds.\n%!";
Pass env)
(fun _log env ->
let result =
Result.pass_with_reason "The pass action always succeeds." in
(result, env))
let skip = make
"skip"
(fun _log _env -> Skip "The skip action always skips.")
(fun _log env ->
let result = Result.skip_with_reason "The skip action always skips." in
(result, env))
let fail = make
"fail"
(fun _log _env -> Fail "The fail action always fails.")
(fun _log env ->
let result = Result.fail_with_reason "The fail action always fails." in
(result, env))
let dumpenv = make
"dumpenv"
(fun log env ->
Environments.dump log env; Pass env)
Environments.dump log env; (Result.pass, env))
let unix = make
"unix"
(Actions_helpers.pass_or_skip Ocamltest_config.unix
"The unix action succeeds because we are on a Unix system.\n"
"The unix action succeeds because we are on a Unix system."
"The unix action skips because we are on a Windows system.")
let windows = make
"windows"
(Actions_helpers.pass_or_skip (not Ocamltest_config.unix)
"The windows action succeeds because we are on a Windows system.\n"
"The windows action succeeds because we are on a Windows system."
"The windows action skips because we are on a Unix system.")
let setup_build_env = make

9
ocamltest/main.ml
View File

@ -66,11 +66,10 @@ let rec run_test log common_prefix path behavior = function
| Run env ->
let testenv0 = interprete_environment_statements env testenvspec in
let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
let t = Tests.run log testenv test in
(match t with
| Actions.Pass env -> "passed", Run env
| Actions.Skip _ -> "skipped", Skip_all_tests
| Actions.Fail _ -> "failed", Skip_all_tests) in
let (result, newenv) = Tests.run log testenv test in
let s = Result.string_of_result result in
if Result.is_pass result then (s, Run newenv)
else (s, Skip_all_tests) in
Printf.printf "%s\n%!" msg;
List.iteri (run_test_i log common_prefix path b) subtrees
and run_test_i log common_prefix path behavior i test_tree =

178
ocamltest/ocaml_actions.ml
View File

@ -121,9 +121,15 @@ let compile_program ocamlsrcdir compiler program_variable log env =
~append:true
log env commandline in
if exit_status=expected_exit_status
then Pass (Environments.add program_variable program_file env)
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status)
then begin
let newenv = Environments.add program_variable program_file env in
(Result.pass, newenv)
end else begin
let reason =
(Actions_helpers.mkreason
what (String.concat " " commandline) exit_status) in
(Result.fail_with_reason reason, env)
end
let compile_module ocamlsrcdir compiler module_ log env =
let backend = compiler.Ocaml_compilers.backend in
@ -152,9 +158,13 @@ let compile_module ocamlsrcdir compiler module_ log env =
~append:true
log env commandline in
if exit_status=expected_exit_status
then Pass env
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status)
then (Result.pass, env)
else begin
let reason =
(Actions_helpers.mkreason
what (String.concat " " commandline) exit_status) in
(Result.fail_with_reason reason, env)
end
let module_has_interface directory module_name =
let interface_name =
@ -314,30 +324,30 @@ let run_expect_once ocamlsrcdir input_file principal log env =
] in
let exit_status =
Actions_helpers.run_cmd ~environment:dumb_term log env commandline in
if exit_status=0 then Pass env
else Fail (Actions_helpers.mkreason
"expect" (String.concat " " commandline) exit_status)
if exit_status=0 then (Result.pass, env)
else begin
let reason = (Actions_helpers.mkreason
"expect" (String.concat " " commandline) exit_status) in
(Result.fail_with_reason reason, env)
end
let run_expect_twice ocamlsrcdir input_file log env =
let corrected filename = Filename.make_filename filename "corrected" in
let first_run = run_expect_once ocamlsrcdir input_file false log env in
match first_run with
| Skip _ | Fail _ -> first_run
| Pass env1 ->
let intermediate_file = corrected input_file in
let second_run =
run_expect_once ocamlsrcdir intermediate_file true log env1 in
(match second_run with
| Skip _ | Fail _ -> second_run
| Pass env2 ->
let output_file = corrected intermediate_file in
let output_env = Environments.add_bindings
[
Builtin_variables.reference, input_file;
Builtin_variables.output, output_file
] env2 in
Pass output_env
)
let (result1, env1) = run_expect_once ocamlsrcdir input_file false log env in
if Result.is_pass result1 then begin
let intermediate_file = corrected input_file in
let (result2, env2) =
run_expect_once ocamlsrcdir intermediate_file true log env1 in
if Result.is_pass result2 then begin
let output_file = corrected intermediate_file in
let output_env = Environments.add_bindings
[
Builtin_variables.reference, input_file;
Builtin_variables.output, output_file
] env2 in
(Result.pass, output_env)
end else (result2, env2)
end else (result1, env1)
let run_expect log env =
let ocamlsrcdir = Ocaml_directories.srcdir () in
@ -378,15 +388,15 @@ let really_compare_programs backend comparison_tool log env =
} in
if Ocamltest_config.flambda && backend = Sys.Native
then begin
Printf.fprintf log
"flambda temporarily disables comparison of native programs";
Pass env
let reason =
"flambda temporarily disables comparison of native programs" in
(Result.pass_with_reason reason, env)
end else
if backend = Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
then begin
Printf.fprintf log
"comparison of native programs temporarily disabled under Windows";
Pass env
let reason =
"comparison of native programs temporarily disabled under Windows" in
(Result.pass_with_reason reason, env)
end else begin
let comparison_tool =
if backend=Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
@ -395,23 +405,23 @@ let really_compare_programs backend comparison_tool log env =
Filecompare.make_cmp_tool bytes_to_ignore
else comparison_tool in
match Filecompare.compare_files ~tool:comparison_tool files with
| Filecompare.Same -> Pass env
| Filecompare.Same -> (Result.pass, env)
| Filecompare.Different ->
let reason = Printf.sprintf "Files %s and %s are different"
program program2 in
Fail reason
(Result.fail_with_reason reason, env)
| Filecompare.Unexpected_output -> assert false
| Filecompare.Error (commandline, exitcode) ->
let reason = Actions_helpers.mkreason what commandline exitcode in
Fail reason
(Result.fail_with_reason reason, env)
end
let compare_programs backend comparison_tool log env =
let compare_programs =
Environments.safe_lookup Ocaml_variables.compare_programs env in
if compare_programs = "false" then begin
Printf.fprintf log "Skipping program comparison (disabled)";
Pass env
let reason = "program comparison disabled" in
(Result.pass_with_reason reason, env)
end else really_compare_programs backend comparison_tool log env
let make_bytecode_programs_comparison_tool ocamlsrcdir =
@ -468,9 +478,13 @@ let compile_module
~stderr_variable:compileroutput
~append:true log env commandline in
if exit_status=expected_exit_status
then Pass env
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status) in
then (Result.pass, env)
else begin
let reason =
(Actions_helpers.mkreason
what (String.concat " " commandline) exit_status) in
(Result.fail_with_reason reason, env)
end in
match module_filetype with
| Filetype.Interface ->
let interface_name =
@ -494,7 +508,7 @@ let compile_module
| _ ->
let reason = Printf.sprintf "File %s of type %s not supported yet"
filename (Filetype.string_of_filetype module_filetype) in
(Fail reason)
(Result.fail_with_reason reason, env)
let compile_modules
ocamlsrcdir compiler compilername compileroutput
@ -504,12 +518,11 @@ let compile_modules
compile_module ocamlsrcdir compiler compilername compileroutput
log env mod_ in
let rec compile_mods env = function
| [] -> Pass env
| [] -> (Result.pass, env)
| m::ms ->
(match compile_mod env m with
| Fail _ | Skip _ as error -> error
| Pass newenv -> (compile_mods newenv ms)
) in
(let (result, newenv) = compile_mod env m in
if Result.is_pass result then (compile_mods newenv ms)
else (result, newenv)) in
compile_mods initial_env modules_with_filetypes
let run_test_program_in_toplevel toplevel log env =
@ -524,43 +537,44 @@ let run_test_program_in_toplevel toplevel log env =
| Sys.Other _ -> assert false in
let compiler_name = compiler.Ocaml_compilers.name ocamlsrcdir in
let modules_with_filetypes = List.map Filetype.filetype (modules env) in
let aux = compile_modules
let (modules_result, modules_env) = compile_modules
ocamlsrcdir compiler compiler_name compiler_output_variable
modules_with_filetypes log env in
match aux with
| Fail _ | Skip _ -> aux
| Pass auxenv ->
begin
let what =
Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
testfile
(Ocaml_backends.string_of_backend toplevel.Ocaml_compilers.backend)
expected_exit_status in
Printf.fprintf log "%s\n%!" what;
let toplevel_name = toplevel.Ocaml_compilers.name ocamlsrcdir in
let toplevel_default_flags = "-noinit -no-version -noprompt" in
let commandline =
[
toplevel_name;
toplevel_default_flags;
toplevel.Ocaml_compilers.flags;
Ocaml_flags.stdlib ocamlsrcdir;
directory_flags auxenv;
Ocaml_flags.include_toplevel_directory ocamlsrcdir;
flags auxenv;
] in
let exit_status =
Actions_helpers.run_cmd
~environment:dumb_term
~stdin_variable:Builtin_variables.test_file
~stdout_variable:compiler_output_variable
~stderr_variable:compiler_output_variable
log auxenv commandline in
if exit_status=expected_exit_status
then Pass auxenv
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status)
end
if Result.is_pass modules_result then begin
let what =
Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
testfile
(Ocaml_backends.string_of_backend toplevel.Ocaml_compilers.backend)
expected_exit_status in
Printf.fprintf log "%s\n%!" what;
let toplevel_name = toplevel.Ocaml_compilers.name ocamlsrcdir in
let toplevel_default_flags = "-noinit -no-version -noprompt" in
let commandline =
[
toplevel_name;
toplevel_default_flags;
toplevel.Ocaml_compilers.flags;
Ocaml_flags.stdlib ocamlsrcdir;
directory_flags modules_env;
Ocaml_flags.include_toplevel_directory ocamlsrcdir;
flags modules_env;
] in
let exit_status =
Actions_helpers.run_cmd
~environment:dumb_term
~stdin_variable:Builtin_variables.test_file
~stdout_variable:compiler_output_variable
~stderr_variable:compiler_output_variable
log modules_env commandline in
if exit_status=expected_exit_status
then (Result.pass, modules_env)
else begin
let reason =
(Actions_helpers.mkreason
what (String.concat " " commandline) exit_status) in
(Result.fail_with_reason reason, modules_env)
end
end else (modules_result, modules_env)
let ocaml = Actions.make
"ocaml"

57
ocamltest/result.ml Normal file
View File

@ -0,0 +1,57 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2018 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Definition of test-result related types and functions *)
type status = Pass | Skip | Fail
type t = {
status : status;
reason : string option
}
let result_of_status s = { status = s; reason = None }
let pass = result_of_status Pass
let skip = result_of_status Skip
let fail = result_of_status Fail
let result_with_reason s r = { status = s; reason = Some r }
let pass_with_reason r = result_with_reason Pass r
let skip_with_reason r = result_with_reason Skip r
let fail_with_reason r = result_with_reason Fail r
let string_of_status = function
| Pass -> "passed"
| Skip -> "skipped"
| Fail -> "failed"
let string_of_reason = function
| None -> ""
| Some reason -> (" (" ^ reason ^ ")")
let string_of_result r =
(string_of_status r.status) ^ (string_of_reason r.reason)
let is_pass r = r.status = Pass
let is_skip r = r.status = Skip
let is_fail r = r.status = Fail

43
ocamltest/result.mli Normal file
View File

@ -0,0 +1,43 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2018 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Definition of test-result related types and functions *)
type status = Pass | Skip | Fail
type t = {
status : status;
reason : string option
}
val pass : t
val skip : t
val fail : t
val pass_with_reason : string -> t
val skip_with_reason : string -> t
val fail_with_reason : string -> t
val string_of_result : t -> string
val is_pass : t -> bool
val is_skip : t -> bool
val is_fail : t -> bool

19
ocamltest/tests.ml
View File

@ -51,25 +51,18 @@ let test_of_action action =
let run_actions log testenv actions =
let total = List.length actions in
let rec run_actions_aux action_number env = function
| [] -> Actions.Pass env
| [] -> (Result.pass, env)
| action::remaining_actions ->
begin
Printf.fprintf log "Running action %d/%d (%s)\n%!"
action_number total (Actions.action_name action);
let result = Actions.run log env action in
let report = match result with
| Actions.Pass _ -> "succeded."
| Actions.Fail reason ->
("failed for the following reason:\n" ^ reason)
| Actions.Skip reason ->
("has been skipped for the following reason:\n" ^ reason) in
let (result, env') = Actions.run log env action in
Printf.fprintf log "Action %d/%d (%s) %s\n%!"
action_number total (Actions.action_name action)
report;
match result with
| Actions.Pass env' ->
run_actions_aux (action_number+1) env' remaining_actions
| _ -> result
(Result.string_of_result result);
if Result.is_pass result
then run_actions_aux (action_number+1) env' remaining_actions
else (result, env')
end in
run_actions_aux 1 testenv actions

2
ocamltest/tests.mli
View File

@ -31,7 +31,7 @@ val default_tests : unit -> t list
val lookup : string -> t option
val run : out_channel -> Environments.t -> t -> Actions.result
val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
val test_of_action : Actions.t -> t