From beb80b38c483f7ad1ab84e35dfc7898f1f8255ad Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Mon, 26 Oct 2020 06:52:03 +0300 Subject: [PATCH] Switch to cram tests for instrumentation testing Resolves #340. Resolves #342. --- .travis.yml | 37 +- Makefile | 11 +- bisect_ppx.opam | 8 + dune-project | 1 + src/common/bisect_common.ml | 3 +- src/ppx/exclusions.ml | 2 +- src/ppx/instrument.ml | 23 +- src/ppx/register.ml | 2 +- test/inspect/dune | 3 - test/inspect/inspect.ml | 317 ------------------ test/instrument/apply/and.t | 51 +++ test/instrument/apply/apply.t | 63 ++++ test/instrument/apply/dune | 3 + test/instrument/apply/operator.t | 25 ++ test/instrument/apply/or.t | 88 +++++ test/instrument/apply/pipe.t | 30 ++ test/instrument/apply/special.t | 314 +++++++++++++++++ test/instrument/attribute.t | 82 +++++ test/instrument/class/class.t | 64 ++++ test/instrument/class/dune | 3 + test/instrument/class/instvar.t | 35 ++ test/instrument/class/method.t | 92 +++++ test/instrument/class/new.t | 34 ++ test/instrument/class/send.t | 45 +++ test/instrument/control/dune | 3 + test/instrument/control/for.t | 60 ++++ test/instrument/control/fun.t | 90 +++++ test/instrument/control/function.t | 41 +++ test/instrument/control/if.t | 71 ++++ test/instrument/control/lazy.t | 22 ++ test/instrument/control/match.t | 43 +++ test/instrument/control/newtype.t | 17 + test/instrument/control/try.t | 40 +++ test/instrument/control/while.t | 36 ++ test/instrument/dune | 3 + test/instrument/pattern/binding.t | 43 +++ test/instrument/pattern/dune | 3 + test/instrument/pattern/exception.t | 47 +++ test/instrument/pattern/nary.t | 104 ++++++ test/instrument/pattern/nullary.t | 124 +++++++ test/instrument/pattern/unary.t | 121 +++++++ test/instrument/pattern/when.t | 57 ++++ test/instrument/recent/dune | 2 + test/instrument/recent/error.t | 9 + test/instrument/recent/exception-pattern.t | 53 +++ test/instrument/recent/let-exception.t | 9 + test/instrument/recent/letop.t | 31 ++ test/instrument/recent/opaque_identity.t | 6 + test/instrument/recent/pattern-open.t | 34 ++ test/instrument/recent/refutation.t | 24 ++ test/instrument/structure.t | 24 ++ test/instrument/test.sh | 48 +++ test/instrument/value.t | 224 +++++++++++++ test/unit/fixtures/attributes/expression.ml | 95 ------ .../attributes/expression.reference.ml | 78 ----- test/unit/fixtures/attributes/file.ml | 3 - .../fixtures/attributes/file.reference.ml | 2 - test/unit/fixtures/attributes/floating.ml | 25 -- .../fixtures/attributes/floating.reference.ml | 28 -- test/unit/fixtures/attributes/include.ml | 10 - .../fixtures/attributes/include.reference.ml | 21 -- test/unit/fixtures/attributes/let.ml | 14 - .../unit/fixtures/attributes/let.reference.ml | 22 -- test/unit/fixtures/instrument/apply.ml | 60 ---- .../fixtures/instrument/apply.reference.ml | 47 --- test/unit/fixtures/instrument/array.ml | 3 - .../fixtures/instrument/array.reference.ml | 18 - test/unit/fixtures/instrument/assert.ml | 59 ---- .../fixtures/instrument/assert.reference.ml | 27 -- test/unit/fixtures/instrument/attribute.ml | 11 - .../instrument/attribute.reference.ml | 18 - test/unit/fixtures/instrument/cases.ml | 106 ------ .../fixtures/instrument/cases.reference.ml | 184 ---------- test/unit/fixtures/instrument/class.ml | 55 --- .../fixtures/instrument/class.reference.ml | 37 -- test/unit/fixtures/instrument/coerce.ml | 7 - .../fixtures/instrument/coerce.reference.ml | 17 - test/unit/fixtures/instrument/constant.ml | 3 - .../fixtures/instrument/constant.reference.ml | 16 - test/unit/fixtures/instrument/constraint.ml | 7 - .../instrument/constraint.reference.ml | 17 - test/unit/fixtures/instrument/construct.ml | 11 - .../instrument/construct.reference.ml | 20 -- test/unit/fixtures/instrument/field.ml | 17 - .../fixtures/instrument/field.reference.ml | 21 -- test/unit/fixtures/instrument/for.ml | 5 - .../unit/fixtures/instrument/for.reference.ml | 20 -- test/unit/fixtures/instrument/fun.ml | 31 -- .../unit/fixtures/instrument/fun.reference.ml | 27 -- test/unit/fixtures/instrument/function.ml | 14 - .../fixtures/instrument/function.reference.ml | 33 -- test/unit/fixtures/instrument/ident.ml | 5 - .../fixtures/instrument/ident.reference.ml | 17 - test/unit/fixtures/instrument/ifthenelse.ml | 36 -- .../instrument/ifthenelse.reference.ml | 36 -- test/unit/fixtures/instrument/lazy.ml | 3 - .../fixtures/instrument/lazy.reference.ml | 16 - test/unit/fixtures/instrument/let.ml | 9 - .../unit/fixtures/instrument/let.reference.ml | 22 -- .../fixtures/instrument/letexception_404.ml | 10 - .../instrument/letexception_404.reference.ml | 17 - test/unit/fixtures/instrument/letmodule.ml | 19 -- .../instrument/letmodule.reference.ml | 23 -- test/unit/fixtures/instrument/letop_408.ml | 20 -- .../instrument/letop_408.reference.ml | 31 -- test/unit/fixtures/instrument/match.ml | 41 --- .../fixtures/instrument/match.reference.ml | 60 ---- test/unit/fixtures/instrument/match_408.ml | 57 ---- .../instrument/match_408.reference.ml | 91 ----- test/unit/fixtures/instrument/new.ml | 23 -- .../unit/fixtures/instrument/new.reference.ml | 21 -- test/unit/fixtures/instrument/newtype.ml | 3 - .../fixtures/instrument/newtype.reference.ml | 16 - test/unit/fixtures/instrument/object.ml | 6 - .../fixtures/instrument/object.reference.ml | 16 - test/unit/fixtures/instrument/open.ml | 9 - .../fixtures/instrument/open.reference.ml | 17 - test/unit/fixtures/instrument/override.ml | 8 - .../fixtures/instrument/override.reference.ml | 22 -- test/unit/fixtures/instrument/pack.ml | 7 - .../fixtures/instrument/pack.reference.ml | 17 - .../unit/fixtures/instrument/ppat_open_404.ml | 21 -- .../instrument/ppat_open_404.reference.ml | 55 --- test/unit/fixtures/instrument/record.ml | 18 - .../fixtures/instrument/record.reference.ml | 26 -- test/unit/fixtures/instrument/send.ml | 31 -- .../fixtures/instrument/send.reference.ml | 27 -- test/unit/fixtures/instrument/sequence.ml | 13 - .../fixtures/instrument/sequence.reference.ml | 23 -- test/unit/fixtures/instrument/setfield.ml | 17 - .../fixtures/instrument/setfield.reference.ml | 23 -- test/unit/fixtures/instrument/setinstvar.ml | 8 - .../instrument/setinstvar.reference.ml | 22 -- test/unit/fixtures/instrument/submodule.ml | 6 - .../instrument/submodule.reference.ml | 16 - test/unit/fixtures/instrument/try.ml | 22 -- .../unit/fixtures/instrument/try.reference.ml | 35 -- test/unit/fixtures/instrument/tuple.ml | 3 - .../fixtures/instrument/tuple.reference.ml | 18 - .../fixtures/instrument/unreachable_403.ml | 8 - .../instrument/unreachable_403.reference.ml | 16 - test/unit/fixtures/instrument/variant.ml | 7 - .../fixtures/instrument/variant.reference.ml | 17 - test/unit/fixtures/instrument/while.ml | 5 - .../fixtures/instrument/while.reference.ml | 19 -- test/unit/test_attributes.ml | 10 - test/unit/test_instrument.ml | 10 - test/unit/test_main.ml | 2 - 148 files changed, 2388 insertions(+), 2682 deletions(-) delete mode 100644 test/inspect/dune delete mode 100644 test/inspect/inspect.ml create mode 100644 test/instrument/apply/and.t create mode 100644 test/instrument/apply/apply.t create mode 100644 test/instrument/apply/dune create mode 100644 test/instrument/apply/operator.t create mode 100644 test/instrument/apply/or.t create mode 100644 test/instrument/apply/pipe.t create mode 100644 test/instrument/apply/special.t create mode 100644 test/instrument/attribute.t create mode 100644 test/instrument/class/class.t create mode 100644 test/instrument/class/dune create mode 100644 test/instrument/class/instvar.t create mode 100644 test/instrument/class/method.t create mode 100644 test/instrument/class/new.t create mode 100644 test/instrument/class/send.t create mode 100644 test/instrument/control/dune create mode 100644 test/instrument/control/for.t create mode 100644 test/instrument/control/fun.t create mode 100644 test/instrument/control/function.t create mode 100644 test/instrument/control/if.t create mode 100644 test/instrument/control/lazy.t create mode 100644 test/instrument/control/match.t create mode 100644 test/instrument/control/newtype.t create mode 100644 test/instrument/control/try.t create mode 100644 test/instrument/control/while.t create mode 100644 test/instrument/dune create mode 100644 test/instrument/pattern/binding.t create mode 100644 test/instrument/pattern/dune create mode 100644 test/instrument/pattern/exception.t create mode 100644 test/instrument/pattern/nary.t create mode 100644 test/instrument/pattern/nullary.t create mode 100644 test/instrument/pattern/unary.t create mode 100644 test/instrument/pattern/when.t create mode 100644 test/instrument/recent/dune create mode 100644 test/instrument/recent/error.t create mode 100644 test/instrument/recent/exception-pattern.t create mode 100644 test/instrument/recent/let-exception.t create mode 100644 test/instrument/recent/letop.t create mode 100644 test/instrument/recent/opaque_identity.t create mode 100644 test/instrument/recent/pattern-open.t create mode 100644 test/instrument/recent/refutation.t create mode 100644 test/instrument/structure.t create mode 100644 test/instrument/test.sh create mode 100644 test/instrument/value.t delete mode 100644 test/unit/fixtures/attributes/expression.ml delete mode 100644 test/unit/fixtures/attributes/expression.reference.ml delete mode 100644 test/unit/fixtures/attributes/file.ml delete mode 100644 test/unit/fixtures/attributes/file.reference.ml delete mode 100644 test/unit/fixtures/attributes/floating.ml delete mode 100644 test/unit/fixtures/attributes/floating.reference.ml delete mode 100644 test/unit/fixtures/attributes/include.ml delete mode 100644 test/unit/fixtures/attributes/include.reference.ml delete mode 100644 test/unit/fixtures/attributes/let.ml delete mode 100644 test/unit/fixtures/attributes/let.reference.ml delete mode 100644 test/unit/fixtures/instrument/apply.ml delete mode 100644 test/unit/fixtures/instrument/apply.reference.ml delete mode 100644 test/unit/fixtures/instrument/array.ml delete mode 100644 test/unit/fixtures/instrument/array.reference.ml delete mode 100644 test/unit/fixtures/instrument/assert.ml delete mode 100644 test/unit/fixtures/instrument/assert.reference.ml delete mode 100644 test/unit/fixtures/instrument/attribute.ml delete mode 100644 test/unit/fixtures/instrument/attribute.reference.ml delete mode 100644 test/unit/fixtures/instrument/cases.ml delete mode 100644 test/unit/fixtures/instrument/cases.reference.ml delete mode 100644 test/unit/fixtures/instrument/class.ml delete mode 100644 test/unit/fixtures/instrument/class.reference.ml delete mode 100644 test/unit/fixtures/instrument/coerce.ml delete mode 100644 test/unit/fixtures/instrument/coerce.reference.ml delete mode 100644 test/unit/fixtures/instrument/constant.ml delete mode 100644 test/unit/fixtures/instrument/constant.reference.ml delete mode 100644 test/unit/fixtures/instrument/constraint.ml delete mode 100644 test/unit/fixtures/instrument/constraint.reference.ml delete mode 100644 test/unit/fixtures/instrument/construct.ml delete mode 100644 test/unit/fixtures/instrument/construct.reference.ml delete mode 100644 test/unit/fixtures/instrument/field.ml delete mode 100644 test/unit/fixtures/instrument/field.reference.ml delete mode 100644 test/unit/fixtures/instrument/for.ml delete mode 100644 test/unit/fixtures/instrument/for.reference.ml delete mode 100644 test/unit/fixtures/instrument/fun.ml delete mode 100644 test/unit/fixtures/instrument/fun.reference.ml delete mode 100644 test/unit/fixtures/instrument/function.ml delete mode 100644 test/unit/fixtures/instrument/function.reference.ml delete mode 100644 test/unit/fixtures/instrument/ident.ml delete mode 100644 test/unit/fixtures/instrument/ident.reference.ml delete mode 100644 test/unit/fixtures/instrument/ifthenelse.ml delete mode 100644 test/unit/fixtures/instrument/ifthenelse.reference.ml delete mode 100644 test/unit/fixtures/instrument/lazy.ml delete mode 100644 test/unit/fixtures/instrument/lazy.reference.ml delete mode 100644 test/unit/fixtures/instrument/let.ml delete mode 100644 test/unit/fixtures/instrument/let.reference.ml delete mode 100644 test/unit/fixtures/instrument/letexception_404.ml delete mode 100644 test/unit/fixtures/instrument/letexception_404.reference.ml delete mode 100644 test/unit/fixtures/instrument/letmodule.ml delete mode 100644 test/unit/fixtures/instrument/letmodule.reference.ml delete mode 100644 test/unit/fixtures/instrument/letop_408.ml delete mode 100644 test/unit/fixtures/instrument/letop_408.reference.ml delete mode 100644 test/unit/fixtures/instrument/match.ml delete mode 100644 test/unit/fixtures/instrument/match.reference.ml delete mode 100644 test/unit/fixtures/instrument/match_408.ml delete mode 100644 test/unit/fixtures/instrument/match_408.reference.ml delete mode 100644 test/unit/fixtures/instrument/new.ml delete mode 100644 test/unit/fixtures/instrument/new.reference.ml delete mode 100644 test/unit/fixtures/instrument/newtype.ml delete mode 100644 test/unit/fixtures/instrument/newtype.reference.ml delete mode 100644 test/unit/fixtures/instrument/object.ml delete mode 100644 test/unit/fixtures/instrument/object.reference.ml delete mode 100644 test/unit/fixtures/instrument/open.ml delete mode 100644 test/unit/fixtures/instrument/open.reference.ml delete mode 100644 test/unit/fixtures/instrument/override.ml delete mode 100644 test/unit/fixtures/instrument/override.reference.ml delete mode 100644 test/unit/fixtures/instrument/pack.ml delete mode 100644 test/unit/fixtures/instrument/pack.reference.ml delete mode 100644 test/unit/fixtures/instrument/ppat_open_404.ml delete mode 100644 test/unit/fixtures/instrument/ppat_open_404.reference.ml delete mode 100644 test/unit/fixtures/instrument/record.ml delete mode 100644 test/unit/fixtures/instrument/record.reference.ml delete mode 100644 test/unit/fixtures/instrument/send.ml delete mode 100644 test/unit/fixtures/instrument/send.reference.ml delete mode 100644 test/unit/fixtures/instrument/sequence.ml delete mode 100644 test/unit/fixtures/instrument/sequence.reference.ml delete mode 100644 test/unit/fixtures/instrument/setfield.ml delete mode 100644 test/unit/fixtures/instrument/setfield.reference.ml delete mode 100644 test/unit/fixtures/instrument/setinstvar.ml delete mode 100644 test/unit/fixtures/instrument/setinstvar.reference.ml delete mode 100644 test/unit/fixtures/instrument/submodule.ml delete mode 100644 test/unit/fixtures/instrument/submodule.reference.ml delete mode 100644 test/unit/fixtures/instrument/try.ml delete mode 100644 test/unit/fixtures/instrument/try.reference.ml delete mode 100644 test/unit/fixtures/instrument/tuple.ml delete mode 100644 test/unit/fixtures/instrument/tuple.reference.ml delete mode 100644 test/unit/fixtures/instrument/unreachable_403.ml delete mode 100644 test/unit/fixtures/instrument/unreachable_403.reference.ml delete mode 100644 test/unit/fixtures/instrument/variant.ml delete mode 100644 test/unit/fixtures/instrument/variant.reference.ml delete mode 100644 test/unit/fixtures/instrument/while.ml delete mode 100644 test/unit/fixtures/instrument/while.reference.ml delete mode 100644 test/unit/test_attributes.ml delete mode 100644 test/unit/test_instrument.ml diff --git a/.travis.yml b/.travis.yml index 800b955e..881f5a3f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,6 @@ sudo: required language: generic +dist: focal scripts: - &bucklescript @@ -83,10 +84,30 @@ scripts: opam switch create . $COMPILER $REPOSITORIES --no-install fi - eval `opam config env` - - ocaml -version + - ocamlc -version - opam --version - - opam install -y --with-test --deps-only . + - | + case `ocamlc -version` in + "4.02.3") OCAMLFORMAT_BINARY=YES;; + "4.03.0") OCAMLFORMAT_BINARY=YES;; + "4.04.2") OCAMLFORMAT_BINARY=YES;; + "4.05.0") OCAMLFORMAT_BINARY=YES;; + esac + - | + if [ "$OCAMLFORMAT_BINARY" == YES ] + then + opam install -y --deps-only . + opam install -y --unset-root ocamlfind ounit2 + wget https://github.com/aantron/ocamlformat-binary/releases/download/0.15.0/ocamlformat + sudo mv ocamlformat /usr/local/bin/ocamlformat + sudo chmod a+x /usr/local/bin/ocamlformat + else + opam install -y --deps-only . --with-test + fi + - which ocamlformat + - ocamlformat --version + - opam list script: @@ -96,7 +117,17 @@ scripts: cp -r _cache/_build . fi - make build - - (unset TRAVIS && unset TRAVIS_JOB_ID && make test) + - | + case `ocamlc -version` in + "4.02.3") TEST_ALIAS=@compatible;; + "4.03.0") TEST_ALIAS=@compatible;; + "4.04.2") TEST_ALIAS=@compatible;; + "4.05.0") TEST_ALIAS=@compatible;; + "4.06.1") TEST_ALIAS=@compatible;; + "4.07.1") TEST_ALIAS=@compatible;; + *) TEST_ALIAS=@runtest;; + esac + - (unset TRAVIS && unset TRAVIS_JOB_ID && make test TEST=$TEST_ALIAS) - | if [ ! -d _cache/_build ] then diff --git a/Makefile b/Makefile index 8f196af2..014bc3ed 100644 --- a/Makefile +++ b/Makefile @@ -2,9 +2,15 @@ build : dune build -p bisect_ppx +TEST := @runtest + .PHONY : test test : build - dune runtest -p bisect_ppx --force --no-buffer -j 1 + dune build -p bisect_ppx $(TEST) + +.PHONY : promote +promote : + dune promote SELF_COVERAGE := _self @@ -67,6 +73,7 @@ self-coverage-workspace : cp -r $(SOURCES) $(SELF_COVERAGE)/bisect_ppx/ mkdir -p $(SELF_COVERAGE)/bisect_ppx/test cp -r test/unit $(SELF_COVERAGE)/bisect_ppx/test/ + cp -r test/instrument $(SELF_COVERAGE)/bisect_ppx/test/ cd $(SELF_COVERAGE)/meta_bisect_ppx && \ patch --no-backup-if-mismatch -p2 < ../../test/self/meta_bisect_ppx.diff cd $(SELF_COVERAGE)/bisect_ppx && \ @@ -108,7 +115,7 @@ self-coverage-test : cd $(SELF_COVERAGE) && rm -f bisect*.meta cd $(SELF_COVERAGE) && dune build @install --instrument-with meta_bisect_ppx cd $(SELF_COVERAGE) && \ - dune runtest --force --no-buffer -j 1 --instrument-with meta_bisect_ppx + dune build --force --instrument-with meta_bisect_ppx $(TEST) rm -rf _coverage cd $(SELF_COVERAGE) && \ _build/install/default/bin/meta-bisect-ppx-report \ diff --git a/bisect_ppx.opam b/bisect_ppx.opam index 27bdeb38..7cba3f57 100644 --- a/bisect_ppx.opam +++ b/bisect_ppx.opam @@ -27,9 +27,17 @@ depends: [ "ppx_tools_versioned" {>= "5.4.0"} "ocamlfind" {with-test} + "ocamlformat" {with-test & = "git.1bf68a7"} "ounit2" {with-test} ] +pin-depends: [ + # This is the last commit before ocamlformat's ppxlib conversion. A newer + # commit, or no pin at all, can be used once Bisect_ppx is also converted to + # ppxlib. + ["ocamlformat.git.1bf68a7" "git+https://github.com/ocaml-ppx/ocamlformat.git#1bf68a70f1480df80a8ab0bd20a799b8e1df0081"] +] + build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name] {with-test} diff --git a/dune-project b/dune-project index 45acd3f0..e1e4354c 100644 --- a/dune-project +++ b/dune-project @@ -1 +1,2 @@ (lang dune 2.7) +(cram enable) diff --git a/src/common/bisect_common.ml b/src/common/bisect_common.ml index b7c2e831..6d8b6068 100644 --- a/src/common/bisect_common.ml +++ b/src/common/bisect_common.ml @@ -172,7 +172,7 @@ let write_runtime_data channel = output_string channel data let () = - Random.self_init () + Random.self_init () [@coverage off] let random_filename base_name = Printf.sprintf "%s%09d.coverage" base_name (abs (Random.int 1000000000)) @@ -229,6 +229,7 @@ let bisect_silent = ref None type options = (Arg.key * Arg.spec * Arg.doc) list +[@@@coverage off] let deprecated binary basename options = let make make_spec fn = (basename, diff --git a/src/ppx/exclusions.ml b/src/ppx/exclusions.ml index c6ee75a2..6a6379ba 100644 --- a/src/ppx/exclusions.ml +++ b/src/ppx/exclusions.ml @@ -10,7 +10,7 @@ type t = let excluded = ref [] -let function_separator = Str.regexp "[ \t]*,[ \t]*" +let function_separator = Str.regexp "[ \t]*,[ \t]*" [@coverage off] let add s = let patterns = Str.split function_separator s in diff --git a/src/ppx/instrument.ml b/src/ppx/instrument.ml index 8b3e7a43..1466fb47 100644 --- a/src/ppx/instrument.ml +++ b/src/ppx/instrument.ml @@ -528,9 +528,9 @@ struct (C B, D E), [loc B, loc E] (C B, D F), [loc B, loc F] - During recursion, the invariant on the location is that it is the - location of the nearest enclosing or-pattern, or the entire pattern, if - there is no enclosing or-pattern. *) + During recursion, the invariant on the location is that it is the + location of the nearest enclosing or-pattern, or the entire pattern, if + there is no enclosing or-pattern. *) and rotate_or_patterns_to_top loc p : rotated_case list = let rec recurse ~enclosing_loc p : rotated_case list = @@ -636,7 +636,7 @@ struct pattern lists (on the left side) into tuples. This is typical of "and-patterns", i.e. those that match various - product types (though that carry multiple pieces of data + product types (those that carry multiple pieces of data simultaneously). *) | Ppat_tuple ps -> ps @@ -710,6 +710,8 @@ struct | Ppat_or (p_1, p_2) -> has_exception_pattern p_1 || has_exception_pattern p_2 + (* Should be unreachable, because or-patterns will have been rotated out + of all patterns by the time this is called. *) | Ppat_constraint (p', _) -> has_exception_pattern p' @@ -1356,17 +1358,20 @@ class instrumenter = | Pexp_letexception (c, e) -> Exp.letexception ~loc ~attrs c (traverse ~is_in_tail_position e) + | Pexp_open (m, e) -> + Exp.open_ ~loc ~attrs + (self#open_declaration m) + (traverse ~is_in_tail_position e) + + (* Expressions that don't need instrumentation, and where AST + traversal leaves the expression language. *) | Pexp_object c -> Exp.object_ ~loc ~attrs (self#class_structure c) | Pexp_pack m -> Exp.pack ~loc ~attrs (self#module_expr m) - | Pexp_open (m, e) -> - Exp.open_ ~loc ~attrs - (self#open_declaration m) - (traverse ~is_in_tail_position e) - + (* Expressions that are not recursively traversed at all. *) | Pexp_extension _ | Pexp_unreachable -> e end diff --git a/src/ppx/register.ml b/src/ppx/register.ml index 5d6ac4df..c911d5ff 100644 --- a/src/ppx/register.ml +++ b/src/ppx/register.ml @@ -72,7 +72,7 @@ let switches = [ " Default value for BISECT_SILENT environment variable"); ] -let deprecated = Common.deprecated "bisect_ppx" +let deprecated = Common.deprecated "bisect_ppx" [@coverage off] let switches = switches diff --git a/test/inspect/dune b/test/inspect/dune deleted file mode 100644 index 79a94e63..00000000 --- a/test/inspect/dune +++ /dev/null @@ -1,3 +0,0 @@ -(executable - (name inspect) - (libraries bisect_ppx.common notty.unix str)) diff --git a/test/inspect/inspect.ml b/test/inspect/inspect.ml deleted file mode 100644 index 8c058df7..00000000 --- a/test/inspect/inspect.ml +++ /dev/null @@ -1,317 +0,0 @@ -module Common = Bisect_common - -let command a = - Printf.ksprintf (fun s -> - let exit_code = Sys.command s in - if exit_code <> 0 then - exit exit_code) a - -let note_temporary_file file = - at_exit (fun () -> - if Sys.file_exists file then - Sys.remove file) - -let read_lines file = - let channel = open_in file in - let rec read acc = - match input_line channel with - | line -> read (line::acc) - | exception End_of_file -> close_in channel; List.rev acc - in - read [] - -type 'event ui_mode = { - mutable scroll : int; - lines : int; - render : unit -> unit; - event : 'event -> unit; - scrolled : unit -> unit; -} - -let () = - (* Load the source file. *) - - let source_file = - match Sys.argv.(1) with - | file -> file - | exception Invalid_argument _ -> - prerr_endline "Usage: inspect.exe FILE"; - exit 1 - in - let source_code = read_lines source_file in - - - (* Instrument the source file, and load the result. *) - - let temporary_file_1 = "temporary_1" in - let temporary_file_2 = "temporary_2" in - note_temporary_file temporary_file_1; - note_temporary_file temporary_file_2; - - command "_build/default/.ppx/bisect_ppx/ppx.exe %s > %s" - source_file temporary_file_1; - let instrumented_code = read_lines temporary_file_1 in - - let prefix = "sed 's/^[^\"]*\"//'" in - let suffix = "sed 's/\"[^\"]*$//'" in - command "grep '\"\\\\' %s | head -n 1 | %s | %s > %s" - temporary_file_1 prefix suffix temporary_file_2; - let points = - read_lines temporary_file_2 - |> List.hd - |> Scanf.unescaped - |> Common.read_points - in - - Sys.remove temporary_file_1; - Sys.remove temporary_file_2; - - - (* Run the UI. *) - - let open Notty in - let open Notty_unix in - - let t = Term.create () in - let viewport_height () = snd (Term.size t) - 1 in - (* Term.cursor t (Some (0, viewport_height ())); *) - - let pad_line width s = - s ^ (String.make (max 0 (width - String.length s)) ' ') - |> fun s -> String.sub s 0 (min width (String.length s)) - in - - let render_code code = - let width = fst (Term.size t) in - code @ (Array.make (viewport_height ()) " " |> Array.to_list) - |> List.map (pad_line width) - |> List.map (I.string A.empty) - |> I.vcat - in - - let points = - let line_start_offsets = - List.fold_left (fun (offset, acc) line -> - (String.length line + offset + 1, offset::acc)) (0, []) source_code - |> snd - |> List.rev - in - let look_up_point_location offset = - let rec scan line_number line_start_offsets = - match line_start_offsets with - | this_offset::next_offset::more -> - if offset < next_offset then - (line_number, offset - this_offset) - else - scan (line_number + 1) (next_offset::more) - | [this_offset] -> - (line_number, offset - this_offset) - | [] -> - (line_number, 0) - in - scan 0 line_start_offsets - in - let look_up_point_character (line, column) = - try (List.nth source_code line).[column] - with Invalid_argument _ -> ' ' - in - points - |> List.map (fun {Common.offset; identifier} -> - let location = look_up_point_location offset in - (identifier, location, look_up_point_character location)) - |> List.mapi (fun index (identifier, loc, c) -> - ((index, identifier), loc, c)) - in - - let find_point index = - let (_, identifier), _, _ = List.nth points index in - let pattern = Printf.sprintf "___bisect_visit___ %i" identifier in - let regexp = Str.regexp_string pattern in - let rec scan = fun line_number -> function - | [] -> - None - | line::more -> - match Str.search_forward regexp line 0 with - | exception Not_found -> - scan (line_number + 1) more - | position -> - Some (line_number, position, pattern) - in - scan 0 instrumented_code - in - - let points_image = - let attr = A.(fg lightyellow ++ bg lightblack ++ st underline ++ st bold) in - let point_image (_, (line, column), c) = - I.(pad ~l:column ~t:line @@ strf ~attr "%c" c) in - points - |> List.map point_image - |> I.zcat - in - - let line_highlight_image index = - List.nth points index - |> fun (_, (line, _), _) -> - let bg = pad_line (fst (Term.size t)) (List.nth source_code line) in - I.(pad ~t:line @@ string A.(bg lightblack) bg) - in - - let current_point_image index = - let attr = A.(fg black ++ bg lightyellow ++ st underline ++ st bold) in - List.nth points index - |> fun (_, (line, column), c) -> - I.(pad ~l:column ~t:line @@ strf ~attr "%c" c) - in - - let source_code_image = ref (render_code source_code) in - let instrumented_image = ref (render_code instrumented_code) in - let point_highlight = ref I.empty in - - let input = Buffer.create 256 in - - let status_line typing text = - let width = fst (Term.size t) in - let cursor_position = - if typing then - Buffer.length input - else - fst (Term.size t) - 2 - in - Term.cursor t (Some (cursor_position, viewport_height ())); - let text = pad_line width text in - I.(pad ~t:(viewport_height ()) @@ string A.(fg black ++ bg lightwhite) text) - in - - let current = ref 0 in - - let rec source_mode = { - scroll = 0; - lines = List.length source_code; - render = begin fun () -> - let view = - I.(current_point_image !current - points_image - line_highlight_image !current - !source_code_image) - |> I.vcrop - (0 + source_mode.scroll) - (source_mode.lines - (viewport_height ()) - source_mode.scroll) - in - let status_line = - if Buffer.length input = 0 then - Printf.ksprintf (status_line false) "Point %i" !current - else - status_line true (Buffer.contents input) - in - I.(status_line view) |> Term.image t - end; - event = begin function - | `Key (`Enter, _) -> - if Buffer.length input = 0 then begin - mode := instrumented_mode; - match find_point !current with - | None -> - () - | Some (line, column, text) -> - let attr = A.(fg black ++ bg lightyellow ++ st bold) in - point_highlight := I.(pad ~t:line ~l:column @@ string attr text); - show_line line - end - else begin - let index = Buffer.contents input |> int_of_string in - Buffer.clear input; - let index = max 0 index in - let index = min (List.length points - 1) index in - current := index; - show_point () - end - | `Key (`Arrow `Right, _) -> - current := min (List.length points - 1) (!current + 1); - show_point () - | `Key (`Arrow `Left, _) -> - current := max 0 (!current - 1); - show_point () - | `Key (`ASCII ('0'..'9' as c), _) -> - Buffer.add_char input c - | `Key (`Backspace, _) -> - if Buffer.length input > 0 then - Buffer.truncate input (Buffer.length input - 1) - | _ -> - () - end; - scrolled = begin fun () -> - let point_visible (_, (line, _), _) = - line >= source_mode.scroll && - line < source_mode.scroll + viewport_height () - in - if point_visible (List.nth points !current) then - () - else - try - points - |> List.filter point_visible - |> List.sort (fun (_, (line, column), _) (_, (line', column'), _) -> - match compare line line' with - | 0 -> compare column column' - | order -> order) - |> List.hd - |> fun ((index, _), _, _) -> current := index - with Failure _ -> - () - end; - } - and instrumented_mode = { - scroll = 0; - lines = List.length instrumented_code; - render = begin fun () -> - I.(status_line false "Press ENTER to return" - - (!point_highlight - !instrumented_image - |> vcrop - (0 + instrumented_mode.scroll) - (instrumented_mode.lines - - (viewport_height ()) - instrumented_mode.scroll))) - |> Term.image t - end; - event = begin function - | `Key (`Enter, _) -> mode := source_mode - | _ -> () - end; - scrolled = ignore; - } - and mode = ref source_mode - and clamp line = - let line = max 0 line in - let line = min (!mode.lines - viewport_height ()) line in - !mode.scroll <- line - and scroll offset = - clamp (!mode.scroll + offset) - and show_line line = - let padding = viewport_height () / 2 in - if line < !mode.scroll then - clamp (line - padding) - else - if line >= !mode.scroll + viewport_height () then - clamp (line - padding) - and show_point () = - match List.nth points !current with - | _, (line, _), _ -> show_line line - | exception Invalid_argument _ -> () - in - - (* TODO Go to selected point. *) - let done_ = ref false in - while not !done_ do - !mode.render (); - match Term.event t with - | `Key (`ASCII 'q', _) -> done_ := true - | `Key (`Arrow `Down, _) -> scroll 1; !mode.scrolled (); - | `Key (`Arrow `Up, _) -> scroll (-1); !mode.scrolled (); - | `Key (`ASCII ' ', _) -> scroll (viewport_height ()); !mode.scrolled (); - | `Key (`ASCII 'b', _) -> scroll (-(viewport_height ())); !mode.scrolled (); - | `Key (`ASCII 'g', []) -> !mode.scroll <- 0; !mode.scrolled (); - | `Key (`ASCII 'G', []) -> - !mode.scroll <- !mode.lines - viewport_height (); !mode.scrolled (); - | event -> !mode.event event - done diff --git a/test/instrument/apply/and.t b/test/instrument/apply/and.t new file mode 100644 index 00000000..e03beca6 --- /dev/null +++ b/test/instrument/apply/and.t @@ -0,0 +1,51 @@ +In logical AND, control might not reach the second argument, so it is +instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = true && false + > let _ = (true & false) [@ocaml.warning "-3"] + > EOF + let _ = + true + && + (___bisect_visit___ 0; + false) + + let _ = + (true + & + (___bisect_visit___ 1; + false)) + [@ocaml.warning "-3"] + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = (bool_of_string "true") && (bool_of_string "false") + > let _ = + > ((bool_of_string "true") & (bool_of_string "false")) [@ocaml.warning "-3"] + > EOF + let _ = + ___bisect_post_visit___ 2 (bool_of_string "true") + && + (___bisect_visit___ 1; + ___bisect_post_visit___ 0 (bool_of_string "false")) + + let _ = + (___bisect_post_visit___ 5 (bool_of_string "true") + & + (___bisect_visit___ 4; + ___bisect_post_visit___ 3 (bool_of_string "false"))) + [@ocaml.warning "-3"] + + +Partial application. See https://github.com/aantron/bisect_ppx/issues/333. + + $ bash ../test.sh <<'EOF' + > [@@@ocaml.warning "-5"] + > let _ = (&&) (List.mem 0 []) + > EOF + [@@@ocaml.warning "-5"] + + let _ = ( && ) (___bisect_post_visit___ 0 (List.mem 0 [])) diff --git a/test/instrument/apply/apply.t b/test/instrument/apply/apply.t new file mode 100644 index 00000000..5d1cc5ac --- /dev/null +++ b/test/instrument/apply/apply.t @@ -0,0 +1,63 @@ +Post-instrumented when they are not in tail position. + + $ bash ../test.sh <<'EOF' + > let _ = print_endline "foo" + > EOF + let _ = ___bisect_post_visit___ 0 (print_endline "foo") + + +Not instrumented when in tail position. + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> print_endline "foo" + > EOF + let _ = + fun () -> + ___bisect_visit___ 0; + print_endline "foo" + + +Arguments instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let _ = String.trim (String.trim "foo") + > EOF + let _ = + ___bisect_post_visit___ 1 + (String.trim (___bisect_post_visit___ 0 (String.trim "foo"))) + + +Function position instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let _ = (List.map ignore) [] + > EOF + let _ = + ___bisect_post_visit___ 0 ((___bisect_post_visit___ 0 (List.map ignore)) []) + + +Multiple arguments don't produce nested instrumentation. + + $ bash ../test.sh <<'EOF' + > let _ = List.map ignore [] + > EOF + let _ = ___bisect_post_visit___ 0 (List.map ignore []) + + +Labels preserved. + + $ bash ../test.sh <<'EOF' + > let _ = ListLabels.iter ~f:ignore [] + > EOF + let _ = ___bisect_post_visit___ 0 (ListLabels.iter ~f:ignore []) + + +Instrumentation suppressed if all arguments labeled. + + $ bash ../test.sh <<'EOF' + > [@@@ocaml.warning "-5"] + > let _ = ListLabels.iter ~f:ignore + > EOF + [@@@ocaml.warning "-5"] + + let _ = ListLabels.iter ~f:ignore diff --git a/test/instrument/apply/dune b/test/instrument/apply/dune new file mode 100644 index 00000000..3add053e --- /dev/null +++ b/test/instrument/apply/dune @@ -0,0 +1,3 @@ +(cram + (deps ../test.sh) + (alias compatible)) diff --git a/test/instrument/apply/operator.t b/test/instrument/apply/operator.t new file mode 100644 index 00000000..fac6881a --- /dev/null +++ b/test/instrument/apply/operator.t @@ -0,0 +1,25 @@ +Instrumentation of partially-applied functions on the left of (@@) is +suppressed. + + $ bash ../test.sh <<'EOF' + > let _ = ListLabels.iter ~f:ignore @@ [] + > EOF + let _ = ___bisect_post_visit___ 0 (ListLabels.iter ~f:ignore @@ []) + + +Subexpressions instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let _ = String.concat (String.trim "") @@ [];; + > let _ = (fun () -> ()) @@ ();; + > EOF + let _ = + ___bisect_post_visit___ 1 + (String.concat (___bisect_post_visit___ 0 (String.trim "")) @@ []) + + let _ = + ___bisect_post_visit___ 3 + ((fun () -> + ___bisect_visit___ 2; + ()) + @@ ()) diff --git a/test/instrument/apply/or.t b/test/instrument/apply/or.t new file mode 100644 index 00000000..0ff42de2 --- /dev/null +++ b/test/instrument/apply/or.t @@ -0,0 +1,88 @@ +Logical OR is expanded so that the operands can be instrumented individually. + + $ bash ../test.sh <<'EOF' + > let _ = true || false + > let _ = true or false + > EOF + let _ = + if true then ( + ___bisect_visit___ 0; + true) + else if false then ( + ___bisect_visit___ 1; + true) + else false + + let _ = + if true then ( + ___bisect_visit___ 2; + true) + else if false then ( + ___bisect_visit___ 3; + true) + else false + + +If the right operand is also a logical OR, the instrumentation is "associative" +rather than nested. + + $ bash ../test.sh <<'EOF' + > let _ = true || true || false + > let _ = true or true or false + > EOF + let _ = + if true then ( + ___bisect_visit___ 0; + true) + else if + if true then ( + ___bisect_visit___ 1; + true) + else if false then ( + ___bisect_visit___ 2; + true) + else false + then true + else false + + let _ = + if true then ( + ___bisect_visit___ 3; + true) + else if + if true then ( + ___bisect_visit___ 5; + true) + else if false then ( + ___bisect_visit___ 4; + true) + else false + then ( + ___bisect_visit___ 4; + true) + else false + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = (bool_of_string "true") || (bool_of_string "false") + > let _ = (bool_of_string "true") or (bool_of_string "false") + > EOF + let _ = + if ___bisect_post_visit___ 3 (bool_of_string "true") then ( + ___bisect_visit___ 0; + true) + else if ___bisect_post_visit___ 2 (bool_of_string "false") then ( + ___bisect_visit___ 1; + true) + else false + + let _ = + if ___bisect_post_visit___ 7 (bool_of_string "true") then ( + ___bisect_visit___ 4; + true) + else if ___bisect_post_visit___ 6 (bool_of_string "false") then ( + ___bisect_visit___ 5; + true) + else false diff --git a/test/instrument/apply/pipe.t b/test/instrument/apply/pipe.t new file mode 100644 index 00000000..0c9b9fd1 --- /dev/null +++ b/test/instrument/apply/pipe.t @@ -0,0 +1,30 @@ +Pipe is given special treatment, to instrument it intuitively as an application +of a function to an argument, rather than a function to two arguments. + + $ bash ../test.sh <<'EOF' + > let _ = "" |> String.trim + > EOF + let _ = ___bisect_post_visit___ 0 ("" |> String.trim) + + +Subexpressions instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let _ = (String.trim "") |> (fun s -> String.trim s) + > EOF + let _ = + ___bisect_post_visit___ 2 + ( ___bisect_post_visit___ 1 (String.trim "") |> fun s -> + ___bisect_visit___ 0; + String.trim s ) + + +Instrumentation suppressed in tail position. + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> "" |> String.trim + > EOF + let _ = + fun () -> + ___bisect_visit___ 0; + "" |> String.trim diff --git a/test/instrument/apply/special.t b/test/instrument/apply/special.t new file mode 100644 index 00000000..6a11d013 --- /dev/null +++ b/test/instrument/apply/special.t @@ -0,0 +1,314 @@ +Instrumentation is suppressed for all of the following function names. +Subexpressions are still instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = not (List.mem () []) + > EOF + let _ = not (___bisect_post_visit___ 0 (List.mem () [])) + + + $ bash ../test.sh <<'EOF' + > let _ = (print_endline "foo") = (print_endline "bar") + > let _ = (=) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") <> (print_endline "bar") + > let _ = (<>) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") < (print_endline "bar") + > let _ = (<) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") <= (print_endline "bar") + > let _ = (<=) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") > (print_endline "bar") + > let _ = (>) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") >= (print_endline "bar") + > let _ = (>=) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") == (print_endline "bar") + > let _ = (==) (print_endline "foo") (print_endline "bar") + > let _ = (print_endline "foo") != (print_endline "bar") + > let _ = (!=) (print_endline "foo") (print_endline "bar") + > EOF + let _ = + ___bisect_post_visit___ 0 (print_endline "foo") + = ___bisect_post_visit___ 1 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 2 (print_endline "foo") + = ___bisect_post_visit___ 3 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 4 (print_endline "foo") + <> ___bisect_post_visit___ 5 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 6 (print_endline "foo") + <> ___bisect_post_visit___ 7 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 8 (print_endline "foo") + < ___bisect_post_visit___ 9 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 10 (print_endline "foo") + < ___bisect_post_visit___ 11 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 12 (print_endline "foo") + <= ___bisect_post_visit___ 13 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 14 (print_endline "foo") + <= ___bisect_post_visit___ 15 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 16 (print_endline "foo") + > ___bisect_post_visit___ 17 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 18 (print_endline "foo") + > ___bisect_post_visit___ 19 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 20 (print_endline "foo") + >= ___bisect_post_visit___ 21 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 22 (print_endline "foo") + >= ___bisect_post_visit___ 23 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 24 (print_endline "foo") + == ___bisect_post_visit___ 25 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 26 (print_endline "foo") + == ___bisect_post_visit___ 27 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 28 (print_endline "foo") + != ___bisect_post_visit___ 29 (print_endline "bar") + + let _ = + ___bisect_post_visit___ 30 (print_endline "foo") + != ___bisect_post_visit___ 31 (print_endline "bar") + + + $ bash ../test.sh <<'EOF' + > let _ = ref (print_endline "foo") + > let _ = !(ref (print_endline "foo")) + > let _ = ref (print_endline "foo") := (print_endline "bar") + > let _ = (:=) (ref (print_endline "foo")) (print_endline "bar") + > EOF + let _ = ref (___bisect_post_visit___ 0 (print_endline "foo")) + + let _ = !(ref (___bisect_post_visit___ 1 (print_endline "foo"))) + + let _ = + ref (___bisect_post_visit___ 2 (print_endline "foo")) + := ___bisect_post_visit___ 3 (print_endline "bar") + + let _ = + ref (___bisect_post_visit___ 4 (print_endline "foo")) + := ___bisect_post_visit___ 5 (print_endline "bar") + + + $ bash ../test.sh <<'EOF' + > let _ = (List.rev []) @ (List.rev []) + > let _ = (@) (List.rev []) (List.rev []) + > let _ = (String.trim "") ^ (String.trim "") + > let _ = (^) (String.trim "") (String.trim "") + > EOF + let _ = + ___bisect_post_visit___ 0 (List.rev []) + @ ___bisect_post_visit___ 1 (List.rev []) + + let _ = + ___bisect_post_visit___ 2 (List.rev []) + @ ___bisect_post_visit___ 3 (List.rev []) + + let _ = + ___bisect_post_visit___ 4 (String.trim "") + ^ ___bisect_post_visit___ 5 (String.trim "") + + let _ = + ___bisect_post_visit___ 6 (String.trim "") + ^ ___bisect_post_visit___ 7 (String.trim "") + + $ bash ../test.sh <<'EOF' + > let _ = (List.length []) + (List.length []) + > let _ = (+) (List.length []) (List.length []) + > let _ = (List.length []) - (List.length []) + > let _ = (-) (List.length []) (List.length []) + > let _ = (List.length []) * (List.length []) + > let _ = ( * ) (List.length []) (List.length []) + > let _ = (List.length []) / (List.length []) + > let _ = (/) (List.length []) (List.length []) + > let _ = (List.length []) mod (List.length []) + > let _ = (mod) (List.length []) (List.length []) + > let _ = (float_of_int 0) +. (float_of_int 0) + > let _ = (+.) (float_of_int 0) (float_of_int 0) + > let _ = (float_of_int 0) +. (float_of_int 0) + > let _ = (-.) (float_of_int 0) (float_of_int 0) + > let _ = (float_of_int 0) *. (float_of_int 0) + > let _ = ( *. ) (float_of_int 0) (float_of_int 0) + > let _ = (float_of_int 0) /. (float_of_int 0) + > let _ = (/.) (float_of_int 0) (float_of_int 0) + > EOF + let _ = + ___bisect_post_visit___ 0 (List.length []) + + ___bisect_post_visit___ 1 (List.length []) + + let _ = + ___bisect_post_visit___ 2 (List.length []) + + ___bisect_post_visit___ 3 (List.length []) + + let _ = + ___bisect_post_visit___ 4 (List.length []) + - ___bisect_post_visit___ 5 (List.length []) + + let _ = + ___bisect_post_visit___ 6 (List.length []) + - ___bisect_post_visit___ 7 (List.length []) + + let _ = + ___bisect_post_visit___ 8 (List.length []) + * ___bisect_post_visit___ 9 (List.length []) + + let _ = + ___bisect_post_visit___ 10 (List.length []) + * ___bisect_post_visit___ 11 (List.length []) + + let _ = + ___bisect_post_visit___ 12 (List.length []) + / ___bisect_post_visit___ 13 (List.length []) + + let _ = + ___bisect_post_visit___ 14 (List.length []) + / ___bisect_post_visit___ 15 (List.length []) + + let _ = + ___bisect_post_visit___ 16 (List.length []) + mod ___bisect_post_visit___ 17 (List.length []) + + let _ = + ___bisect_post_visit___ 18 (List.length []) + mod ___bisect_post_visit___ 19 (List.length []) + + let _ = + ___bisect_post_visit___ 20 (float_of_int 0) + +. ___bisect_post_visit___ 21 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 22 (float_of_int 0) + +. ___bisect_post_visit___ 23 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 24 (float_of_int 0) + +. ___bisect_post_visit___ 25 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 26 (float_of_int 0) + -. ___bisect_post_visit___ 27 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 28 (float_of_int 0) + *. ___bisect_post_visit___ 29 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 30 (float_of_int 0) + *. ___bisect_post_visit___ 31 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 32 (float_of_int 0) + /. ___bisect_post_visit___ 33 (float_of_int 0) + + let _ = + ___bisect_post_visit___ 34 (float_of_int 0) + /. ___bisect_post_visit___ 35 (float_of_int 0) + + + $ bash ../test.sh <<'EOF' + > let _ = (List.length []) land (List.length []) + > let _ = (land) (List.length []) (List.length []) + > let _ = (List.length []) lor (List.length []) + > let _ = (lor) (List.length []) (List.length []) + > let _ = (List.length []) lxor (List.length []) + > let _ = (lxor) (List.length []) (List.length []) + > let _ = (List.length []) lsl (List.length []) + > let _ = (lsl) (List.length []) (List.length []) + > let _ = (List.length []) lsr (List.length []) + > let _ = (lsr) (List.length []) (List.length []) + > let _ = (List.length []) asr (List.length []) + > let _ = (asr) (List.length []) (List.length []) + > EOF + let _ = + ___bisect_post_visit___ 0 (List.length []) + land ___bisect_post_visit___ 1 (List.length []) + + let _ = + ___bisect_post_visit___ 2 (List.length []) + land ___bisect_post_visit___ 3 (List.length []) + + let _ = + ___bisect_post_visit___ 4 (List.length []) + lor ___bisect_post_visit___ 5 (List.length []) + + let _ = + ___bisect_post_visit___ 6 (List.length []) + lor ___bisect_post_visit___ 7 (List.length []) + + let _ = + ___bisect_post_visit___ 8 (List.length []) + lxor ___bisect_post_visit___ 9 (List.length []) + + let _ = + ___bisect_post_visit___ 10 (List.length []) + lxor ___bisect_post_visit___ 11 (List.length []) + + let _ = + ___bisect_post_visit___ 12 (List.length []) + lsl ___bisect_post_visit___ 13 (List.length []) + + let _ = + ___bisect_post_visit___ 14 (List.length []) + lsl ___bisect_post_visit___ 15 (List.length []) + + let _ = + ___bisect_post_visit___ 16 (List.length []) + lsr ___bisect_post_visit___ 17 (List.length []) + + let _ = + ___bisect_post_visit___ 18 (List.length []) + lsr ___bisect_post_visit___ 19 (List.length []) + + let _ = + ___bisect_post_visit___ 20 (List.length []) + asr ___bisect_post_visit___ 21 (List.length []) + + let _ = + ___bisect_post_visit___ 22 (List.length []) + asr ___bisect_post_visit___ 23 (List.length []) + + + $ bash ../test.sh <<'EOF' + > let _ = raise (print_endline "foo"; Exit) + > let _ = raise_notrace (print_endline "foo"; Exit) + > let _ = failwith (print_endline "foo"; "bar") + > let _ = ignore (print_endline "foo") + > let _ = Obj.magic (print_endline "foo") + > EOF + let _ = + raise + (___bisect_post_visit___ 0 (print_endline "foo"); + Exit) + + let _ = + raise_notrace + (___bisect_post_visit___ 1 (print_endline "foo"); + Exit) + + let _ = + failwith + (___bisect_post_visit___ 2 (print_endline "foo"); + "bar") + + let _ = ignore (___bisect_post_visit___ 3 (print_endline "foo")) + + let _ = Obj.magic (___bisect_post_visit___ 4 (print_endline "foo")) diff --git a/test/instrument/attribute.t b/test/instrument/attribute.t new file mode 100644 index 00000000..2d542249 --- /dev/null +++ b/test/instrument/attribute.t @@ -0,0 +1,82 @@ +Attributes can suppress instrumentation in an expression subtree. + + $ bash test.sh <<'EOF' + > let _ = + > if true then + > ((fun () -> print_endline "foo") [@coverage off]) + > else + > ignore + > EOF + let _ = + if true then fun [@coverage off] () -> print_endline "foo" + else ( + ___bisect_visit___ 0; + ignore) + + +Suppression works even across a transition out of the expression language. + + $ bash test.sh <<'EOF' + > let _ = + > (let module Foo = struct let _bar = fun () -> () end in + > ()) [@coverage off] + > EOF + let _ = + (let module Foo = struct + let _bar () = () + end in + ()) + [@coverage off] + + +Attributes can suppress instrumentation of a structure item. + + $ bash test.sh <<'EOF' + > let f () = () + > [@@coverage off] + > EOF + let f () = () [@@coverage off] + + +Attributes can suppress instrumentation of a range of structure items. + + $ bash test.sh <<'EOF' + > [@@@coverage off] + > let f () = () + > [@@@coverage on] + > let g () = () + > EOF + [@@@coverage off] + + let f () = () + + [@@@coverage on] + + let g () = + ___bisect_visit___ 0; + () + + +Attributes can suppress coverage in a file. + + $ bash test.sh <<'EOF' + > [@@@coverage exclude_file] + > let f () = () + > EOF + + +Non-coverage attributes are preserved uninstrumented. + + $ bash test.sh <<'EOF' + > [@@@foo print_endline "bar"] + > + > let _ = () + > [@@foo print_endline "bar"] + > + > let _ = () [@foo print_endline "bar"] + > EOF + [@@@foo print_endline "bar"] + + let _ = () [@@foo print_endline "bar"] + + let _ = () [@foo print_endline "bar"] diff --git a/test/instrument/class/class.t b/test/instrument/class/class.t new file mode 100644 index 00000000..1d0a3bd7 --- /dev/null +++ b/test/instrument/class/class.t @@ -0,0 +1,64 @@ +Trivial. + + $ bash ../test.sh <<'EOF' + > class foo = + > object + > end + > EOF + class foo = object end + + +Parameters are preserved. + + $ bash ../test.sh <<'EOF' + > class foo_1 () = + > object + > end + > class foo_2 ~l:_ = + > object + > end + > class foo_3 ?l:_ () = + > object + > end + > EOF + class foo_1 () = object end + + class foo_2 ~l:_ = object end + + class foo_3 ?l:_ () = object end + + +Default values are instrumented, and instrumented recursively. + + $ bash ../test.sh <<'EOF' + > [@@@ocaml.warning "-27"] + > class foo ?(l = fun () -> ()) () = + > object + > end + > EOF + [@@@ocaml.warning "-27"] + + class foo + ?(l = + ___bisect_visit___ 1; + fun () -> + ___bisect_visit___ 0; + ()) () = object end + + +Nested expressions and initializers instrumented. + + $ bash ../test.sh <<'EOF' + > class foo = + > let () = print_endline "bar" in + > object + > initializer print_endline "baz" + > end + > EOF + class foo = + let () = ___bisect_post_visit___ 2 (print_endline "bar") in + object + initializer + ___bisect_visit___ 1; + ___bisect_post_visit___ 0 (print_endline "baz") + end diff --git a/test/instrument/class/dune b/test/instrument/class/dune new file mode 100644 index 00000000..3add053e --- /dev/null +++ b/test/instrument/class/dune @@ -0,0 +1,3 @@ +(cram + (deps ../test.sh) + (alias compatible)) diff --git a/test/instrument/class/instvar.t b/test/instrument/class/instvar.t new file mode 100644 index 00000000..cacc3d61 --- /dev/null +++ b/test/instrument/class/instvar.t @@ -0,0 +1,35 @@ +Pexp_setinstvar traversed. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > val mutable x = () + > method foo = x <- (print_endline "foo") + > end + > EOF + let _ = + object + val mutable x = () + + method foo = + ___bisect_visit___ 1; + x <- ___bisect_post_visit___ 0 (print_endline "foo") + end + + +Pexp_override traversed. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > val x = () + > method foo = {< x = print_endline "foo" >} + > end + let _ = + object + val x = () + + method foo = + ___bisect_visit___ 1; + {} + end diff --git a/test/instrument/class/method.t b/test/instrument/class/method.t new file mode 100644 index 00000000..d4daa388 --- /dev/null +++ b/test/instrument/class/method.t @@ -0,0 +1,92 @@ +Method "entry point" instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > method foo = () + > end + > EOF + let _ = + object + method foo = + ___bisect_visit___ 0; + () + end + + +Instrumentation is inserted into nested abstractions. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > method foo () () = () + > method bar = function () -> () + > end + > EOF + let _ = + object + method foo () () = + ___bisect_visit___ 0; + () + + method bar = + function + | () -> + ___bisect_visit___ 1; + () + end + + +Subexpressions instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > val foo = print_endline "foo" + > method bar = print_endline "bar" + > end + > EOF + let _ = + object + val foo = ___bisect_post_visit___ 0 (print_endline "foo") + + method bar = + ___bisect_visit___ 1; + print_endline "bar" + end + + +Virtual method preserved. + + $ bash ../test.sh <<'EOF' + > class virtual foo = + > object + > method virtual bar : unit + > end + > EOF + class virtual foo = + object + method virtual bar : unit + end + + +Polymorphic type annotations preserved. + + $ bash ../test.sh <<'EOF' + > let _ = + > object + > method foo : 'a. unit = () + > method bar : 'a. 'a -> unit = fun _ -> () + > end + > EOF + let _ = + object + method foo : 'a. unit = + ___bisect_visit___ 0; + () + + method bar : 'a. 'a -> unit = + fun _ -> + ___bisect_visit___ 1; + () + end diff --git a/test/instrument/class/new.t b/test/instrument/class/new.t new file mode 100644 index 00000000..8f307a2a --- /dev/null +++ b/test/instrument/class/new.t @@ -0,0 +1,34 @@ +New instrumented. + + $ bash ../test.sh << 'EOF' + > class foo = object end + > let _ = new foo + > EOF + class foo = object end + + let _ = ___bisect_post_visit___ 0 (new foo) + + +Not instrumented in tail position. + + $ bash ../test.sh << 'EOF' + > class foo = object end + > let _ = fun () -> new foo + > EOF + class foo = object end + + let _ = + fun () -> + ___bisect_visit___ 0; + new foo + + +Not instrumented inside a surrounding application expression. + + $ bash ../test.sh << 'EOF' + > class foo () = object end + > let _ = new foo () + > EOF + class foo () = object end + + let _ = ___bisect_post_visit___ 0 (new foo ()) diff --git a/test/instrument/class/send.t b/test/instrument/class/send.t new file mode 100644 index 00000000..82590681 --- /dev/null +++ b/test/instrument/class/send.t @@ -0,0 +1,45 @@ +Send instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = (object method foo = () end)#foo + > EOF + let _ = + ___bisect_post_visit___ 1 + (object + method foo = + ___bisect_visit___ 0; + () + end) + #foo + + +Not instrumented in tail position. + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> (object method foo = () end)#foo + > EOF + let _ = + fun () -> + ___bisect_visit___ 1; + (object + method foo = + ___bisect_visit___ 0; + () + end) + #foo + + +Not instrumented inside a surrounding application expression. + + $ bash ../test.sh << 'EOF' + > let _ = (object method foo () = () end)#foo () + > EOF + let _ = + ___bisect_post_visit___ 1 + ((object + method foo () = + ___bisect_visit___ 0; + () + end) + #foo + ()) diff --git a/test/instrument/control/dune b/test/instrument/control/dune new file mode 100644 index 00000000..3add053e --- /dev/null +++ b/test/instrument/control/dune @@ -0,0 +1,3 @@ +(cram + (deps ../test.sh) + (alias compatible)) diff --git a/test/instrument/control/for.t b/test/instrument/control/for.t new file mode 100644 index 00000000..08bbffcc --- /dev/null +++ b/test/instrument/control/for.t @@ -0,0 +1,60 @@ +Loop body is instrumented. Condition and bound are not instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = + > for _index = 0 to 1 do + > () + > done + > EOF + let _ = + for _index = 0 to 1 do + ___bisect_visit___ 0; + () + done + + +Direction is preserved. + + $ bash ../test.sh <<'EOF' + > let _ = + > for _index = 1 downto 0 do + > () + > done + > EOF + let _ = + for _index = 1 downto 0 do + ___bisect_visit___ 0; + () + done + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = + > for _index = (for _i = 0 to 1 do () done); 0 + > to (for _i = 0 to 1 do () done); 1 + > do + > for _i = 0 to 1 do () done + > done + > EOF + let _ = + for + _index = + for _i = 0 to 1 do + ___bisect_visit___ 3; + () + done; + 0 + to for _i = 0 to 1 do + ___bisect_visit___ 2; + () + done; + 1 + do + ___bisect_visit___ 1; + for _i = 0 to 1 do + ___bisect_visit___ 0; + () + done + done diff --git a/test/instrument/control/fun.t b/test/instrument/control/fun.t new file mode 100644 index 00000000..0f3c056c --- /dev/null +++ b/test/instrument/control/fun.t @@ -0,0 +1,90 @@ +Instrumentation of internal entry point. + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> () + > EOF + let _ = + fun () -> + ___bisect_visit___ 0; + () + + +Preservation of labeled arguments and their patterns. + + $ bash ../test.sh <<'EOF' + > let _ = fun ~l:_ -> () + > EOF + let _ = + fun ~l:_ -> + ___bisect_visit___ 0; + () + + +Preservation of optional labeled arguments. + + $ bash ../test.sh <<'EOF' + > let _ = (fun ?l:_ -> ()) [@ocaml.warning "-16"] + > EOF + let _ = + fun [@ocaml.warning "-16"] ?l:_ -> + ___bisect_visit___ 0; + () + + +Preservation of default values. Instrumentation of entry into default values. +Recursive instrumentation of default values. + + $ bash ../test.sh <<'EOF' + > let _ = fun ?(l = fun () -> ()) -> l + > EOF + let _ = + fun ?(l = + ___bisect_visit___ 1; + fun () -> + ___bisect_visit___ 0; + ()) -> + ___bisect_visit___ 2; + l + + +Recursive instrumentation of main subexpression. Instrumentation suppressed on +"between arguments." + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> fun () -> () + > EOF + let _ = + fun () () -> + ___bisect_visit___ 0; + () + + +Instrumentation placed correctly if immediate child is a "return type" +constraint. + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> (() : unit) + > EOF + let _ = + fun () : unit -> + ___bisect_visit___ 0; + () + + +Gentle handling of optional argument elimination. See +https://github.com/aantron/bisect_ppx/issues/319. + + $ bash ../test.sh <<'EOF' + > let f () ?x () = + > x + > + > let () = + > ignore (List.map (f ()) []) + > EOF + let f () ?x () = + ___bisect_visit___ 0; + x + + let () = + ignore + (___bisect_post_visit___ 2 (List.map (___bisect_post_visit___ 1 (f ())) [])) diff --git a/test/instrument/control/function.t b/test/instrument/control/function.t new file mode 100644 index 00000000..bccc0bd8 --- /dev/null +++ b/test/instrument/control/function.t @@ -0,0 +1,41 @@ +Instrumentation of cases. + + $ bash ../test.sh <<'EOF' + > let _ = + > function + > | 0 -> () + > | _ -> () + > EOF + let _ = function + | 0 -> + ___bisect_visit___ 0; + () + | _ -> + ___bisect_visit___ 1; + () + + +Recursive instrumentation of cases. + + $ bash ../test.sh <<'EOF' + > let _ = function () -> function () -> () + > EOF + let _ = function + | () -> ( + ___bisect_visit___ 1; + function + | () -> + ___bisect_visit___ 0; + ()) + + +Instrumentation suppressed "between arguments." + + $ bash ../test.sh <<'EOF' + > let _ = fun () -> function () -> () + > EOF + let _ = + fun () -> function + | () -> + ___bisect_visit___ 0; + () diff --git a/test/instrument/control/if.t b/test/instrument/control/if.t new file mode 100644 index 00000000..47edcd05 --- /dev/null +++ b/test/instrument/control/if.t @@ -0,0 +1,71 @@ +Instrumentation of branches. + + $ bash ../test.sh <<'EOF' + > let _ = if true then 1 else 2 + > EOF + let _ = + if true then ( + ___bisect_visit___ 1; + 1) + else ( + ___bisect_visit___ 0; + 2) + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = + > if if true then true else false then + > if true then true else false + > else + > if true then true else false + > EOF + let _ = + if + if true then ( + ___bisect_visit___ 7; + true) + else ( + ___bisect_visit___ 6; + false) + then ( + ___bisect_visit___ 5; + if true then ( + ___bisect_visit___ 4; + true) + else ( + ___bisect_visit___ 3; + false)) + else ( + ___bisect_visit___ 2; + if true then ( + ___bisect_visit___ 1; + true) + else ( + ___bisect_visit___ 0; + false)) + + +Supports if-then. + + $ bash ../test.sh <<'EOF' + > let _ = if true then () + > EOF + let _ = + if true then ( + ___bisect_visit___ 0; + ()) + + +The next expression after if-then is instrumented as if it were an else-case. + + $ bash ../test.sh <<'EOF' + > let _ = (if true then ()); () + > EOF + let _ = + if true then ( + ___bisect_visit___ 1; + ()); + ___bisect_visit___ 0; + () diff --git a/test/instrument/control/lazy.t b/test/instrument/control/lazy.t new file mode 100644 index 00000000..62f4acdf --- /dev/null +++ b/test/instrument/control/lazy.t @@ -0,0 +1,22 @@ +Thunk body is instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = lazy () + > EOF + let _ = + lazy + (___bisect_visit___ 0; + ()) + + +Recursive instrumentation of subexpression. + + $ bash ../test.sh <<'EOF' + > let _ = lazy (lazy ()) + > EOF + let _ = + lazy + (___bisect_visit___ 1; + lazy + (___bisect_visit___ 0; + ())) diff --git a/test/instrument/control/match.t b/test/instrument/control/match.t new file mode 100644 index 00000000..ca57aea8 --- /dev/null +++ b/test/instrument/control/match.t @@ -0,0 +1,43 @@ +Instrumentation of cases. + + $ bash ../test.sh <<'EOF' + > let _ = + > match true with + > | true -> () + > | false -> () + > EOF + let _ = + match true with + | true -> + ___bisect_visit___ 0; + () + | false -> + ___bisect_visit___ 1; + () + + +Recursive instrumentation of cases. + + $ bash ../test.sh <<'EOF' + > let _ = + > match + > match () with + > | () -> () + > with + > | () -> + > match () with + > | () -> () + > EOF + let _ = + match + match () with + | () -> + ___bisect_visit___ 2; + () + with + | () -> ( + ___bisect_visit___ 1; + match () with + | () -> + ___bisect_visit___ 0; + ()) diff --git a/test/instrument/control/newtype.t b/test/instrument/control/newtype.t new file mode 100644 index 00000000..e9e3697a --- /dev/null +++ b/test/instrument/control/newtype.t @@ -0,0 +1,17 @@ +Pseudo-entry point of newtype is not instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = fun (type _t) -> () + > EOF + let _ = fun (type _t) -> () + + +Recursive instrumentation of subexpression. + + $ bash ../test.sh <<'EOF' + > let _ = fun (type _t) -> fun x -> x + > EOF + let _ = + fun (type _t) x -> + ___bisect_visit___ 0; + x diff --git a/test/instrument/control/try.t b/test/instrument/control/try.t new file mode 100644 index 00000000..81633a8f --- /dev/null +++ b/test/instrument/control/try.t @@ -0,0 +1,40 @@ +Instrumentation of cases. No instrumentation of main subexpression. + + $ bash ../test.sh <<'EOF' + > let _ = + > try () + > with + > | Exit -> () + > | Failure _ -> () + > EOF + let _ = + try () with + | Exit -> + ___bisect_visit___ 0; + () + | Failure _ -> + ___bisect_visit___ 1; + () + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = + > try + > try () with _ -> () + > with _ -> + > try () with _ -> () + > EOF + let _ = + try + try () + with _ -> + ___bisect_visit___ 2; + () + with _ -> ( + ___bisect_visit___ 1; + try () + with _ -> + ___bisect_visit___ 0; + ()) diff --git a/test/instrument/control/while.t b/test/instrument/control/while.t new file mode 100644 index 00000000..58d66c62 --- /dev/null +++ b/test/instrument/control/while.t @@ -0,0 +1,36 @@ +Loop body is instrumented. Condition is not instrumented. + + $ bash ../test.sh <<'EOF' + > let _ = while true do () done + > EOF + let _ = + while true do + ___bisect_visit___ 0; + () + done + + +Recursive instrumentation of subexpressions. + + $ bash ../test.sh <<'EOF' + > let _ = + > while + > (while true do () done); true + > do + > while true do () done + > done + > EOF + let _ = + while + while true do + ___bisect_visit___ 2; + () + done; + true + do + ___bisect_visit___ 1; + while true do + ___bisect_visit___ 0; + () + done + done diff --git a/test/instrument/dune b/test/instrument/dune new file mode 100644 index 00000000..a29f94bf --- /dev/null +++ b/test/instrument/dune @@ -0,0 +1,3 @@ +(cram + (deps test.sh) + (alias compatible)) diff --git a/test/instrument/pattern/binding.t b/test/instrument/pattern/binding.t new file mode 100644 index 00000000..3c1ebd63 --- /dev/null +++ b/test/instrument/pattern/binding.t @@ -0,0 +1,43 @@ +Bindings made under or-patterns remain consistent after instrumentation. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A with + > | (`A as x) | (`B as x) -> print_endline "foo"; x + > EOF + let _ = + match `A with + | ((`A as x) | `B) as x as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A as x -> + ___bisect_visit___ 1; + () + | `B as x -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo"); + x + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A () with + > | `A x | `B x -> print_endline "foo"; x + > EOF + let _ = + match `A () with + | (`A x | `B x) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A x -> + ___bisect_visit___ 1; + () + | `B x -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo"); + x diff --git a/test/instrument/pattern/dune b/test/instrument/pattern/dune new file mode 100644 index 00000000..3add053e --- /dev/null +++ b/test/instrument/pattern/dune @@ -0,0 +1,3 @@ +(cram + (deps ../test.sh) + (alias compatible)) diff --git a/test/instrument/pattern/exception.t b/test/instrument/pattern/exception.t new file mode 100644 index 00000000..bfc9b956 --- /dev/null +++ b/test/instrument/pattern/exception.t @@ -0,0 +1,47 @@ +Exception or-patterns. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | () -> () + > | exception (Exit | Failure _) -> () + > EOF + let _ = + match () with + | () -> + ___bisect_visit___ 0; + () + | exception ((Exit | Failure _) as ___bisect_matched_value___) -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | Exit -> + ___bisect_visit___ 1; + () + | Failure _ -> + ___bisect_visit___ 2; + () + | _ -> ()); + () + + +Mixed value-exception cases trigger an alternative instrumentation strategy, +which is only correct because such cases do not use when-guards. + + $ bash ../test.sh <<'EOF' + > let _ = + > match Exit with + > | x | exception (Exit as x) -> ignore x; print_endline "foo" + > EOF + let _ = + let ___bisect_case_0___ x () = + ignore x; + ___bisect_post_visit___ 0 (print_endline "foo") + in + match Exit with + | x -> + ___bisect_visit___ 1; + ___bisect_case_0___ x () + | exception (Exit as x) -> + ___bisect_visit___ 2; + ___bisect_case_0___ x () diff --git a/test/instrument/pattern/nary.t b/test/instrument/pattern/nary.t new file mode 100644 index 00000000..4ee2bcb0 --- /dev/null +++ b/test/instrument/pattern/nary.t @@ -0,0 +1,104 @@ +Tuple. + + $ bash ../test.sh <<'EOF' + > let _ = + > match (`A, `C) with + > | ((`A | `B), (`C | `D)) -> print_endline "foo" + > EOF + let _ = + match (`A, `C) with + | ((`A | `B), (`C | `D)) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A, `C -> + ___bisect_visit___ 2; + ___bisect_visit___ 1; + () + | `A, `D -> + ___bisect_visit___ 3; + ___bisect_visit___ 1; + () + | `B, `C -> + ___bisect_visit___ 2; + ___bisect_visit___ 4; + () + | `B, `D -> + ___bisect_visit___ 3; + ___bisect_visit___ 4; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + + +Record. + + $ bash ../test.sh <<'EOF' + > type t = {a : bool; b : bool} + > let _ = + > match {a = true; b = false} with + > | {a = true | false; b = true | false} -> print_endline "foo" + > EOF + type t = { a : bool; b : bool } + + let _ = + match { a = true; b = false } with + | { a = true | false; b = true | false } as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | { a = true; b = true } -> + ___bisect_visit___ 2; + ___bisect_visit___ 1; + () + | { a = true; b = false } -> + ___bisect_visit___ 3; + ___bisect_visit___ 1; + () + | { a = false; b = true } -> + ___bisect_visit___ 2; + ___bisect_visit___ 4; + () + | { a = false; b = false } -> + ___bisect_visit___ 3; + ___bisect_visit___ 4; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + + +Array. + + $ bash ../test.sh <<'EOF' + > let _ = + > match [|`A; `C|] with + > | [|`A | `B; `C | `D|] -> print_endline "foo" + > | _ -> () + > EOF + let _ = + match [| `A; `C |] with + | [| `A | `B; `C | `D |] as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | [| `A; `C |] -> + ___bisect_visit___ 2; + ___bisect_visit___ 1; + () + | [| `A; `D |] -> + ___bisect_visit___ 3; + ___bisect_visit___ 1; + () + | [| `B; `C |] -> + ___bisect_visit___ 2; + ___bisect_visit___ 4; + () + | [| `B; `D |] -> + ___bisect_visit___ 3; + ___bisect_visit___ 4; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + | _ -> + ___bisect_visit___ 5; + () diff --git a/test/instrument/pattern/nullary.t b/test/instrument/pattern/nullary.t new file mode 100644 index 00000000..f6363663 --- /dev/null +++ b/test/instrument/pattern/nullary.t @@ -0,0 +1,124 @@ +Wildcard. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | _ -> () + > EOF + let _ = + match () with + | _ -> + ___bisect_visit___ 0; + () + + +Variable. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | x -> x + > EOF + let _ = + match () with + | x -> + ___bisect_visit___ 0; + x + + +Nullary constructor. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | () -> () + > EOF + let _ = + match () with + | () -> + ___bisect_visit___ 0; + () + + +Constant. + + $ bash ../test.sh <<'EOF' + > let _ = + > match 0 with + > | 0 -> () + > | _ -> () + > EOF + let _ = + match 0 with + | 0 -> + ___bisect_visit___ 0; + () + | _ -> + ___bisect_visit___ 1; + () + + +Interval. + + $ bash ../test.sh <<'EOF' + > let _ = + > match 'a' with + > | 'a'..'z' -> () + > | _ -> () + > EOF + let _ = + match 'a' with + | 'a' .. 'z' -> + ___bisect_visit___ 0; + () + | _ -> + ___bisect_visit___ 1; + () + + +Nullary polymorphic variand. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A with + > | `A -> () + > EOF + let _ = + match `A with + | `A -> + ___bisect_visit___ 0; + () + + +Polymorphic variant type name. + + $ bash ../test.sh <<'EOF' + > type t = [ `A ] + > let _ = + > match `A with + > | #t -> () + > EOF + type t = [ `A ] + + let _ = + match `A with + | #t -> + ___bisect_visit___ 0; + () + + +Module. + + $ bash ../test.sh <<'EOF' + > module type L = module type of List + > let _ = + > match (module List : L) with + > | (module L) -> () + > EOF + module type L = module type of List + + let _ = + match (module List : L) with + | (module L) -> + ___bisect_visit___ 0; + () diff --git a/test/instrument/pattern/unary.t b/test/instrument/pattern/unary.t new file mode 100644 index 00000000..6479e740 --- /dev/null +++ b/test/instrument/pattern/unary.t @@ -0,0 +1,121 @@ +Alias. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A with + > | `A | `B as _x -> print_endline "foo" + > EOF + let _ = + match `A with + | (`A | `B) as _x as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A as _x -> + ___bisect_visit___ 1; + () + | `B as _x -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + + +Constructor. + + $ bash ../test.sh <<'EOF' + > let _ = + > match Some `A with + > | Some (`A | `B) -> print_endline "foo" + > | None -> () + > EOF + let _ = + match Some `A with + | Some (`A | `B) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | Some `A -> + ___bisect_visit___ 1; + () + | Some `B -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + | None -> + ___bisect_visit___ 3; + () + + +Polymorphic variant constructor. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A `B with + > | `A (`B | `C) -> print_endline "foo" + > EOF + let _ = + match `A `B with + | `A (`B | `C) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A `B -> + ___bisect_visit___ 1; + () + | `A `C -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + + +Type constraint. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A with + > | (`A | `B : _) -> print_endline "foo" + > EOF + let _ = + match `A with + | (`A | `B : _) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | (`A : _) -> + ___bisect_visit___ 1; + () + | (`B : _) -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") + + +Lazy. + + $ bash ../test.sh <<'EOF' + > let _ = + > match lazy `A with + > | lazy (`A | `B) -> print_endline "foo" + > EOF + let _ = + match + lazy + (___bisect_visit___ 3; + `A) + with + | (lazy (`A | `B)) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | (lazy `A) -> + ___bisect_visit___ 1; + () + | (lazy `B) -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo") diff --git a/test/instrument/pattern/when.t b/test/instrument/pattern/when.t new file mode 100644 index 00000000..69ad07e6 --- /dev/null +++ b/test/instrument/pattern/when.t @@ -0,0 +1,57 @@ +If there is a pattern guard, pattern instrumentation is placed on it instead. +The nested expression gets a fresh instrumentation point, being the out-edge of +the guard, rather than the pattern. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A `B with + > | `A (`B | `C) when print_endline "foo"; true -> () + > | _ -> () + > EOF + let _ = + match `A `B with + | `A (`B | `C) as ___bisect_matched_value___ + when (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A `B -> + ___bisect_visit___ 1; + () + | `A `C -> + ___bisect_visit___ 2; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo"); + true -> + ___bisect_visit___ 3; + () + | _ -> + ___bisect_visit___ 4; + () + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | () -> () + > | exception (Exit | Failure _) when print_endline "foo"; true -> () + > EOF + let _ = + match () with + | () -> + ___bisect_visit___ 1; + () + | exception ((Exit | Failure _) as ___bisect_matched_value___) + when (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | Exit -> + ___bisect_visit___ 2; + () + | Failure _ -> + ___bisect_visit___ 3; + () + | _ -> ()); + ___bisect_post_visit___ 0 (print_endline "foo"); + true -> + ___bisect_visit___ 4; + () diff --git a/test/instrument/recent/dune b/test/instrument/recent/dune new file mode 100644 index 00000000..6327a6c3 --- /dev/null +++ b/test/instrument/recent/dune @@ -0,0 +1,2 @@ +(cram + (deps ../test.sh)) diff --git a/test/instrument/recent/error.t b/test/instrument/recent/error.t new file mode 100644 index 00000000..9f53f049 --- /dev/null +++ b/test/instrument/recent/error.t @@ -0,0 +1,9 @@ +Bad attributes generate an error message. + + $ bash ../test.sh <<'EOF' + > [@@@coverage invalid] + > EOF + File "test.ml", line 1, characters 0-21: + 1 | [@@@coverage invalid] + ^^^^^^^^^^^^^^^^^^^^^ + Error: Bad payload in coverage attribute. diff --git a/test/instrument/recent/exception-pattern.t b/test/instrument/recent/exception-pattern.t new file mode 100644 index 00000000..3f5190c4 --- /dev/null +++ b/test/instrument/recent/exception-pattern.t @@ -0,0 +1,53 @@ +Exception patterns under or-pattern. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | () -> () + > | exception Exit | exception Failure _ -> () + > EOF + let _ = + match () with + | () -> + ___bisect_visit___ 0; + () + | (exception (Exit as ___bisect_matched_value___)) + | (exception (Failure _ as ___bisect_matched_value___)) -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | Exit -> + ___bisect_visit___ 1; + () + | Failure _ -> + ___bisect_visit___ 2; + () + | _ -> ()); + () + + +Exception pattern under type constraint. + + $ bash ../test.sh <<'EOF' + > let _ = + > match () with + > | () -> () + > | (exception (Exit | Failure _) : unit) -> () + > EOF + let _ = + match () with + | () -> + ___bisect_visit___ 0; + () + | ((exception ((Exit | Failure _) as ___bisect_matched_value___)) : unit) -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | Exit -> + ___bisect_visit___ 1; + () + | Failure _ -> + ___bisect_visit___ 2; + () + | _ -> ()); + () diff --git a/test/instrument/recent/let-exception.t b/test/instrument/recent/let-exception.t new file mode 100644 index 00000000..a6654541 --- /dev/null +++ b/test/instrument/recent/let-exception.t @@ -0,0 +1,9 @@ + $ bash ../test.sh <<'EOF' + > [@@@ocaml.warning "-38"] + > let _ = let exception E in print_endline "foo" + > EOF + [@@@ocaml.warning "-38"] + + let _ = + let exception E in + ___bisect_post_visit___ 0 (print_endline "foo") diff --git a/test/instrument/recent/letop.t b/test/instrument/recent/letop.t new file mode 100644 index 00000000..bfe2f505 --- /dev/null +++ b/test/instrument/recent/letop.t @@ -0,0 +1,31 @@ +Subexpressions instrumented recursively. + + $ bash ../test.sh <<'EOF' + > let (let*) x f = f x + > let (and*) x y = (x, y) + > let return x = x + > let _ = + > let* () = print_endline "foo" + > and* () = print_endline "bar" in + > let* () = print_endline "baz" in + > return () + > EOF + let ( let* ) x f = + ___bisect_visit___ 0; + f x + + let ( and* ) x y = + ___bisect_visit___ 1; + (x, y) + + let return x = + ___bisect_visit___ 2; + x + + let _ = + let* () = ___bisect_post_visit___ 7 (print_endline "foo") + and* () = ___bisect_post_visit___ 6 (print_endline "bar") in + ___bisect_visit___ 5; + let* () = ___bisect_post_visit___ 4 (print_endline "baz") in + ___bisect_visit___ 3; + return () diff --git a/test/instrument/recent/opaque_identity.t b/test/instrument/recent/opaque_identity.t new file mode 100644 index 00000000..fd86cbd3 --- /dev/null +++ b/test/instrument/recent/opaque_identity.t @@ -0,0 +1,6 @@ +Sys.opaque_identity instrumentation is suppressed. + + $ bash ../test.sh <<'EOF' + > let _ = Sys.opaque_identity (print_endline "foo") + > EOF + let _ = Sys.opaque_identity (___bisect_post_visit___ 0 (print_endline "foo")) diff --git a/test/instrument/recent/pattern-open.t b/test/instrument/recent/pattern-open.t new file mode 100644 index 00000000..55b9a45d --- /dev/null +++ b/test/instrument/recent/pattern-open.t @@ -0,0 +1,34 @@ +Or-pattern under local open. + + $ bash ../test.sh <<'EOF' + > module M = struct exception E end + > let _ = + > match () with + > | () -> () + > | M.(exception (E | Exit)) -> () + > EOF + File "test.ml", line 5, characters 2-26: + 5 | | M.(exception (E | Exit)) -> () + ^^^^^^^^^^^^^^^^^^^^^^^^ + Error (warning 33): unused open M. + module M = struct + exception E + end + + let _ = + match () with + | () -> + ___bisect_visit___ 0; + () + | M.((exception ((E | Exit) as ___bisect_matched_value___))) -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | M.(E) -> + ___bisect_visit___ 1; + () + | M.(Exit) -> + ___bisect_visit___ 2; + () + | _ -> ()); + () diff --git a/test/instrument/recent/refutation.t b/test/instrument/recent/refutation.t new file mode 100644 index 00000000..0372870c --- /dev/null +++ b/test/instrument/recent/refutation.t @@ -0,0 +1,24 @@ +Refutation cases must not be instrumented in order to still be recognized by the +compiler. + + $ bash ../test.sh <<'EOF' + > let _ = + > match `A with + > | `A | `B -> () + > | `A | `B -> . + > EOF + let _ = + match `A with + | (`A | `B) as ___bisect_matched_value___ -> + (match[@ocaml.warning "-4-8-9-11-26-27-28"] + ___bisect_matched_value___ + with + | `A -> + ___bisect_visit___ 0; + () + | `B -> + ___bisect_visit___ 1; + () + | _ -> ()); + () + | `A | `B -> . diff --git a/test/instrument/structure.t b/test/instrument/structure.t new file mode 100644 index 00000000..87863281 --- /dev/null +++ b/test/instrument/structure.t @@ -0,0 +1,24 @@ +An empty file. Show the bare registration code. + + $ bash test.sh --include-registration <<'EOF' + > + > EOF + module Bisect_visit___test___ml = struct + let ___bisect_visit___ = + let point_definitions = + "132149166190000000000001000000000000000000000000000000000000128" + in + let (`Staged cb) = + Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None + "test.ml" ~point_count:0 ~point_definitions + in + cb + + let ___bisect_post_visit___ point_index result = + ___bisect_visit___ point_index; + result + end + + open Bisect_visit___test___ml + + [@@@ocaml.text "/*"] diff --git a/test/instrument/test.sh b/test/instrument/test.sh new file mode 100644 index 00000000..ce6fc545 --- /dev/null +++ b/test/instrument/test.sh @@ -0,0 +1,48 @@ +#!/usr/bin/env bash + +echo "(lang dune 2.7)" > dune-project + +echo "(executable" > dune +echo " (name test)" >> dune +echo " (instrumentation (backend bisect_ppx)))" >> dune + +echo > .ocamlformat + +rm -f test.ml +while read line +do + echo "$line" >> test.ml +done < /dev/stdin + +sanitize() { + # [@@@ocaml.text "/*"] is the delimiter in the output. Bisect_ppx runtime + # registration code begins at the first line containing that text. The + # instrumented module proper begins after the second such line. + + THRESHOLD=${1:-2} + COUNT=0 + + while read line + do + if [ $COUNT -ge $THRESHOLD ] + then + echo "$line" + fi + + if [ "$line" == "[@@@ocaml.text \"/*\"]" ] + then + COUNT=$(($COUNT + 1)) + fi + done +} + +if [ "$1" == "--include-registration" ] +then + DELIMITERS=1 +fi + +dune build ./test.exe --instrument-with bisect_ppx +ocamlfind c \ + -package bisect_ppx.runtime -dsource -c _build/default/test.pp.ml 2>&1 \ +| sanitize $DELIMITERS \ +| ocamlformat --name test.ml - diff --git a/test/instrument/value.t b/test/instrument/value.t new file mode 100644 index 00000000..7ab8b1ae --- /dev/null +++ b/test/instrument/value.t @@ -0,0 +1,224 @@ +No instrumentation is inserted into expressions that are (syntactic) values. + + + $ bash test.sh <<'EOF' + > let _ = ignore + > EOF + let _ = ignore + + + $ bash test.sh <<'EOF' + > let _ = 0 + > EOF + let _ = 0 + + + $ bash test.sh <<'EOF' + > let _ = let x = 0 in x + > let _ = let _x = print_endline "foo" in print_endline "bar" + > EOF + let _ = + let x = 0 in + x + + let _ = + let _x = ___bisect_post_visit___ 1 (print_endline "foo") in + ___bisect_post_visit___ 0 (print_endline "bar") + + + $ bash test.sh <<'EOF' + > let _ = let x = 0 and _y = 1 in x + > EOF + let _ = + let x = 0 and _y = 1 in + x + + + $ bash test.sh <<'EOF' + > let _ = (let rec x = 0 and _y = 1 in x) [@ocaml.warning "-39"] + > EOF + let _ = + (let rec x = 0 and _y = 1 in + x) + [@ocaml.warning "-39"] + + + $ bash test.sh <<'EOF' + > let _ = (0, 1) + > let _ = (print_endline "foo", print_endline "bar") + > EOF + let _ = (0, 1) + + let _ = + ( ___bisect_post_visit___ 0 (print_endline "foo"), + ___bisect_post_visit___ 1 (print_endline "bar") ) + + + $ bash test.sh <<'EOF' + > let _ = Exit + > EOF + let _ = Exit + + + $ bash test.sh <<'EOF' + > let _ = Failure "foo" + > let _ = Failure (String.concat "" []) + > EOF + let _ = Failure "foo" + + let _ = Failure (___bisect_post_visit___ 0 (String.concat "" [])) + + + $ bash test.sh <<'EOF' + > let _ = `Foo + > EOF + let _ = `Foo + + + $ bash test.sh <<'EOF' + > let _ = `Foo "bar" + > let _ = `Foo (print_endline "foo") + > EOF + let _ = `Foo "bar" + + let _ = `Foo (___bisect_post_visit___ 0 (print_endline "foo")) + + + $ bash test.sh <<'EOF' + > let _ = {contents = 0} + > let _ = {contents = print_endline "foo"} + > EOF + let _ = { contents = 0 } + + let _ = { contents = ___bisect_post_visit___ 0 (print_endline "foo") } + + + $ bash test.sh <<'EOF' + > [@@@ocaml.warning "-23"] + > let _ = {{contents = 0} with contents = 1} + > let _ = {{contents = ()} with contents = print_endline "foo"} + > EOF + [@@@ocaml.warning "-23"] + + let _ = { { contents = 0 } with contents = 1 } + + let _ = + { + { contents = () } with + contents = ___bisect_post_visit___ 0 (print_endline "foo"); + } + + + $ bash test.sh <<'EOF' + > let _ = {contents = 0}.contents + > EOF + let _ = { contents = 0 }.contents + + + $ bash test.sh <<'EOF' + > let _ = {contents = 0}.contents <- 1 + > let _ = {contents = ()}.contents <- print_endline "foo" + > EOF + let _ = { contents = 0 }.contents <- 1 + + let _ = + { contents = () }.contents <- ___bisect_post_visit___ 0 (print_endline "foo") + + + $ bash test.sh <<'EOF' + > let _ = [|0; 1|] + > let _ = [|print_endline "foo"; print_endline "bar"|] + > EOF + let _ = [| 0; 1 |] + + let _ = + [| + ___bisect_post_visit___ 0 (print_endline "foo"); + ___bisect_post_visit___ 1 (print_endline "bar"); + |] + + + $ bash test.sh <<'EOF' + > let _ = (); 0 + > let _ = print_endline "foo"; print_endline "bar" + > EOF + let _ = + (); + 0 + + let _ = + ___bisect_post_visit___ 1 (print_endline "foo"); + ___bisect_post_visit___ 0 (print_endline "bar") + + + $ bash test.sh <<'EOF' + > let _ = (0 : int) + > let _ = (print_endline "foo" : unit) + > EOF + let _ = (0 : int) + + let _ = (___bisect_post_visit___ 0 (print_endline "foo") : unit) + + + $ bash test.sh <<'EOF' + > let _ = (`Foo :> [ `Foo | `Bar ]) + > let _ = (`Foo (print_endline "foo") :> [ `Foo of unit | `Bar ]) + > EOF + let _ = (`Foo :> [ `Foo | `Bar ]) + + let _ = + (`Foo (___bisect_post_visit___ 0 (print_endline "foo")) + :> [ `Foo of unit | `Bar ]) + + + $ bash test.sh <<'EOF' + > let _ = let module Foo = struct end in 0 + > let _ = + > let module Foo = struct let () = print_endline "foo" end in + > print_endline "bar" + > EOF + let _ = + let module Foo = struct end in + 0 + + let _ = + let module Foo = struct + let () = ___bisect_post_visit___ 1 (print_endline "foo") + end in + ___bisect_post_visit___ 0 (print_endline "bar") + + + $ bash test.sh <<'EOF' + > module type X = sig val x : unit end + > let _ = (module struct let x = () end : X) + > let _ = (module struct let x = print_endline "foo" end : X) + > EOF + module type X = sig + val x : unit + end + + let _ = + (module struct + let x = () + end : X) + + let _ = + (module struct + let x = ___bisect_post_visit___ 0 (print_endline "foo") + end : X) + + + $ bash test.sh <<'EOF' + > [@@@ocaml.warning "-33"] + > let _ = let open List in ignore + > let _ = let open List in print_endline "foo" + > EOF + [@@@ocaml.warning "-33"] + + let _ = + let open List in + ignore + + let _ = + let open List in + ___bisect_post_visit___ 0 (print_endline "foo") diff --git a/test/unit/fixtures/attributes/expression.ml b/test/unit/fixtures/attributes/expression.ml deleted file mode 100644 index 3df75eb0..00000000 --- a/test/unit/fixtures/attributes/expression.ml +++ /dev/null @@ -1,95 +0,0 @@ -let fn _ = - () - -let () = - if true then - fn 1 [@coverage off] - else - fn 2;; - -fn 3;; - -fn 4 [@coverage off];; - -(fn (if true then 5 else 6)) [@coverage off];; - -(* Application expressions that place their marks visually on another - expression. *) -let () = - fn () - -let () = - (fn [@coverage off]) () - -let () = - fn (); () - -let () = - fn (); (() [@coverage off]) - -let () = - fn @@ () - -let () = - (fn [@coverage off]) @@ () - -let () = - () |> fn - -let () = - () |> (fn [@coverage off]) - -let fn' _ _ = - () - -let () = - () |> fn' () - -let () = - () |> (fn' () [@coverage off]) - -let () = - () |> (fn' [@coverage off]) () - -let () = - () |> fn; () - -let () = - () |> fn; (() [@coverage off]) - -let _ = - true || false - -let _ = - true [@coverage off] || false - -let _ = - true || false [@coverage off] - -let _ = - true || true || true [@coverage off] - -let _ = - true || true [@coverage off] || true - -class foo = - object - method bar = - () - end - -let () = - let _ = new foo in - () - -let () = - let _ = new foo in - (() [@coverage off]) - -let () = - let o = new foo in - o#bar; () - -let () = - let o = new foo in - o#bar; (() [@coverage off]) diff --git a/test/unit/fixtures/attributes/expression.reference.ml b/test/unit/fixtures/attributes/expression.reference.ml deleted file mode 100644 index 89b07b74..00000000 --- a/test/unit/fixtures/attributes/expression.reference.ml +++ /dev/null @@ -1,78 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___expression___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000x\000\000\000\025\000\000\000a\000\000\000a\b\000\000`\000\160M@\160\000MB\160\000NA\160\000VC\160\001\001\tD\160\001\001EE\160\001\001}F\160\001\001\191G\160\001\001\249H\160\001\002\016I\160\001\002\129J\160\001\002\189K\160\001\002\198L\160\001\002\239M\160\001\002\255N\160\001\003(O\160\001\0030P\160\001\003XQ\160\001\003xR\160\001\003\167S\160\001\003\209T\160\001\004+V\160\001\0042U\160\001\004VW" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "expression.ml" ~point_count:24 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___expression___ml -[@@@ocaml.text "/*"] -let fn _ = ___bisect_visit___ 0; () -let () = - if true - then ((fn 1)[@coverage off]) - else (___bisect_visit___ 2; ___bisect_post_visit___ 1 (fn 2)) -;;___bisect_post_visit___ 3 (fn 3) -;;((fn 4)[@coverage off]) -;;((fn (if true then 5 else 6))[@coverage off]) -let () = ___bisect_post_visit___ 4 (fn ()) -let () = ((fn)[@coverage off]) () -let () = ___bisect_post_visit___ 5 (fn ()); () -let () = fn (); ((())[@coverage off]) -let () = ___bisect_post_visit___ 6 (fn @@ ()) -let () = ((fn)[@coverage off]) @@ () -let () = ___bisect_post_visit___ 7 (() |> fn) -let () = () |> ((fn)[@coverage off]) -let fn' _ _ = ___bisect_visit___ 8; () -let () = ___bisect_post_visit___ 9 (() |> (fn' ())) -let () = () |> ((fn' ())[@coverage off]) -let () = () |> (((fn')[@coverage off]) ()) -let () = ___bisect_post_visit___ 10 (() |> fn); () -let () = () |> fn; ((())[@coverage off]) -let _ = - if true - then (___bisect_visit___ 11; true) - else if false then (___bisect_visit___ 12; true) else false -let _ = - if ((true)[@coverage off]) - then true - else if false then (___bisect_visit___ 13; true) else false -let _ = - if true - then (___bisect_visit___ 14; true) - else if ((false)[@coverage off]) then true else false -let _ = - if true - then (___bisect_visit___ 15; true) - else - if - (if true - then (___bisect_visit___ 16; true) - else if ((true)[@coverage off]) then true else false) - then true - else false -let _ = - if true - then (___bisect_visit___ 17; true) - else - if - (if ((true)[@coverage off]) - then true - else if true then (___bisect_visit___ 18; true) else false) - then true - else false -class foo = object method bar = ___bisect_visit___ 19; () end -let () = let _ = ___bisect_post_visit___ 20 (new foo) in () -let () = let _ = new foo in ((())[@coverage off]) -let () = - let o = ___bisect_post_visit___ 22 (new foo) in - ___bisect_post_visit___ 21 o#bar; () -let () = - let o = ___bisect_post_visit___ 23 (new foo) in - o#bar; ((())[@coverage off]) diff --git a/test/unit/fixtures/attributes/file.ml b/test/unit/fixtures/attributes/file.ml deleted file mode 100644 index 50f38a60..00000000 --- a/test/unit/fixtures/attributes/file.ml +++ /dev/null @@ -1,3 +0,0 @@ -let not_instrumented = () - -[@@@coverage exclude_file] diff --git a/test/unit/fixtures/attributes/file.reference.ml b/test/unit/fixtures/attributes/file.reference.ml deleted file mode 100644 index 4ce219fd..00000000 --- a/test/unit/fixtures/attributes/file.reference.ml +++ /dev/null @@ -1,2 +0,0 @@ -let not_instrumented = () -[@@@coverage exclude_file] diff --git a/test/unit/fixtures/attributes/floating.ml b/test/unit/fixtures/attributes/floating.ml deleted file mode 100644 index 71b1d964..00000000 --- a/test/unit/fixtures/attributes/floating.ml +++ /dev/null @@ -1,25 +0,0 @@ -let instrumented = () - -[@@@coverage off] - -let not_instrumented = () - -module Nested_1 = -struct - let also_not_instrumented = () -end - -[@@@coverage on] - -let instrumented_again = () - -module Nested_2 = -struct - let instrumented_3 = () - - [@@@coverage off] - - let not_instrumented_3 = () -end - -let instrumented_4 = () diff --git a/test/unit/fixtures/attributes/floating.reference.ml b/test/unit/fixtures/attributes/floating.reference.ml deleted file mode 100644 index 55c81e60..00000000 --- a/test/unit/fixtures/attributes/floating.reference.ml +++ /dev/null @@ -1,28 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___floating___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "floating.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___floating___ml -[@@@ocaml.text "/*"] -let instrumented = () -[@@@coverage off] -let not_instrumented = () -module Nested_1 = struct let also_not_instrumented = () end -[@@@coverage on] -let instrumented_again = () -module Nested_2 = - struct - let instrumented_3 = () - [@@@coverage off] - let not_instrumented_3 = () - end -let instrumented_4 = () diff --git a/test/unit/fixtures/attributes/include.ml b/test/unit/fixtures/attributes/include.ml deleted file mode 100644 index 6def7ef4..00000000 --- a/test/unit/fixtures/attributes/include.ml +++ /dev/null @@ -1,10 +0,0 @@ -module Foo = -struct - let instrumented = () - - [@@@coverage off] - let not_instrumented = () -end - -[@@@coverage off] -include Foo diff --git a/test/unit/fixtures/attributes/include.reference.ml b/test/unit/fixtures/attributes/include.reference.ml deleted file mode 100644 index 596e5df4..00000000 --- a/test/unit/fixtures/attributes/include.reference.ml +++ /dev/null @@ -1,21 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___include___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "include.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___include___ml -[@@@ocaml.text "/*"] -module Foo = - struct let instrumented = () - [@@@coverage off] - let not_instrumented = () end -[@@@coverage off] -include Foo diff --git a/test/unit/fixtures/attributes/let.ml b/test/unit/fixtures/attributes/let.ml deleted file mode 100644 index 9ec3f541..00000000 --- a/test/unit/fixtures/attributes/let.ml +++ /dev/null @@ -1,14 +0,0 @@ -let instrumented = () - -let not_instrumented = () - [@@coverage off] - -let instrumented_again = () - -let instrumented_3 = () -and not_instrumented_2 = () - [@@coverage off] - -let not_instrumented_3 = () - [@@coverage off] -and instrumented_4 = () diff --git a/test/unit/fixtures/attributes/let.reference.ml b/test/unit/fixtures/attributes/let.reference.ml deleted file mode 100644 index 8b943e46..00000000 --- a/test/unit/fixtures/attributes/let.reference.ml +++ /dev/null @@ -1,22 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___let___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "let.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___let___ml -[@@@ocaml.text "/*"] -let instrumented = () -let not_instrumented = ()[@@coverage off] -let instrumented_again = () -let instrumented_3 = () -and not_instrumented_2 = ()[@@coverage off] -let not_instrumented_3 = ()[@@coverage off] -and instrumented_4 = () diff --git a/test/unit/fixtures/instrument/apply.ml b/test/unit/fixtures/instrument/apply.ml deleted file mode 100644 index ead9976f..00000000 --- a/test/unit/fixtures/instrument/apply.ml +++ /dev/null @@ -1,60 +0,0 @@ -(* Application in a non-tail position. *) -let () = - print_endline "foo" - -(* Application in a tail position. *) -let f () = - print_endline "foo" - -(* Function subexpression. *) -let helper () = - print_endline - -let () = - (helper ()) "foo" - -(* Multiple arguments. *) -let () = - helper () "foo" - -(* Argument subexpression. *) -let helper () = - "foo" - -let () = - print_endline (helper ()) - -(* Optional argument elimination with @@. *) -let helper ?foo ~bar () = - () - -let () = - helper ~bar:() @@ () - -(* Optional argument elimination with labeled argument. *) -let f : unit -> unit = - helper ~bar:() - -(* Short-circuiting operators. *) -let _ = - false || true - -let _ = - false or true - -let _ = - true && true - -let _ = - true & true - -(* Short-circuiting operators with subexpressions. *) -let _ = - (print_endline "foo"; false) || (print_endline "bar"; true) - -(* Short-circuiting operators applied partially. *) -let _ = - (&&) true - -let _ = - (&&) (print_endline "foo"; true) diff --git a/test/unit/fixtures/instrument/apply.reference.ml b/test/unit/fixtures/instrument/apply.reference.ml deleted file mode 100644 index 7c93611c..00000000 --- a/test/unit/fixtures/instrument/apply.reference.ml +++ /dev/null @@ -1,47 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___apply___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000l\000\000\000\022\000\000\000U\000\000\000U\b\000\000T\000\160\000A@\160\000}A\160\001\000\194B\160\001\000\226C\160\001\001\025D\160\001\001UE\160\001\001sG\160\001\001{F\160\001\001\203H\160\001\001\231I\160\001\002\132J\160\001\002\140K\160\001\002\157L\160\001\002\165M\160\001\002\186N\160\001\002\209O\160\001\003-S\160\001\0032P\160\001\003MR\160\001\003QQ\160\001\003\194T" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "apply.ml" ~point_count:21 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___apply___ml -[@@@ocaml.text "/*"] -let () = ___bisect_post_visit___ 0 (print_endline "foo") -let f () = ___bisect_visit___ 1; print_endline "foo" -let helper () = ___bisect_visit___ 2; print_endline -let () = - ___bisect_post_visit___ 3 ((___bisect_post_visit___ 3 (helper ())) "foo") -let () = ___bisect_post_visit___ 4 (helper () "foo") -let helper () = ___bisect_visit___ 5; "foo" -let () = - ___bisect_post_visit___ 7 - (print_endline (___bisect_post_visit___ 6 (helper ()))) -let helper ?foo ~bar () = ___bisect_visit___ 8; () -let () = ___bisect_post_visit___ 9 ((helper ~bar:()) @@ ()) -let f : unit -> unit = helper ~bar:() -let _ = - if false - then (___bisect_visit___ 10; true) - else if true then (___bisect_visit___ 11; true) else false -let _ = - if false - then (___bisect_visit___ 12; true) - else if true then (___bisect_visit___ 13; true) else false -let _ = true && (___bisect_visit___ 14; true) -let _ = true & (___bisect_visit___ 15; true) -let _ = - if (___bisect_post_visit___ 19 (print_endline "foo"); false) - then (___bisect_visit___ 16; true) - else - if (___bisect_post_visit___ 18 (print_endline "bar"); true) - then (___bisect_visit___ 17; true) - else false -let _ = (&&) true -let _ = (&&) (___bisect_post_visit___ 20 (print_endline "foo"); true) diff --git a/test/unit/fixtures/instrument/array.ml b/test/unit/fixtures/instrument/array.ml deleted file mode 100644 index cd8a9881..00000000 --- a/test/unit/fixtures/instrument/array.ml +++ /dev/null @@ -1,3 +0,0 @@ -(* Basic. *) -let _ = - [|print_endline "foo", print_endline "bar"|] diff --git a/test/unit/fixtures/instrument/array.reference.ml b/test/unit/fixtures/instrument/array.reference.ml deleted file mode 100644 index dc92d222..00000000 --- a/test/unit/fixtures/instrument/array.reference.ml +++ /dev/null @@ -1,18 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___array___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\007\000\000\000\003\000\000\000\t\000\000\000\t\160\160e@\160zA" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "array.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___array___ml -[@@@ocaml.text "/*"] -let _ = - [|((___bisect_post_visit___ 0 (print_endline "foo")), - (___bisect_post_visit___ 1 (print_endline "bar")))|] diff --git a/test/unit/fixtures/instrument/assert.ml b/test/unit/fixtures/instrument/assert.ml deleted file mode 100644 index 9a7b5a3a..00000000 --- a/test/unit/fixtures/instrument/assert.ml +++ /dev/null @@ -1,59 +0,0 @@ -(* In non-tail position. *) -let () = - assert true - -(* In tail position. *) -let f () = - assert true - -(* Subexpression. *) -let () = - assert (print_endline "foo"; true) - -(* assert false. *) -let () = - assert false - -(* assert false: function. *) -let f = function - | `A -> assert false - -(* assert false: match. *) -let () = - match `A with - | `A -> assert false - -(* assert false: try. *) -let () = - try () - with Exit -> assert false - -(* assert false: if. *) -let () = - if true then - assert false - else - assert false - -(* assert false: while. *) -let () = - while false do - assert false - done - -(* assert false: for. *) -let () = - for i = 1 to 0 do - assert false - done - -(* assert false: lazy. *) -let _ = - lazy (assert false) - -(* assert false: method. *) -let _ = - object - method foo = - assert false - end diff --git a/test/unit/fixtures/instrument/assert.reference.ml b/test/unit/fixtures/instrument/assert.reference.ml deleted file mode 100644 index 32f57ba1..00000000 --- a/test/unit/fixtures/instrument/assert.reference.ml +++ /dev/null @@ -1,27 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___assert___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\006\000\000\000\002\000\000\000\005\000\000\000\005\144\160\001\000\163@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "assert.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___assert___ml -[@@@ocaml.text "/*"] -let () = assert true -let f () = assert true -let () = assert (___bisect_post_visit___ 0 (print_endline "foo"); true) -let () = assert false -let f = function | `A -> assert false -let () = match `A with | `A -> assert false -let () = try () with | Exit -> assert false -let () = if true then assert false else assert false -let () = while false do assert false done -let () = for i = 1 to 0 do assert false done -let _ = lazy (assert false) -let _ = object method foo = assert false end diff --git a/test/unit/fixtures/instrument/attribute.ml b/test/unit/fixtures/instrument/attribute.ml deleted file mode 100644 index 468cabad..00000000 --- a/test/unit/fixtures/instrument/attribute.ml +++ /dev/null @@ -1,11 +0,0 @@ -(* Floating. *) -[@@@foo print_endline "bar"; ()] - -(* Structure item. *) -let () = - () - [@@foo print_endline "bar"; ()] - -(* On expression. *) -let () = - () [@foo print_endline "bar"; ()] diff --git a/test/unit/fixtures/instrument/attribute.reference.ml b/test/unit/fixtures/instrument/attribute.reference.ml deleted file mode 100644 index fca70e65..00000000 --- a/test/unit/fixtures/instrument/attribute.reference.ml +++ /dev/null @@ -1,18 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___attribute___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "attribute.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___attribute___ml -[@@@ocaml.text "/*"] -[@@@foo print_endline "bar"; ()] -let () = ()[@@foo print_endline "bar"; ()] -let () = ((())[@foo print_endline "bar"; ()]) diff --git a/test/unit/fixtures/instrument/cases.ml b/test/unit/fixtures/instrument/cases.ml deleted file mode 100644 index 5ffe27d9..00000000 --- a/test/unit/fixtures/instrument/cases.ml +++ /dev/null @@ -1,106 +0,0 @@ -type ('a, 'b) record = { - left : 'a; - right : 'b; -} - -(* Subexpression. *) -let () = - match `A with - | `A -> print_endline "foo" - -(* Guard. *) -let () = - match `A with - | `A when print_endline "foo"; true -> () - | _ -> () - - -(* assert false. *) -let () = - match `A with - | `A -> assert false - -(* Or-pattern. *) -let () = - match `A with - | `A | `B -> () - -(* Nested or-pattern: alias. *) -let () = - match `A with - | (`A | `B) as x -> () - -(* Nested or-pattern: constructor. *) -let () = - match None with - | Some (`A | `B) -> () - | _ -> () - -(* Nested or-pattern: polymorphic variant. *) -let () = - match `A `B with - | `A (`B | `C) -> () - -(* Nested or-pattern: constraint. *) -let () = - match `A with - | ((`A | `B) : _) -> () - -(* Nested or-pattern: lazy. *) -let () = - match lazy `A with - | lazy (`A | `B) -> () - -(* Nested or-pattern: tuple. *) -let () = - match (`A, `C) with - | ((`A | `B), (`C | `D)) -> () - -(* Nested or-pattern: record. *) -let () = - match {left = `A; right = `C} with - | {left = `A | `B; right = `C | `D} -> () - -(* Nested or-pattern: array. *) -let () = - match [|`A; `C|] with - | [|`A | `B; `C | `D|] -> () - -(* Nested or-pattern: or. *) -let () = - match `A with - | (`A | `B) | `C -> () - -(* Or-pattern: binding. *) -let () = - match `A () with - | `A x | `B x -> x - -(* Or-pattern: alias. *) -let () = - match `A with - | (`A as x) | (`B as x) -> () - -(* Or-pattern with guard. *) -let () = - match `A with - | `A | `B when print_endline "foo"; true -> () - | _ -> () - -(* Exception pattern. *) -let () = - match `A with - | `A -> () - | exception Exit -> print_endline "foo" - -(* Exception pattern with guard. *) -let () = - match `A with - | `A -> () - | exception Exit when print_endline "foo"; true -> () - -(* Exception or-pattern. *) -let () = - match `A with - | `A -> () - | exception (Exit | Not_found) -> () diff --git a/test/unit/fixtures/instrument/cases.reference.ml b/test/unit/fixtures/instrument/cases.reference.ml deleted file mode 100644 index 16b7ad7d..00000000 --- a/test/unit/fixtures/instrument/cases.reference.ml +++ /dev/null @@ -1,184 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___cases___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\001\017\000\000\0007\000\000\000\217\000\000\000\217\b\000\000\216\000\160\000iA\160\000{@\160\001\000\174D\160\001\000\203B\160\001\000\211C\160\001\000\218E\160\001\001XF\160\001\001]G\160\001\001\165H\160\001\001\170I\160\001\002\005J\160\001\002\nK\160\001\002\024L\160\001\002sM\160\001\002xN\160\001\002\199O\160\001\002\204P\160\001\003\017S\160\001\003#Q\160\001\003(R\160\001\003xT\160\001\003}W\160\001\003\131U\160\001\003\136V\160\001\003\239X\160\001\003\244[\160\001\004\000Y\160\001\004\005Z\160\001\004W\\\160\001\004\\_\160\001\004`]\160\001\004e^\160\001\004\172`\160\001\004\177a\160\001\004\183b\160\001\004\252c\160\001\005\003d\160\001\005De\160\001\005Pf\160\001\005\155h\160\001\005\160i\160\001\005\189g\160\001\005\197j\160\001\005\204k\160\001\006\011m\160\001\006\024n\160\001\0066l\160\001\006\128p\160\001\006\141r\160\001\006\182o\160\001\006\190q\160\001\006\251s\160\001\007\019t\160\001\007\026u" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "cases.ml" ~point_count:54 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___cases___ml -[@@@ocaml.text "/*"] -type ('a, 'b) record = { - left: 'a ; - right: 'b } -let () = - match `A with - | `A -> - (___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline "foo")) -let () = - match `A with - | `A when - ___bisect_visit___ 4; - ___bisect_post_visit___ 2 (print_endline "foo"); - true -> (___bisect_visit___ 3; ()) - | _ -> (___bisect_visit___ 5; ()) -let () = match `A with | `A -> assert false -let () = - match `A with - | `A|`B as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A -> (___bisect_visit___ 6; ()) - | `B -> (___bisect_visit___ 7; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A with - | `A|`B as x as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A as x -> (___bisect_visit___ 8; ()) - | `B as x -> (___bisect_visit___ 9; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match None with - | Some (`A|`B) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | Some `A -> (___bisect_visit___ 10; ()) - | Some `B -> (___bisect_visit___ 11; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) - | _ -> (___bisect_visit___ 12; ()) -let () = - match `A `B with - | `A (`B|`C) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A `B -> (___bisect_visit___ 13; ()) - | `A `C -> (___bisect_visit___ 14; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A with - | ((`A|`B) : _) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | (`A : _) -> (___bisect_visit___ 15; ()) - | (`B : _) -> (___bisect_visit___ 16; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match lazy (___bisect_visit___ 19; `A) with - | (lazy (`A|`B)) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | (lazy `A) -> (___bisect_visit___ 17; ()) - | (lazy `B) -> (___bisect_visit___ 18; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match (`A, `C) with - | ((`A|`B), (`C|`D)) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | (`A, `C) -> (___bisect_visit___ 21; ___bisect_visit___ 20; ()) - | (`A, `D) -> (___bisect_visit___ 22; ___bisect_visit___ 20; ()) - | (`B, `C) -> (___bisect_visit___ 21; ___bisect_visit___ 23; ()) - | (`B, `D) -> (___bisect_visit___ 22; ___bisect_visit___ 23; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match { left = `A; right = `C } with - | { left = (`A|`B); right = (`C|`D) } as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | { left = `A; right = `C } -> - (___bisect_visit___ 25; ___bisect_visit___ 24; ()) - | { left = `A; right = `D } -> - (___bisect_visit___ 26; ___bisect_visit___ 24; ()) - | { left = `B; right = `C } -> - (___bisect_visit___ 25; ___bisect_visit___ 27; ()) - | { left = `B; right = `D } -> - (___bisect_visit___ 26; ___bisect_visit___ 27; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match [|`A;`C|] with - | [|(`A|`B);(`C|`D)|] as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | [|`A;`C|] -> (___bisect_visit___ 29; ___bisect_visit___ 28; ()) - | [|`A;`D|] -> (___bisect_visit___ 30; ___bisect_visit___ 28; ()) - | [|`B;`C|] -> (___bisect_visit___ 29; ___bisect_visit___ 31; ()) - | [|`B;`D|] -> (___bisect_visit___ 30; ___bisect_visit___ 31; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A with - | `A|`B|`C as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A -> (___bisect_visit___ 32; ()) - | `B -> (___bisect_visit___ 33; ()) - | `C -> (___bisect_visit___ 34; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A () with - | `A x|`B x as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A x -> (___bisect_visit___ 35; ()) - | `B x -> (___bisect_visit___ 36; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - x) -let () = - match `A with - | `A as x|`B as x as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A as x -> (___bisect_visit___ 37; ()) - | `B as x -> (___bisect_visit___ 38; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A with - | `A|`B as ___bisect_matched_value___ when - (((match ___bisect_matched_value___ with - | `A -> (___bisect_visit___ 40; ()) - | `B -> (___bisect_visit___ 41; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ___bisect_post_visit___ 39 (print_endline "foo"); - true -> (___bisect_visit___ 42; ()) - | _ -> (___bisect_visit___ 43; ()) -let () = - match `A with - | `A -> (___bisect_visit___ 45; ()) - | exception Exit -> - (___bisect_visit___ 46; - ___bisect_post_visit___ 44 (print_endline "foo")) -let () = - match `A with - | `A -> (___bisect_visit___ 48; ()) - | exception Exit when - ___bisect_visit___ 50; - ___bisect_post_visit___ 47 (print_endline "foo"); - true -> (___bisect_visit___ 49; ()) -let () = - match `A with - | `A -> (___bisect_visit___ 51; ()) - | exception (Exit|Not_found as ___bisect_matched_value___) -> - ((((match ___bisect_matched_value___ with - | Exit -> (___bisect_visit___ 52; ()) - | Not_found -> (___bisect_visit___ 53; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) diff --git a/test/unit/fixtures/instrument/class.ml b/test/unit/fixtures/instrument/class.ml deleted file mode 100644 index aee92c45..00000000 --- a/test/unit/fixtures/instrument/class.ml +++ /dev/null @@ -1,55 +0,0 @@ -(* Default value. *) -class default = fun ?(foo = ()) () -> - object - end - -(* Application. *) -class applied = - default ~foo:(print_endline "foo") (print_endline "bar") - -(* Let. *) -class let_ = - let foo = print_endline "foo" in - default foo - -(* Expression in val is not in tail position. *) -class val_ = - object - val foo = - print_endline "foo" - end - -(* Method. *) -class method_1 = - object - method foo = - print_endline "foo" - end - -(* Method with additional arguments. *) -class method_2 = - object - method foo () = - print_endline "foo" - end - -(* Method with polymorphic type. *) -let helper = raise - -class method_3 = - object - method foo : 'a. 'a = - helper Exit - end - -(* Method with polymorphic type and additional arguments. *) -class method_4 = - object - method foo : 'a. 'a -> unit = fun _ -> - () - end - -class initializer_ = - object - initializer (print_endline "foo") - end diff --git a/test/unit/fixtures/instrument/class.reference.ml b/test/unit/fixtures/instrument/class.reference.ml deleted file mode 100644 index b67bb89d..00000000 --- a/test/unit/fixtures/instrument/class.reference.ml +++ /dev/null @@ -1,37 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___class___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000:\000\000\000\012\000\000\000-\000\000\000-\b\000\000,\000\160q@\160\001\000\138A\160\001\000\160B\160\001\000\218C\160\001\001[D\160\001\001\169E\160\001\002 F\160\001\002\173G\160\001\003HH\160\001\003\129J\160\001\003\141I" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "class.ml" ~point_count:11 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___class___ml -[@@@ocaml.text "/*"] -class default ?(foo= ___bisect_visit___ 0; ()) () = object end -class applied = ((default) - ~foo:(___bisect_post_visit___ 1 (print_endline "foo")) - (___bisect_post_visit___ 2 (print_endline "bar"))) -class let_ = let foo = ___bisect_post_visit___ 3 (print_endline "foo") in - ((default) foo) -class val_ = - object val foo = ___bisect_post_visit___ 4 (print_endline "foo") end -class method_1 = - object method foo = ___bisect_visit___ 5; print_endline "foo" end -class method_2 = - object method foo () = ___bisect_visit___ 6; print_endline "foo" end -let helper = raise -class method_3 = - object method foo : 'a . 'a= ___bisect_visit___ 7; helper Exit end -class method_4 = - object method foo : 'a . 'a -> unit= fun _ -> ___bisect_visit___ 8; () end -class initializer_ = - object - initializer - ___bisect_visit___ 10; ___bisect_post_visit___ 9 (print_endline "foo") - end diff --git a/test/unit/fixtures/instrument/coerce.ml b/test/unit/fixtures/instrument/coerce.ml deleted file mode 100644 index c49be586..00000000 --- a/test/unit/fixtures/instrument/coerce.ml +++ /dev/null @@ -1,7 +0,0 @@ -(* In non-tail position. *) -let () = - (print_endline "foo" : unit :> unit) - -(* In tail position. *) -let f () = - (print_endline "foo" : unit :> unit) diff --git a/test/unit/fixtures/instrument/coerce.reference.ml b/test/unit/fixtures/instrument/coerce.reference.ml deleted file mode 100644 index 4877545a..00000000 --- a/test/unit/fixtures/instrument/coerce.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___coerce___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160t@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "coerce.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___coerce___ml -[@@@ocaml.text "/*"] -let () = (___bisect_post_visit___ 0 (print_endline "foo") : unit :> unit) -let f () = (print_endline "foo" : unit :> unit) diff --git a/test/unit/fixtures/instrument/constant.ml b/test/unit/fixtures/instrument/constant.ml deleted file mode 100644 index f9c0f34b..00000000 --- a/test/unit/fixtures/instrument/constant.ml +++ /dev/null @@ -1,3 +0,0 @@ -(* Basic. *) -let _ = - 0 diff --git a/test/unit/fixtures/instrument/constant.reference.ml b/test/unit/fixtures/instrument/constant.reference.ml deleted file mode 100644 index 3a7e831e..00000000 --- a/test/unit/fixtures/instrument/constant.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___constant___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "constant.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___constant___ml -[@@@ocaml.text "/*"] -let _ = 0 diff --git a/test/unit/fixtures/instrument/constraint.ml b/test/unit/fixtures/instrument/constraint.ml deleted file mode 100644 index 7cf108ab..00000000 --- a/test/unit/fixtures/instrument/constraint.ml +++ /dev/null @@ -1,7 +0,0 @@ -(* In non-tail position. *) -let () = - (print_endline "foo" :> unit) - -(* In tail position. *) -let f () = - (print_endline "foo" :> unit) diff --git a/test/unit/fixtures/instrument/constraint.reference.ml b/test/unit/fixtures/instrument/constraint.reference.ml deleted file mode 100644 index be3d62ba..00000000 --- a/test/unit/fixtures/instrument/constraint.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___constraint___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160t@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "constraint.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___constraint___ml -[@@@ocaml.text "/*"] -let () = (___bisect_post_visit___ 0 (print_endline "foo") :> unit) -let f () = (print_endline "foo" :> unit) diff --git a/test/unit/fixtures/instrument/construct.ml b/test/unit/fixtures/instrument/construct.ml deleted file mode 100644 index 8770c3a6..00000000 --- a/test/unit/fixtures/instrument/construct.ml +++ /dev/null @@ -1,11 +0,0 @@ -type foo = - | A - | B of unit - -(* No argument. *) -let _ = - A - -(* With argument. *) -let _ = - B (print_endline "foo") diff --git a/test/unit/fixtures/instrument/construct.reference.ml b/test/unit/fixtures/instrument/construct.reference.ml deleted file mode 100644 index 245ab6f6..00000000 --- a/test/unit/fixtures/instrument/construct.reference.ml +++ /dev/null @@ -1,20 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___construct___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\005\000\000\000\002\000\000\000\005\000\000\000\005\144\160\000n@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "construct.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___construct___ml -[@@@ocaml.text "/*"] -type foo = - | A - | B of unit -let _ = A -let _ = B (___bisect_post_visit___ 0 (print_endline "foo")) diff --git a/test/unit/fixtures/instrument/field.ml b/test/unit/fixtures/instrument/field.ml deleted file mode 100644 index 72d95744..00000000 --- a/test/unit/fixtures/instrument/field.ml +++ /dev/null @@ -1,17 +0,0 @@ -type foo = { - bar : unit; -} - -let baz = - {bar = ()} - -(* Basic. *) -let () = - baz.bar - -(* Record subexpression. *) -let helper () = - baz - -let () = - (helper ()).bar diff --git a/test/unit/fixtures/instrument/field.reference.ml b/test/unit/fixtures/instrument/field.reference.ml deleted file mode 100644 index e0fea7b2..00000000 --- a/test/unit/fixtures/instrument/field.reference.ml +++ /dev/null @@ -1,21 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___field___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\011\000\000\000\003\000\000\000\t\000\000\000\t\160\160\001\000\133@\160\001\000\155A" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "field.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___field___ml -[@@@ocaml.text "/*"] -type foo = { - bar: unit } -let baz = { bar = () } -let () = baz.bar -let helper () = ___bisect_visit___ 0; baz -let () = (___bisect_post_visit___ 1 (helper ())).bar diff --git a/test/unit/fixtures/instrument/for.ml b/test/unit/fixtures/instrument/for.ml deleted file mode 100644 index 950e0db9..00000000 --- a/test/unit/fixtures/instrument/for.ml +++ /dev/null @@ -1,5 +0,0 @@ -(* Basic. *) -let () = - for i = (succ 0) to (succ 1) do - print_endline "foo" - done diff --git a/test/unit/fixtures/instrument/for.reference.ml b/test/unit/fixtures/instrument/for.reference.ml deleted file mode 100644 index 9d7ec485..00000000 --- a/test/unit/fixtures/instrument/for.reference.ml +++ /dev/null @@ -1,20 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___for___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\014\000\000\000\005\000\000\000\017\000\000\000\017\192\160dC\160pB\160|A\160\000H@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "for.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___for___ml -[@@@ocaml.text "/*"] -let () = - for i = ___bisect_post_visit___ 3 (succ 0) to - ___bisect_post_visit___ 2 (succ 1) do - ___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline "foo") - done diff --git a/test/unit/fixtures/instrument/fun.ml b/test/unit/fixtures/instrument/fun.ml deleted file mode 100644 index c2f2384d..00000000 --- a/test/unit/fixtures/instrument/fun.ml +++ /dev/null @@ -1,31 +0,0 @@ -(* Basic. *) -let f = fun () -> - print_endline "foo" - -(* Structure item. *) -let f () = - print_endline "foo" - -(* Let-expression. *) -let () = - let f () = print_endline "foo" in - () - -(* Labeled argument. *) -let f = fun ~foo -> - print_endline foo - -(* Optional argument. *) -let f = fun ?foo () -> - print_endline "foo" - -(* Optional argument with default value. *) -let f = fun ?(foo = "foo") () -> - print_endline foo - -(* Optional argument elimination. *) -let f () ?x () = - x - -let () = - ignore (List.map (f ()) []) diff --git a/test/unit/fixtures/instrument/fun.reference.ml b/test/unit/fixtures/instrument/fun.reference.ml deleted file mode 100644 index f58d9594..00000000 --- a/test/unit/fixtures/instrument/fun.reference.ml +++ /dev/null @@ -1,27 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___fun___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\0004\000\000\000\011\000\000\000)\000\000\000)\b\000\000(\000\160a@\160\000YA\160\001\000\154B\160\001\000\229C\160\001\001*D\160\001\001\127E\160\001\001\142F\160\001\001\217G\160\001\001\246I\160\001\001\249H" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "fun.ml" ~point_count:10 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___fun___ml -[@@@ocaml.text "/*"] -let f () = ___bisect_visit___ 0; print_endline "foo" -let f () = ___bisect_visit___ 1; print_endline "foo" -let () = let f () = ___bisect_visit___ 2; print_endline "foo" in () -let f ~foo = ___bisect_visit___ 3; print_endline foo -let f ?foo () = ___bisect_visit___ 4; print_endline "foo" -let f ?(foo= ___bisect_visit___ 5; "foo") () = - ___bisect_visit___ 6; print_endline foo -let f () ?x () = ___bisect_visit___ 7; x -let () = - ignore - (___bisect_post_visit___ 9 - (List.map (___bisect_post_visit___ 8 (f ())) [])) diff --git a/test/unit/fixtures/instrument/function.ml b/test/unit/fixtures/instrument/function.ml deleted file mode 100644 index 12c6055b..00000000 --- a/test/unit/fixtures/instrument/function.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* Basic. Most of the testing of cases is done in cases.ml. *) -let f = function - | `A -> () - | `B -> print_endline "foo" - -(* Abstracted. *) -let f () = function - | `A -> () - | `B -> () - -(* Or pattern. *) -let f = function - | `A | `B -> () - | `C -> () diff --git a/test/unit/fixtures/instrument/function.reference.ml b/test/unit/fixtures/instrument/function.reference.ml deleted file mode 100644 index bfd09906..00000000 --- a/test/unit/fixtures/instrument/function.reference.ml +++ /dev/null @@ -1,33 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___function___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\"\000\000\000\b\000\000\000\029\000\000\000\029\240\160\000T@\160\000aA\160\001\000\166B\160\001\000\179C\160\001\000\228D\160\001\000\233E\160\001\000\246F" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "function.ml" ~point_count:7 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___function___ml -[@@@ocaml.text "/*"] -let f = - function - | `A -> (___bisect_visit___ 0; ()) - | `B -> (___bisect_visit___ 1; print_endline "foo") -let f () = - function - | `A -> (___bisect_visit___ 2; ()) - | `B -> (___bisect_visit___ 3; ()) -let f = - function - | `A|`B as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A -> (___bisect_visit___ 4; ()) - | `B -> (___bisect_visit___ 5; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) - | `C -> (___bisect_visit___ 6; ()) diff --git a/test/unit/fixtures/instrument/ident.ml b/test/unit/fixtures/instrument/ident.ml deleted file mode 100644 index 47596804..00000000 --- a/test/unit/fixtures/instrument/ident.ml +++ /dev/null @@ -1,5 +0,0 @@ -let x = () - -(* Basic. *) -let () = - x diff --git a/test/unit/fixtures/instrument/ident.reference.ml b/test/unit/fixtures/instrument/ident.reference.ml deleted file mode 100644 index 80ac6923..00000000 --- a/test/unit/fixtures/instrument/ident.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___ident___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "ident.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___ident___ml -[@@@ocaml.text "/*"] -let x = () -let () = x diff --git a/test/unit/fixtures/instrument/ifthenelse.ml b/test/unit/fixtures/instrument/ifthenelse.ml deleted file mode 100644 index dde01ac0..00000000 --- a/test/unit/fixtures/instrument/ifthenelse.ml +++ /dev/null @@ -1,36 +0,0 @@ -(* If-then-else: non-tail position. *) -let () = - if true then - print_endline "foo" - else - print_endline "bar" - -(* If-then-else: tail position. *) -let f () = - if true then - print_endline "foo" - else - print_endline "bar" - -(* If-then-else: condition subexpression. *) -let () = - if not true then - () - else - () - -(* If-then: non-tail position. *) -let () = - if true then - print_endline "foo" - -(* If-then: tail position. *) -let f () = - if true then - print_endline "foo" - -(* If-then: condition subexpression. *) -let () = - if not true then - () - diff --git a/test/unit/fixtures/instrument/ifthenelse.reference.ml b/test/unit/fixtures/instrument/ifthenelse.reference.ml deleted file mode 100644 index e4b900a0..00000000 --- a/test/unit/fixtures/instrument/ifthenelse.reference.ml +++ /dev/null @@ -1,36 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___ifthenelse___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000G\000\000\000\015\000\000\0009\000\000\0009\b\000\0008\000\160\000CC\160\000OB\160\000bA\160\000n@\160\001\000\167F\160\001\000\184E\160\001\000\215D\160\001\0019H\160\001\001GG\160\001\001\137J\160\001\001\149I\160\001\001\201L\160\001\001\218K\160\001\0027M" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "ifthenelse.ml" ~point_count:14 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___ifthenelse___ml -[@@@ocaml.text "/*"] -let () = - if true - then - (___bisect_visit___ 3; ___bisect_post_visit___ 2 (print_endline "foo")) - else - (___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline "bar")) -let f () = - ___bisect_visit___ 6; - if true - then (___bisect_visit___ 5; print_endline "foo") - else (___bisect_visit___ 4; print_endline "bar") -let () = - if not true then (___bisect_visit___ 8; ()) else (___bisect_visit___ 7; ()) -let () = - if true - then - (___bisect_visit___ 10; ___bisect_post_visit___ 9 (print_endline "foo")) -let f () = - ___bisect_visit___ 12; - if true then (___bisect_visit___ 11; print_endline "foo") -let () = if not true then (___bisect_visit___ 13; ()) diff --git a/test/unit/fixtures/instrument/lazy.ml b/test/unit/fixtures/instrument/lazy.ml deleted file mode 100644 index 8588947a..00000000 --- a/test/unit/fixtures/instrument/lazy.ml +++ /dev/null @@ -1,3 +0,0 @@ -(* Basic. *) -let _ = - lazy (print_endline "foo") diff --git a/test/unit/fixtures/instrument/lazy.reference.ml b/test/unit/fixtures/instrument/lazy.reference.ml deleted file mode 100644 index a8c7a3d1..00000000 --- a/test/unit/fixtures/instrument/lazy.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___lazy___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160\\@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "lazy.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___lazy___ml -[@@@ocaml.text "/*"] -let _ = lazy (___bisect_visit___ 0; print_endline "foo") diff --git a/test/unit/fixtures/instrument/let.ml b/test/unit/fixtures/instrument/let.ml deleted file mode 100644 index a43fd79b..00000000 --- a/test/unit/fixtures/instrument/let.ml +++ /dev/null @@ -1,9 +0,0 @@ -(* Non-tail position. *) -let () = - let () = print_endline "foo" in - print_endline "bar" - -(* Tail position. *) -let f () = - let () = print_endline "foo" in - print_endline "bar" diff --git a/test/unit/fixtures/instrument/let.reference.ml b/test/unit/fixtures/instrument/let.reference.ml deleted file mode 100644 index e175b68d..00000000 --- a/test/unit/fixtures/instrument/let.reference.ml +++ /dev/null @@ -1,22 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___let___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\018\000\000\000\005\000\000\000\017\000\000\000\017\192\160\000FA\160\000R@\160\000}C\160\001\000\159B" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "let.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___let___ml -[@@@ocaml.text "/*"] -let () = - let () = ___bisect_post_visit___ 1 (print_endline "foo") in - ___bisect_post_visit___ 0 (print_endline "bar") -let f () = - ___bisect_visit___ 3; - (let () = ___bisect_post_visit___ 2 (print_endline "foo") in - print_endline "bar") diff --git a/test/unit/fixtures/instrument/letexception_404.ml b/test/unit/fixtures/instrument/letexception_404.ml deleted file mode 100644 index f3e0f347..00000000 --- a/test/unit/fixtures/instrument/letexception_404.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* Non-tail position. *) -let () = - let exception E in - print_endline "bar" - -(* Tail position. *) -let f () = - let exception E in - print_endline "bar" - diff --git a/test/unit/fixtures/instrument/letexception_404.reference.ml b/test/unit/fixtures/instrument/letexception_404.reference.ml deleted file mode 100644 index 64fd7c28..00000000 --- a/test/unit/fixtures/instrument/letexception_404.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___letexception_404___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\t\000\000\000\003\000\000\000\t\000\000\000\t\160\160\000E@\160\000pA" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "letexception_404.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___letexception_404___ml -[@@@ocaml.text "/*"] -let () = let exception E in ___bisect_post_visit___ 0 (print_endline "bar") -let f () = ___bisect_visit___ 1; (let exception E in print_endline "bar") diff --git a/test/unit/fixtures/instrument/letmodule.ml b/test/unit/fixtures/instrument/letmodule.ml deleted file mode 100644 index 4069b686..00000000 --- a/test/unit/fixtures/instrument/letmodule.ml +++ /dev/null @@ -1,19 +0,0 @@ -(* Non-tail position. *) -let () = - let module M = struct end in - print_endline "foo" - -(* Tail position. *) -let f () = - let module M = struct end in - print_endline "foo" - -(* Non-trivial nested module. *) -let () = - let module M = - struct - let () = - print_endline "foo" - end - in - () diff --git a/test/unit/fixtures/instrument/letmodule.reference.ml b/test/unit/fixtures/instrument/letmodule.reference.ml deleted file mode 100644 index 2f8a31c4..00000000 --- a/test/unit/fixtures/instrument/letmodule.reference.ml +++ /dev/null @@ -1,23 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___letmodule___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\014\000\000\000\004\000\000\000\r\000\000\000\r\176\160\000O@\160\000zA\160\001\001\023B" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "letmodule.ml" ~point_count:3 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___letmodule___ml -[@@@ocaml.text "/*"] -let () = - let module M = struct end in - ___bisect_post_visit___ 0 (print_endline "foo") -let f () = - ___bisect_visit___ 1; (let module M = struct end in print_endline "foo") -let () = - let module M = - struct let () = ___bisect_post_visit___ 2 (print_endline "foo") end in () diff --git a/test/unit/fixtures/instrument/letop_408.ml b/test/unit/fixtures/instrument/letop_408.ml deleted file mode 100644 index 4098f1e1..00000000 --- a/test/unit/fixtures/instrument/letop_408.ml +++ /dev/null @@ -1,20 +0,0 @@ -let (let*) x f = f x -let (and*) x y = (x, y) -let return x = x - -(* Basic. *) -let () = - let* () = print_endline "foo" in - return () - -(* ands. *) -let () = - let* () = print_endline "foo" - and* () = print_endline "bar" in - return () - -(* Sequence. *) -let () = - let* () = print_endline "foo" in - let* () = print_endline "bar" in - return () diff --git a/test/unit/fixtures/instrument/letop_408.reference.ml b/test/unit/fixtures/instrument/letop_408.reference.ml deleted file mode 100644 index 17394f00..00000000 --- a/test/unit/fixtures/instrument/letop_408.reference.ml +++ /dev/null @@ -1,31 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___letop_408___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\0009\000\000\000\r\000\000\0001\000\000\0001\b\000\0000\000\160Q@\160fA\160|B\160\000mD\160\000zC\160\001\000\178G\160\001\000\210F\160\001\000\223E\160\001\001\027K\160\001\001(J\160\001\001>I\160\001\001KH" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "letop_408.ml" ~point_count:12 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___letop_408___ml -[@@@ocaml.text "/*"] -let ( let* ) x f = ___bisect_visit___ 0; f x -let ( and* ) x y = ___bisect_visit___ 1; (x, y) -let return x = ___bisect_visit___ 2; x -let () = - let* () = ___bisect_post_visit___ 4 (print_endline "foo") - in ___bisect_visit___ 3; return () -let () = - let* () = ___bisect_post_visit___ 7 (print_endline "foo") - and* () = ___bisect_post_visit___ 6 (print_endline "bar") in - ___bisect_visit___ 5; return () -let () = - let* () = ___bisect_post_visit___ 11 (print_endline "foo") - in - ___bisect_visit___ 10; - (let* () = ___bisect_post_visit___ 9 (print_endline "bar") - in ___bisect_visit___ 8; return ()) diff --git a/test/unit/fixtures/instrument/match.ml b/test/unit/fixtures/instrument/match.ml deleted file mode 100644 index 7c9a7fbc..00000000 --- a/test/unit/fixtures/instrument/match.ml +++ /dev/null @@ -1,41 +0,0 @@ -(* Basic. *) -let () = - match `A with - | `A -> () - | `B -> print_endline "foo" - -(* In tail position. *) -let f () = - match `A with - | `A -> () - | `B -> print_endline "foo" - -(* Selector subexpression. *) -let () = - match not true with - | true -> () - | false -> () - -(* Or-pattern. *) -let () = - match `A with - | `A | `B -> () - | `C -> () - -(* Exception. *) -let () = - match `A with - | `A -> () - | exception Exit -> print_endline "foo" - -(* Exception or-pattern. *) -let () = - match `A with - | `A -> () - | exception (Exit | Not_found) -> () - -(* Exception in tail position. *) -let f () = - match `A with - | `A -> () - | exception Exit -> print_endline "foo" \ No newline at end of file diff --git a/test/unit/fixtures/instrument/match.reference.ml b/test/unit/fixtures/instrument/match.reference.ml deleted file mode 100644 index 8c08b5af..00000000 --- a/test/unit/fixtures/instrument/match.reference.ml +++ /dev/null @@ -1,60 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___match___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000c\000\000\000\021\000\000\000Q\000\000\000Q\b\000\000P\000\160jA\160wB\160\000I@\160\000wE\160\001\000\137C\160\001\000\150D\160\001\000\242F\160\001\001\001G\160\001\001=H\160\001\001BI\160\001\001OJ\160\001\001\135L\160\001\001\148M\160\001\001\178K\160\001\001\244N\160\001\002\012O\160\001\002\019P\160\001\002TS\160\001\002fQ\160\001\002sR" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "match.ml" ~point_count:20 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___match___ml -[@@@ocaml.text "/*"] -let () = - match `A with - | `A -> (___bisect_visit___ 1; ()) - | `B -> - (___bisect_visit___ 2; ___bisect_post_visit___ 0 (print_endline "foo")) -let f () = - ___bisect_visit___ 5; - (match `A with - | `A -> (___bisect_visit___ 3; ()) - | `B -> (___bisect_visit___ 4; print_endline "foo")) -let () = - match not true with - | true -> (___bisect_visit___ 6; ()) - | false -> (___bisect_visit___ 7; ()) -let () = - match `A with - | `A|`B as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | `A -> (___bisect_visit___ 8; ()) - | `B -> (___bisect_visit___ 9; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) - | `C -> (___bisect_visit___ 10; ()) -let () = - match `A with - | `A -> (___bisect_visit___ 12; ()) - | exception Exit -> - (___bisect_visit___ 13; - ___bisect_post_visit___ 11 (print_endline "foo")) -let () = - match `A with - | `A -> (___bisect_visit___ 14; ()) - | exception (Exit|Not_found as ___bisect_matched_value___) -> - ((((match ___bisect_matched_value___ with - | Exit -> (___bisect_visit___ 15; ()) - | Not_found -> (___bisect_visit___ 16; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let f () = - ___bisect_visit___ 19; - (match `A with - | `A -> (___bisect_visit___ 17; ()) - | exception Exit -> (___bisect_visit___ 18; print_endline "foo")) diff --git a/test/unit/fixtures/instrument/match_408.ml b/test/unit/fixtures/instrument/match_408.ml deleted file mode 100644 index 179f9890..00000000 --- a/test/unit/fixtures/instrument/match_408.ml +++ /dev/null @@ -1,57 +0,0 @@ -(* Exception patterns under an or-pattern. *) -let () = - match `A with - | `A -> () - | exception Exit | exception Not_found -> () - -(* Exception under a constraint. *) -let () = - match () with - | () -> () - | ((exception Exit) : unit) -> () - -(* Exception or-pattern under a constraint. *) -let () = - match () with - | () -> () - | ((exception Exit | exception Not_found) : unit) -> () - -(* Exception under open. *) -let () = - match `A with - | `A -> () - | List.(exception Exit) -> () - -(* Exception or-pattern under open. *) -let () = - match `A with - | `A -> () - | List.(exception Exit | exception Not_found) -> () - -(* Mixed value/exception case. *) -let () = - match `A with - | `A | exception Exit -> () - -(* Mixed case - non-trivial RHS. *) -let () = - match `A with - | `A | exception Exit -> if true then ignore `B else ignore `C - -(* Ordinary and mixed cases. *) -let () = - match `A with - | `A -> () - | `B | exception Exit -> () - | exception Not_found -> () - -(* Multiple mixed cases. *) -let () = - match `A with - | `A | exception Exit -> () - | `B | exception Not_found -> () - -(* Bound variables. *) -let () = - match "foo" with - | x as y | exception Invalid_argument (x as y) -> () diff --git a/test/unit/fixtures/instrument/match_408.reference.ml b/test/unit/fixtures/instrument/match_408.reference.ml deleted file mode 100644 index c7f992ae..00000000 --- a/test/unit/fixtures/instrument/match_408.reference.ml +++ /dev/null @@ -1,91 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___match_408___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\147\000\000\000\030\000\000\000u\000\000\000u\b\000\000t\000\160\000K@\160\000XA\160\000iB\160\001\000\197C\160\001\000\210D\160\001\001?E\160\001\001NF\160\001\001_G\160\001\001\188H\160\001\001\201I\160\001\002*J\160\001\002=K\160\001\002NL\160\001\002\169M\160\001\002\174N\160\001\003\005Q\160\001\003\nR\160\001\003)P\160\001\0038O\160\001\003\128S\160\001\003\141T\160\001\003\146U\160\001\003\171V\160\001\003\255W\160\001\004\004X\160\001\004\029Y\160\001\004\"Z\160\001\004t[\160\001\004}\\" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "match_408.ml" ~point_count:29 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___match_408___ml -[@@@ocaml.text "/*"] -let () = - match `A with - | `A -> (___bisect_visit___ 0; ()) - | exception (Exit as ___bisect_matched_value___) - |exception (Not_found as ___bisect_matched_value___) -> - ((((match ___bisect_matched_value___ with - | Exit -> (___bisect_visit___ 1; ()) - | Not_found -> (___bisect_visit___ 2; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match () with - | () -> (___bisect_visit___ 3; ()) - | (exception Exit : unit) -> (___bisect_visit___ 4; ()) -let () = - match () with - | () -> (___bisect_visit___ 5; ()) - | ((exception (Exit as ___bisect_matched_value___) - |exception (Not_found as ___bisect_matched_value___)) : unit) -> - ((((match ___bisect_matched_value___ with - | Exit -> (___bisect_visit___ 6; ()) - | Not_found -> (___bisect_visit___ 7; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match `A with - | `A -> (___bisect_visit___ 8; ()) - | List.(exception Exit) -> (___bisect_visit___ 9; ()) -let () = - match `A with - | `A -> (___bisect_visit___ 10; ()) - | List.((exception (Exit as ___bisect_matched_value___) - |exception (Not_found as ___bisect_matched_value___))) - -> - ((((match ___bisect_matched_value___ with - | List.(Exit) -> (___bisect_visit___ 11; ()) - | List.(Not_found) -> (___bisect_visit___ 12; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - let ___bisect_case_0___ () = () in - match `A with - | `A -> (___bisect_visit___ 13; ___bisect_case_0___ ()) - | exception Exit -> (___bisect_visit___ 14; ___bisect_case_0___ ()) -let () = - let ___bisect_case_0___ () = - if true - then (___bisect_visit___ 16; ignore `B) - else (___bisect_visit___ 15; ignore `C) in - match `A with - | `A -> (___bisect_visit___ 17; ___bisect_case_0___ ()) - | exception Exit -> (___bisect_visit___ 18; ___bisect_case_0___ ()) -let () = - let ___bisect_case_1___ () = () in - match `A with - | `A -> (___bisect_visit___ 19; ()) - | `B -> (___bisect_visit___ 20; ___bisect_case_1___ ()) - | exception Exit -> (___bisect_visit___ 21; ___bisect_case_1___ ()) - | exception Not_found -> (___bisect_visit___ 22; ()) -let () = - let ___bisect_case_1___ () = () in - let ___bisect_case_0___ () = () in - match `A with - | `A -> (___bisect_visit___ 23; ___bisect_case_0___ ()) - | exception Exit -> (___bisect_visit___ 24; ___bisect_case_0___ ()) - | `B -> (___bisect_visit___ 25; ___bisect_case_1___ ()) - | exception Not_found -> (___bisect_visit___ 26; ___bisect_case_1___ ()) -let () = - let ___bisect_case_0___ y x () = () in - match "foo" with - | x as y -> (___bisect_visit___ 27; ___bisect_case_0___ y x ()) - | exception Invalid_argument (x as y) -> - (___bisect_visit___ 28; ___bisect_case_0___ y x ()) diff --git a/test/unit/fixtures/instrument/new.ml b/test/unit/fixtures/instrument/new.ml deleted file mode 100644 index d06e2edd..00000000 --- a/test/unit/fixtures/instrument/new.ml +++ /dev/null @@ -1,23 +0,0 @@ -class foo = - object - end - -class bar = fun () () -> - object - end - -(* Basic. *) -let _ = - new foo - -(* With arguments. *) -let _ = - new bar () () - -(* In tail position. *) -let f () = - new foo - -(* In tail position with arguments. *) -let f () = - new bar () () diff --git a/test/unit/fixtures/instrument/new.reference.ml b/test/unit/fixtures/instrument/new.reference.ml deleted file mode 100644 index 19f63347..00000000 --- a/test/unit/fixtures/instrument/new.reference.ml +++ /dev/null @@ -1,21 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___new___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\020\000\000\000\005\000\000\000\017\000\000\000\017\192\160\000b@\160\001\000\139A\160\001\000\185B\160\001\000\246C" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "new.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___new___ml -[@@@ocaml.text "/*"] -class foo = object end -class bar () () = object end -let _ = ___bisect_post_visit___ 0 (new foo) -let _ = ___bisect_post_visit___ 1 ((new bar) () ()) -let f () = ___bisect_visit___ 2; new foo -let f () = ___bisect_visit___ 3; (new bar) () () diff --git a/test/unit/fixtures/instrument/newtype.ml b/test/unit/fixtures/instrument/newtype.ml deleted file mode 100644 index 10f3dd5b..00000000 --- a/test/unit/fixtures/instrument/newtype.ml +++ /dev/null @@ -1,3 +0,0 @@ -(* Basic. *) -let f = fun (type t) -> - print_endline "foo" diff --git a/test/unit/fixtures/instrument/newtype.reference.ml b/test/unit/fixtures/instrument/newtype.reference.ml deleted file mode 100644 index 7af7d84d..00000000 --- a/test/unit/fixtures/instrument/newtype.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___newtype___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "newtype.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___newtype___ml -[@@@ocaml.text "/*"] -let f (type t) = print_endline "foo" diff --git a/test/unit/fixtures/instrument/object.ml b/test/unit/fixtures/instrument/object.ml deleted file mode 100644 index 7d9023dc..00000000 --- a/test/unit/fixtures/instrument/object.ml +++ /dev/null @@ -1,6 +0,0 @@ -(* Basic. *) -let _ = - object - method foo = - () - end diff --git a/test/unit/fixtures/instrument/object.reference.ml b/test/unit/fixtures/instrument/object.reference.ml deleted file mode 100644 index 49c3f99f..00000000 --- a/test/unit/fixtures/instrument/object.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___object___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160u@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "object.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___object___ml -[@@@ocaml.text "/*"] -let _ = object method foo = ___bisect_visit___ 0; () end diff --git a/test/unit/fixtures/instrument/open.ml b/test/unit/fixtures/instrument/open.ml deleted file mode 100644 index 2fb8a18f..00000000 --- a/test/unit/fixtures/instrument/open.ml +++ /dev/null @@ -1,9 +0,0 @@ -(* Non-tail position. *) -let () = - let open List in - print_endline "bar" - -(* Tail position. *) -let f () = - let open List in - print_endline "bar" diff --git a/test/unit/fixtures/instrument/open.reference.ml b/test/unit/fixtures/instrument/open.reference.ml deleted file mode 100644 index da5ec81d..00000000 --- a/test/unit/fixtures/instrument/open.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___open___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\t\000\000\000\003\000\000\000\t\000\000\000\t\160\160\000C@\160\000nA" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "open.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___open___ml -[@@@ocaml.text "/*"] -let () = let open List in ___bisect_post_visit___ 0 (print_endline "bar") -let f () = ___bisect_visit___ 1; (let open List in print_endline "bar") diff --git a/test/unit/fixtures/instrument/override.ml b/test/unit/fixtures/instrument/override.ml deleted file mode 100644 index d873e850..00000000 --- a/test/unit/fixtures/instrument/override.ml +++ /dev/null @@ -1,8 +0,0 @@ -(* Basic. *) -let _ = - object - val mutable foo = () - - method bar = - {} - end diff --git a/test/unit/fixtures/instrument/override.reference.ml b/test/unit/fixtures/instrument/override.reference.ml deleted file mode 100644 index f99c0313..00000000 --- a/test/unit/fixtures/instrument/override.reference.ml +++ /dev/null @@ -1,22 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___override___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\t\000\000\000\003\000\000\000\t\000\000\000\t\160\160\000OA\160\000c@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "override.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___override___ml -[@@@ocaml.text "/*"] -let _ = - object - val mutable foo = () - method bar = - ___bisect_visit___ 1; - {} - end diff --git a/test/unit/fixtures/instrument/pack.ml b/test/unit/fixtures/instrument/pack.ml deleted file mode 100644 index e35f39ee..00000000 --- a/test/unit/fixtures/instrument/pack.ml +++ /dev/null @@ -1,7 +0,0 @@ -module type EMPTY = - sig - end - -(* Basic. *) -let _ = - (module struct end : EMPTY) diff --git a/test/unit/fixtures/instrument/pack.reference.ml b/test/unit/fixtures/instrument/pack.reference.ml deleted file mode 100644 index 2b3d214e..00000000 --- a/test/unit/fixtures/instrument/pack.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___pack___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\128" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "pack.ml" ~point_count:0 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___pack___ml -[@@@ocaml.text "/*"] -module type EMPTY = sig end -let _ = ((module struct end) : (module EMPTY)) diff --git a/test/unit/fixtures/instrument/ppat_open_404.ml b/test/unit/fixtures/instrument/ppat_open_404.ml deleted file mode 100644 index 7f32845b..00000000 --- a/test/unit/fixtures/instrument/ppat_open_404.ml +++ /dev/null @@ -1,21 +0,0 @@ -(* Basic. *) -let () = - match `A with - | List.(`A | `B) -> () - -(* List. *) -let () = - match [`A] with - | List.[`A | `B] -> () - | _ -> () - -(* Array. *) -let () = - match [|`A|] with - | List.[|`A | `B|] -> () - | _ -> () - -(* Record. *) -let () = - match {contents = `A} with - | List.{contents = `A | `B} -> () diff --git a/test/unit/fixtures/instrument/ppat_open_404.reference.ml b/test/unit/fixtures/instrument/ppat_open_404.reference.ml deleted file mode 100644 index 45508812..00000000 --- a/test/unit/fixtures/instrument/ppat_open_404.reference.ml +++ /dev/null @@ -1,55 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___ppat_open_404___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\0005\000\000\000\012\000\000\000-\000\000\000-\b\000\000,\000\160p@\160uA\160\000kB\160\000qC\160\000vD\160\001\000\132E\160\001\000\194F\160\001\000\199G\160\001\000\214H\160\001\001(I\160\001\001-J" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "ppat_open_404.ml" ~point_count:11 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___ppat_open_404___ml -[@@@ocaml.text "/*"] -let () = - match `A with - | List.((`A|`B)) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | List.(`A) -> (___bisect_visit___ 0; ()) - | List.(`B) -> (___bisect_visit___ 1; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) -let () = - match [`A] with - | List.((`A|`B)::[]) as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | List.(`A::[]) -> - (___bisect_visit___ 3; ___bisect_visit___ 2; ()) - | List.(`B::[]) -> - (___bisect_visit___ 4; ___bisect_visit___ 2; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) - | _ -> (___bisect_visit___ 5; ()) -let () = - match [|`A|] with - | List.[|(`A|`B)|] as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | List.[|`A|] -> (___bisect_visit___ 6; ()) - | List.[|`B|] -> (___bisect_visit___ 7; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) - | _ -> (___bisect_visit___ 8; ()) -let () = - match { contents = `A } with - | List.{ contents = (`A|`B) } as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | List.{ contents = `A } -> (___bisect_visit___ 9; ()) - | List.{ contents = `B } -> (___bisect_visit___ 10; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ()) diff --git a/test/unit/fixtures/instrument/record.ml b/test/unit/fixtures/instrument/record.ml deleted file mode 100644 index 971d2e10..00000000 --- a/test/unit/fixtures/instrument/record.ml +++ /dev/null @@ -1,18 +0,0 @@ -type foo = { - bar : unit; - baz : unit; -} - -(* Basic. *) -let initial = { - bar = print_endline "foo"; - baz = (); -} - -(* Record subexpression. *) -let helper () = - initial - -let final = {(helper ()) with - bar = print_endline "bar"; -} diff --git a/test/unit/fixtures/instrument/record.reference.ml b/test/unit/fixtures/instrument/record.reference.ml deleted file mode 100644 index 72017dae..00000000 --- a/test/unit/fixtures/instrument/record.reference.ml +++ /dev/null @@ -1,26 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___record___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\020\000\000\000\005\000\000\000\017\000\000\000\017\192\160\000]@\160\001\000\163A\160\001\000\191B\160\001\000\222C" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "record.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___record___ml -[@@@ocaml.text "/*"] -type foo = { - bar: unit ; - baz: unit } -let initial = - { bar = (___bisect_post_visit___ 0 (print_endline "foo")); baz = () } -let helper () = ___bisect_visit___ 1; initial -let final = - { - (___bisect_post_visit___ 2 (helper ())) with - bar = (___bisect_post_visit___ 3 (print_endline "bar")) - } diff --git a/test/unit/fixtures/instrument/send.ml b/test/unit/fixtures/instrument/send.ml deleted file mode 100644 index 57ae113b..00000000 --- a/test/unit/fixtures/instrument/send.ml +++ /dev/null @@ -1,31 +0,0 @@ -let foo = - object - method bar = - () - - method baz () () = - () - end - -(* Basic. *) -let () = - foo#bar - -(* With arguments. *) -let () = - foo#baz () () - -(* In tail position. *) -let f () = - foo#bar - -(* In tail position with arguments. *) -let f () = - foo#baz () () - -(* Object subexpression. *) -let helper () = - foo - -let () = - (helper ())#bar diff --git a/test/unit/fixtures/instrument/send.reference.ml b/test/unit/fixtures/instrument/send.reference.ml deleted file mode 100644 index fb9e16b4..00000000 --- a/test/unit/fixtures/instrument/send.reference.ml +++ /dev/null @@ -1,27 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___send___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000.\000\000\000\n\000\000\000%\000\000\000%\b\000\000$\000\160j@\160\000KA\160\000sB\160\001\000\157C\160\001\000\203D\160\001\001\bE\160\001\001EF\160\001\001[G\160\001\001cH" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "send.ml" ~point_count:9 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___send___ml -[@@@ocaml.text "/*"] -let foo = - object - method bar = ___bisect_visit___ 0; () - method baz () () = ___bisect_visit___ 1; () - end -let () = ___bisect_post_visit___ 2 foo#bar -let () = ___bisect_post_visit___ 3 (foo#baz () ()) -let f () = ___bisect_visit___ 4; foo#bar -let f () = ___bisect_visit___ 5; foo#baz () () -let helper () = ___bisect_visit___ 6; foo -let () = - ___bisect_post_visit___ 8 (___bisect_post_visit___ 7 (helper ()))#bar diff --git a/test/unit/fixtures/instrument/sequence.ml b/test/unit/fixtures/instrument/sequence.ml deleted file mode 100644 index e6c8867c..00000000 --- a/test/unit/fixtures/instrument/sequence.ml +++ /dev/null @@ -1,13 +0,0 @@ -(* Basic. *) -let () = - (); () - -(* Subexpressions. *) -let () = - print_endline "foo"; - print_endline "bar" - -(* In tail position. *) -let f () = - print_endline "foo"; - print_endline "bar" diff --git a/test/unit/fixtures/instrument/sequence.reference.ml b/test/unit/fixtures/instrument/sequence.reference.ml deleted file mode 100644 index d789cb00..00000000 --- a/test/unit/fixtures/instrument/sequence.reference.ml +++ /dev/null @@ -1,23 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___sequence___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\019\000\000\000\005\000\000\000\017\000\000\000\017\192\160\000XA\160\000d@\160\001\000\146C\160\001\000\169B" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "sequence.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___sequence___ml -[@@@ocaml.text "/*"] -let () = (); () -let () = - ___bisect_post_visit___ 1 (print_endline "foo"); - ___bisect_post_visit___ 0 (print_endline "bar") -let f () = - ___bisect_visit___ 3; - ___bisect_post_visit___ 2 (print_endline "foo"); - print_endline "bar" diff --git a/test/unit/fixtures/instrument/setfield.ml b/test/unit/fixtures/instrument/setfield.ml deleted file mode 100644 index 729072e7..00000000 --- a/test/unit/fixtures/instrument/setfield.ml +++ /dev/null @@ -1,17 +0,0 @@ -type foo = { - mutable bar : unit; -} - -let baz = - {bar = ()} - -(* Basic. *) -let () = - baz.bar <- print_endline "foo" - -(* Record subexpression. *) -let helper () = - baz - -let () = - (helper ()).bar <- print_endline "foo" diff --git a/test/unit/fixtures/instrument/setfield.reference.ml b/test/unit/fixtures/instrument/setfield.reference.ml deleted file mode 100644 index 836e199e..00000000 --- a/test/unit/fixtures/instrument/setfield.reference.ml +++ /dev/null @@ -1,23 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___setfield___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\020\000\000\000\005\000\000\000\017\000\000\000\017\192\160\000m@\160\001\000\164A\160\001\000\186C\160\001\000\211B" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "setfield.ml" ~point_count:4 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___setfield___ml -[@@@ocaml.text "/*"] -type foo = { - mutable bar: unit } -let baz = { bar = () } -let () = baz.bar <- (___bisect_post_visit___ 0 (print_endline "foo")) -let helper () = ___bisect_visit___ 1; baz -let () = - (___bisect_post_visit___ 3 (helper ())).bar <- - (___bisect_post_visit___ 2 (print_endline "foo")) diff --git a/test/unit/fixtures/instrument/setinstvar.ml b/test/unit/fixtures/instrument/setinstvar.ml deleted file mode 100644 index c0f932f0..00000000 --- a/test/unit/fixtures/instrument/setinstvar.ml +++ /dev/null @@ -1,8 +0,0 @@ -(* Basic. *) -let _ = - object - val mutable foo = () - - method bar = - foo <- print_endline "foo" - end diff --git a/test/unit/fixtures/instrument/setinstvar.reference.ml b/test/unit/fixtures/instrument/setinstvar.reference.ml deleted file mode 100644 index b85bbbe4..00000000 --- a/test/unit/fixtures/instrument/setinstvar.reference.ml +++ /dev/null @@ -1,22 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___setinstvar___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\t\000\000\000\003\000\000\000\t\000\000\000\t\160\160\000OA\160\000b@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "setinstvar.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___setinstvar___ml -[@@@ocaml.text "/*"] -let _ = - object - val mutable foo = () - method bar = - ___bisect_visit___ 1; - foo <- ___bisect_post_visit___ 0 (print_endline "foo") - end diff --git a/test/unit/fixtures/instrument/submodule.ml b/test/unit/fixtures/instrument/submodule.ml deleted file mode 100644 index 127e7a42..00000000 --- a/test/unit/fixtures/instrument/submodule.ml +++ /dev/null @@ -1,6 +0,0 @@ -(* Basic. *) -module Foo = -struct - let bar () = - () -end diff --git a/test/unit/fixtures/instrument/submodule.reference.ml b/test/unit/fixtures/instrument/submodule.reference.ml deleted file mode 100644 index 598ff988..00000000 --- a/test/unit/fixtures/instrument/submodule.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___submodule___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160t@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "submodule.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___submodule___ml -[@@@ocaml.text "/*"] -module Foo = struct let bar () = ___bisect_visit___ 0; () end diff --git a/test/unit/fixtures/instrument/try.ml b/test/unit/fixtures/instrument/try.ml deleted file mode 100644 index b8b0b9a2..00000000 --- a/test/unit/fixtures/instrument/try.ml +++ /dev/null @@ -1,22 +0,0 @@ -(* Basic. *) -let () = - try - print_endline "foo" - with - | Exit -> () - | Not_found -> print_endline "bar" - -(* In tail position. *) -let f () = - try - print_endline "foo" - with - | Exit -> () - | Not_found -> print_endline "bar" - -(* Or-pattern. *) -let () = - try - () - with - | Exit | Not_found -> print_endline "bar" diff --git a/test/unit/fixtures/instrument/try.reference.ml b/test/unit/fixtures/instrument/try.reference.ml deleted file mode 100644 index 82af339d..00000000 --- a/test/unit/fixtures/instrument/try.reference.ml +++ /dev/null @@ -1,35 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___try___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\0006\000\000\000\012\000\000\000-\000\000\000-\b\000\000,\000\160lC\160\127A\160\000NB\160\000g@\160\001\000\149G\160\001\000\169F\160\001\000\188D\160\001\000\203E\160\001\001 I\160\001\001'J\160\001\001@H" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "try.ml" ~point_count:11 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___try___ml -[@@@ocaml.text "/*"] -let () = - try ___bisect_post_visit___ 3 (print_endline "foo") - with | Exit -> (___bisect_visit___ 1; ()) - | Not_found -> - (___bisect_visit___ 2; ___bisect_post_visit___ 0 (print_endline "bar")) -let f () = - ___bisect_visit___ 7; - (try ___bisect_post_visit___ 6 (print_endline "foo") - with | Exit -> (___bisect_visit___ 4; ()) - | Not_found -> (___bisect_visit___ 5; print_endline "bar")) -let () = - try () - with - | Exit|Not_found as ___bisect_matched_value___ -> - ((((match ___bisect_matched_value___ with - | Exit -> (___bisect_visit___ 9; ()) - | Not_found -> (___bisect_visit___ 10; ()) - | _ -> ())) - [@ocaml.warning "-4-8-9-11-26-27-28"]); - ___bisect_post_visit___ 8 (print_endline "bar")) diff --git a/test/unit/fixtures/instrument/tuple.ml b/test/unit/fixtures/instrument/tuple.ml deleted file mode 100644 index 20c38be9..00000000 --- a/test/unit/fixtures/instrument/tuple.ml +++ /dev/null @@ -1,3 +0,0 @@ -(* Basic. *) -let _ = - (print_endline "foo", print_endline "bar") diff --git a/test/unit/fixtures/instrument/tuple.reference.ml b/test/unit/fixtures/instrument/tuple.reference.ml deleted file mode 100644 index f39c86ea..00000000 --- a/test/unit/fixtures/instrument/tuple.reference.ml +++ /dev/null @@ -1,18 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___tuple___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\007\000\000\000\003\000\000\000\t\000\000\000\t\160\160d@\160yA" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "tuple.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___tuple___ml -[@@@ocaml.text "/*"] -let _ = - ((___bisect_post_visit___ 0 (print_endline "foo")), - (___bisect_post_visit___ 1 (print_endline "bar"))) diff --git a/test/unit/fixtures/instrument/unreachable_403.ml b/test/unit/fixtures/instrument/unreachable_403.ml deleted file mode 100644 index ead15d12..00000000 --- a/test/unit/fixtures/instrument/unreachable_403.ml +++ /dev/null @@ -1,8 +0,0 @@ -(* Basic. *) -let test = function - | () -> () - | () -> . - (* This case should not be instrumented, as that would generate code that - fails type checking: the OCaml type-checker accepts unreachable clauses - whose expression is just ".", but warns then fails on clauses whose - expression are of the form "; .". *) diff --git a/test/unit/fixtures/instrument/unreachable_403.reference.ml b/test/unit/fixtures/instrument/unreachable_403.reference.ml deleted file mode 100644 index 56efd2e4..00000000 --- a/test/unit/fixtures/instrument/unreachable_403.reference.ml +++ /dev/null @@ -1,16 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___unreachable_403___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\004\000\000\000\002\000\000\000\005\000\000\000\005\144\160e@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "unreachable_403.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___unreachable_403___ml -[@@@ocaml.text "/*"] -let test = function | () -> (___bisect_visit___ 0; ()) | () -> . diff --git a/test/unit/fixtures/instrument/variant.ml b/test/unit/fixtures/instrument/variant.ml deleted file mode 100644 index ac48dcdc..00000000 --- a/test/unit/fixtures/instrument/variant.ml +++ /dev/null @@ -1,7 +0,0 @@ -(* No argument. *) -let _ = - `A - -(* With argument. *) -let _ = - `B (print_endline "foo") diff --git a/test/unit/fixtures/instrument/variant.reference.ml b/test/unit/fixtures/instrument/variant.reference.ml deleted file mode 100644 index 10b1d6ea..00000000 --- a/test/unit/fixtures/instrument/variant.reference.ml +++ /dev/null @@ -1,17 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___variant___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\005\000\000\000\002\000\000\000\005\000\000\000\005\144\160\000P@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "variant.ml" ~point_count:1 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___variant___ml -[@@@ocaml.text "/*"] -let _ = `A -let _ = `B (___bisect_post_visit___ 0 (print_endline "foo")) diff --git a/test/unit/fixtures/instrument/while.ml b/test/unit/fixtures/instrument/while.ml deleted file mode 100644 index 3a57ab75..00000000 --- a/test/unit/fixtures/instrument/while.ml +++ /dev/null @@ -1,5 +0,0 @@ -(* Basic. *) -let () = - while not true do - print_endline "foo" - done diff --git a/test/unit/fixtures/instrument/while.reference.ml b/test/unit/fixtures/instrument/while.reference.ml deleted file mode 100644 index a297f9de..00000000 --- a/test/unit/fixtures/instrument/while.reference.ml +++ /dev/null @@ -1,19 +0,0 @@ -[@@@ocaml.text "/*"] -module Bisect_visit___while___ml = - struct - let ___bisect_visit___ = - let point_definitions = - "\132\149\166\190\000\000\000\007\000\000\000\003\000\000\000\t\000\000\000\t\160\160nA\160z@" in - let `Staged cb = - Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None - "while.ml" ~point_count:2 ~point_definitions in - cb - let ___bisect_post_visit___ point_index result = - ___bisect_visit___ point_index; result - end -open Bisect_visit___while___ml -[@@@ocaml.text "/*"] -let () = - while not true do - ___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline "foo") - done diff --git a/test/unit/test_attributes.ml b/test/unit/test_attributes.ml deleted file mode 100644 index 337cf0f9..00000000 --- a/test/unit/test_attributes.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* This file is part of Bisect_ppx, released under the MIT license. See - LICENSE.md for details, or visit - https://github.com/aantron/bisect_ppx/blob/master/LICENSE.md. *) - - - -open Test_helpers - -let tests = - compile_compare (fun () -> with_bisect ()) "attributes" diff --git a/test/unit/test_instrument.ml b/test/unit/test_instrument.ml deleted file mode 100644 index 1750dd24..00000000 --- a/test/unit/test_instrument.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* This file is part of Bisect_ppx, released under the MIT license. See - LICENSE.md for details, or visit - https://github.com/aantron/bisect_ppx/blob/master/LICENSE.md. *) - - - -open Test_helpers - -let tests = - compile_compare (fun () -> with_bisect () ^ " -w +A-32-4") "instrument" diff --git a/test/unit/test_main.ml b/test/unit/test_main.ml index 82b58eb2..37f7789c 100644 --- a/test/unit/test_main.ml +++ b/test/unit/test_main.ml @@ -9,8 +9,6 @@ open OUnit2 let tests = "bisect_ppx" >::: [ Test_report.tests; Test_send_to.tests; - Test_instrument.tests; - Test_attributes.tests; Test_warnings.tests; Test_line_number_directive.tests; Test_exclude_file.tests;