diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 190eb0aa..87fe6e70 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -15,6 +15,14 @@ jobs: - ubuntu-latest - macos-latest - windows-latest + ocaml: + - "4.14" + - "5.0" + - "5.1" + - "5.2" + - "5.3" + - "5.4" + - "5.5" runs-on: ${{ matrix.os }} @@ -25,7 +33,7 @@ jobs: - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: - ocaml-compiler: "5.3" + ocaml-compiler: ${{ matrix.ocaml }} - run: opam install . --deps-only --with-test diff --git a/.gitignore b/.gitignore index 79fc7d32..27fbd80f 100644 --- a/.gitignore +++ b/.gitignore @@ -19,6 +19,7 @@ *.install _build _opam +check/src/io.ml # tests output *.out *.err diff --git a/README.md b/README.md index a91ee50a..caaf2187 100644 --- a/README.md +++ b/README.md @@ -48,8 +48,9 @@ For more information, see the [User documentation](docs/USER_DOC.md) ## Requirements -- Currently tested and working on **OCaml 5.3** +- Currently tested and working on **OCaml 4.14 - 5.5** - **dune >= 3.20** +- **cppo** ## Install diff --git a/check/classic/classic.exp b/check/classic/classic.exp index 395b0276..9326ee3c 100644 --- a/check/classic/classic.exp +++ b/check/classic/classic.exp @@ -580,6 +580,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -620,6 +623,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -706,6 +712,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -717,6 +736,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... diff --git a/check/classic/classic.ref b/check/classic/classic.ref index 7a356929..3b3d0c5b 100644 --- a/check/classic/classic.ref +++ b/check/classic/classic.ref @@ -423,6 +423,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/unwrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:15: ?always @@ -463,6 +466,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/wrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_make/baz.ml:1: ?d ./examples/using_make/baz.ml:5: ?d ./examples/using_make/cond_sel.ml:1: ?a @@ -580,6 +586,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -620,6 +629,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -706,6 +718,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -717,6 +742,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -732,7 +770,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 603 -Success: 603 -Failed: 0 -Ratio: 100.% +Total: 641 +Success: 635 +Failed: 6 +Ratio: 99.0639625585% diff --git a/check/internal/internal.exp b/check/internal/internal.exp index 9248e8c1..5435b5b1 100644 --- a/check/internal/internal.exp +++ b/check/internal/internal.exp @@ -532,6 +532,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -572,6 +575,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -658,6 +664,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -669,6 +688,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... diff --git a/check/internal/internal.ref b/check/internal/internal.ref index 4a7eedfb..6219ff7c 100644 --- a/check/internal/internal.ref +++ b/check/internal/internal.ref @@ -375,6 +375,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/unwrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:15: ?always @@ -415,6 +418,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/wrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_make/baz.ml:1: ?d ./examples/using_make/baz.ml:5: ?d ./examples/using_make/cond_sel.ml:1: ?a @@ -532,6 +538,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -572,6 +581,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -658,6 +670,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -669,6 +694,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -684,7 +722,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 559 -Success: 559 -Failed: 0 -Ratio: 100.% +Total: 597 +Success: 591 +Failed: 6 +Ratio: 98.9949748744% diff --git a/check/src/Makefile b/check/src/Makefile index dc9543de..f2f13cd3 100644 --- a/check/src/Makefile +++ b/check/src/Makefile @@ -1,8 +1,15 @@ COMPFLAGS=-g -w +A-4-9-40-42 -bin-annot -keep-locs OCAMLC=ocamlc $(COMPFLAGS) OCAMLOPT=ocamlopt $(COMPFLAGS) +OCAML_VERSION=$(shell ocamlc -version) -API_SRC=pretty_print.ml section.ml scores.ml path.ml reports.ml +ADD_UNIX=$(shell [ $(OCAML_VERSION) \< 5.1 ] && echo "YES") +ifeq ($(ADD_UNIX), YES) +OCAMLC:=$(OCAMLC) -I +unix unix.cma +OCAMLOPT:=$(OCAMLOPT) -I +unix unix.cmxa +endif + +API_SRC=io.ml pretty_print.ml section.ml scores.ml path.ml reports.ml CHECK_SRC=$(API_SRC:.ml=.mli) $(API_SRC) check.mli check.ml AGGR_SRC=$(API_SRC:.ml=.mli) $(API_SRC) aggregate.mli aggregate.ml @@ -18,5 +25,8 @@ aggregate.byt$(EXE): $(AGGR_SRC) aggregate.opt$(EXE): $(AGGR_SRC) $(OCAMLOPT) -o $@ $^ +io.ml: io.cppo.ml + cppo -V OCAML:$(OCAML_VERSION) -o $@ $^ + clean: - rm -f *~ *.cm* *.a *.lib *.o *.obj *.byt$(EXE) *.opt$(EXE) **.out + rm -f io.ml *~ *.cm* *.a *.lib *.o *.obj *.byt$(EXE) *.opt$(EXE) **.out diff --git a/check/src/aggregate.ml b/check/src/aggregate.ml index a5f704b2..c2e88f2c 100644 --- a/check/src/aggregate.ml +++ b/check/src/aggregate.ml @@ -92,7 +92,7 @@ let update state line = let process state filepath = let input_lines = - In_channel.with_open_text filepath In_channel.input_lines + In_channel.with_open_text filepath Io.input_lines in print_title (Filename.remove_extension filepath); let local_state = List.fold_left update State.init input_lines in diff --git a/check/src/check.ml b/check/src/check.ml index 8672faf6..18da9a5f 100644 --- a/check/src/check.ml +++ b/check/src/check.ml @@ -178,7 +178,7 @@ let normalized_lines_of ~is_res_file filename = else Path.normalize_to_unix line ) in - In_channel.with_open_text filename In_channel.input_lines + In_channel.with_open_text filename Io.input_lines |> List.map normalize let () = diff --git a/check/src/io.cppo.ml b/check/src/io.cppo.ml new file mode 100644 index 00000000..a78ee2c2 --- /dev/null +++ b/check/src/io.cppo.ml @@ -0,0 +1,20 @@ +let isatty fd = + #scope + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 1, 0) + #define Out_channel Unix + #endif + match fd with + | `Stdout -> Out_channel.isatty Out_channel.stdout + | `Stderr -> Out_channel.isatty Out_channel.stderr + #endscope + + +#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 1, 0) +let [@tail_mod_cons] rec input_lines ic = + (* reproduce https://github.com/ocaml/ocaml/blob/5.3.0/stdlib/in_channel.ml#L195 *) + match In_channel.input_line ic with + | Some line -> line :: input_lines ic + | None -> [] +#elif OCAML_VERSION >= (5, 1, 0) && OCAML_VERSION < (5, 6, 0) +let input_lines = In_channel.input_lines +#endif diff --git a/check/src/io.mli b/check/src/io.mli new file mode 100644 index 00000000..d490e3d7 --- /dev/null +++ b/check/src/io.mli @@ -0,0 +1,3 @@ +val isatty : [`Stdout | `Stderr] -> bool + +val input_lines : In_channel.t -> string list diff --git a/check/src/pretty_print.ml b/check/src/pretty_print.ml index 55b72b09..b1f66492 100644 --- a/check/src/pretty_print.ml +++ b/check/src/pretty_print.ml @@ -8,6 +8,6 @@ let style_reset = "\x1b[0m" let bold = "\x1b[01m" let error ~err ~ctx = - if Out_channel.isatty Out_channel.stderr then + if Io.isatty `Stderr then Printf.eprintf "%s%s: %s%s%s%s\n%!" red ctx white bg_red err style_reset else Printf.eprintf "%s: %s\n%!" ctx err diff --git a/check/src/scores.ml b/check/src/scores.ml index a7577217..84f363bb 100644 --- a/check/src/scores.ml +++ b/check/src/scores.ml @@ -41,7 +41,7 @@ let extract_failed = extract_from (failed_fmt ~isatty:false ()) let pp t = let total = total t in - let isatty = Out_channel.isatty Out_channel.stdout in + let isatty = Io.isatty `Stdout in let print_line fmt value = Printf.printf (fmt ~isatty ()) value; Printf.printf "\n" diff --git a/check/threshold-1/threshold-1.exp b/check/threshold-1/threshold-1.exp index c8277204..5fd52d3d 100644 --- a/check/threshold-1/threshold-1.exp +++ b/check/threshold-1/threshold-1.exp @@ -1057,6 +1057,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -1097,6 +1100,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -1183,6 +1189,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1194,6 +1213,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... diff --git a/check/threshold-1/threshold-1.ref b/check/threshold-1/threshold-1.ref index c82df69c..69746819 100644 --- a/check/threshold-1/threshold-1.ref +++ b/check/threshold-1/threshold-1.ref @@ -903,6 +903,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/unwrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:15: ?always @@ -943,6 +946,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/wrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_make/baz.ml:1: ?d ./examples/using_make/baz.ml:5: ?d ./examples/using_make/cond_sel.ml:1: ?a @@ -1060,6 +1066,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -1100,6 +1109,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -1186,6 +1198,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1197,6 +1222,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1212,7 +1250,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1001 -Success: 1001 -Failed: 0 -Ratio: 100.% +Total: 1039 +Success: 1033 +Failed: 6 +Ratio: 99.4225216554% diff --git a/check/threshold-3-0.5/threshold-3-0.5.exp b/check/threshold-3-0.5/threshold-3-0.5.exp index e04ce12a..7cd2c3d0 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.exp +++ b/check/threshold-3-0.5/threshold-3-0.5.exp @@ -1382,6 +1382,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -1422,6 +1425,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -1591,6 +1597,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1602,6 +1621,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... diff --git a/check/threshold-3-0.5/threshold-3-0.5.ref b/check/threshold-3-0.5/threshold-3-0.5.ref index 3919783a..b1bacdd1 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.ref +++ b/check/threshold-3-0.5/threshold-3-0.5.ref @@ -1125,6 +1125,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/unwrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/unwrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?always ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:15: ?always @@ -1165,6 +1168,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:8: ?duplicate ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:17: ?type_used +./examples/using_dune/wrapped_lib/style/style.ml:38: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:43: ?opt: Should not be detected +./examples/using_dune/wrapped_lib/style/style.ml:47: ?opt: Should not be detected ./examples/using_make/baz.ml:1: ?d ./examples/using_make/baz.ml:5: ?d ./examples/using_make/cond_sel.ml:1: ?a @@ -1379,6 +1385,9 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/unwrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/unwrapped_lib/style/style.ml:36: ?opt ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:1: ?never ./examples/using_dune/wrapped_lib/opt_args/mixed_args.ml:8: ?never @@ -1419,6 +1428,9 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.mli:7: ?duplicate ./examples/using_dune/wrapped_lib/style/style.ml:3: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:28: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:33: ?opt +./examples/using_dune/wrapped_lib/style/style.ml:36: ?opt ./examples/using_make/dir/alias_opt.ml:2: ?b ./examples/using_make/dir/alias_opt.ml:11: ?a @@ -1587,6 +1599,19 @@ Nothing else to report in this section ./examples/using_dune/unwrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/unwrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/unwrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/unwrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/unwrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/unwrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/unwrapped_lib/style/style.ml:63: unit pattern param ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:20: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/opt_args/opt_args_in_higher_order_fun.ml:22: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1598,6 +1623,19 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/style/style.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_dune/wrapped_lib/style/style.ml:4: let () = ... in ... (=> use sequence) ./examples/using_dune/wrapped_lib/style/style.ml:5: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:11: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:18: let x = ... in x (=> useless binding) +./examples/using_dune/wrapped_lib/style/style.ml:28: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:31: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:36: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:38: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:41: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:47: val f: ... -> (... -> ?_:_ -> ...) -> ... +./examples/using_dune/wrapped_lib/style/style.ml:55: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:55: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:59: let () = ... in ... (=> use sequence) +./examples/using_dune/wrapped_lib/style/style.ml:59: unit pattern constrained_unit_binding +./examples/using_dune/wrapped_lib/style/style.ml:63: unit pattern param ./examples/using_make/dir/fn_arg.ml:3: val f: ... -> (... -> ?_:_ -> ...) -> ... ./examples/using_make/dir/fn_arg.ml:9: val f: ... -> (... -> ?_:_ -> ...) -> ... @@ -1613,7 +1651,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1323 -Success: 1323 -Failed: 0 -Ratio: 100.% +Total: 1361 +Success: 1355 +Failed: 6 +Ratio: 99.5591476855% diff --git a/dead_code_analyzer.opam b/dead_code_analyzer.opam index 845ff95e..79ac2919 100644 --- a/dead_code_analyzer.opam +++ b/dead_code_analyzer.opam @@ -15,7 +15,8 @@ homepage: "https://github.com/LexiFi/dead_code_analyzer" bug-reports: "https://github.com/LexiFi/dead_code_analyzer/issues" depends: [ "dune" {>= "3.20"} - "ocaml" {>= "5.3" & < "5.4"} + "ocaml" {>= "4.14" & < "5.6"} + "cppo" "odoc" {with-doc} ] build: [ diff --git a/dune-project b/dune-project index 16e58f49..b0eab14a 100644 --- a/dune-project +++ b/dune-project @@ -22,6 +22,7 @@ (synopsis "Dead code analyzer for OCaml") (license MIT) (depends - (ocaml (and (>= 5.3) (< 5.4))) + (ocaml (and (>= 4.14) (< 5.6))) + cppo ) ) diff --git a/examples/using_dune/lib/style/style.ml b/examples/using_dune/lib/style/style.ml index 4a01b40f..e4338332 100644 --- a/examples/using_dune/lib/style/style.ml +++ b/examples/using_dune/lib/style/style.ml @@ -5,3 +5,63 @@ let all = let useless_binding = 42 in useless_binding +(* more useless bindings *) + +let _ = + let constrained_useless_binding : int = 42 in + (* This is translated as + let ((_ : int) as constrained_useless_binding) = ... + from OCaml 5.1 to 5.4 *) + constrained_useless_binding + +let _ = + let (constrained_useless_binding : int) = 42 in + (* This is translated as + let ((_ : int) as constrained_useless_binding) = ... + OCaml <= 5.4 *) + constrained_useless_binding + +(* more opt arg in arg *) + +let _ = + let multiline_opt_arg_in_arg a b (* unused params *) + (f : ?opt:'a -> unit -> unit) = + f () + in + let opt_arg_in_opt_arg_sig ?(f: (?opt:'a -> unit -> unit) option) () = + match f with + | Some f -> f () + | None -> () + in + let opt_arg_in_opt_arg_val ?(f=fun ?opt () -> ()) () = f () in + let multiline_implicit_opt_arg_in_arg a b + f = + multiline_opt_arg_in_arg a b f + in + let implicit_opt_arg_in_opt_arg ?f () = + match f with + | Some f -> multiline_opt_arg_in_arg () () f + | None -> () + in + let multiline_implicit_opt_arg_in_arg a b ?(opt = None) + f = + multiline_opt_arg_in_arg a b f + in + () + +(* more unit bindings *) + +let _ = + let constrained_unit_binding : unit = () in + (* This is translated as + let ((_ : int) as constrained_unit_binding) = ... + from OCaml 5.1 to 5.4 *) + let (constrained_unit_binding : unit) = () in + (* This is translated as + let ((_ : int) as constrained_unit_binding) = ... + OCaml <= 5.4 *) + let f (param : unit) = () in + let _underscore_unit_binding = () in + let (_underscore_constrained_unit_binding : unit) = () in + let f (_underscore_param : unit) = () in + () diff --git a/src/deadArg.ml b/src/deadArg.ml index 566dbaed..0219b2de 100644 --- a/src/deadArg.ml +++ b/src/deadArg.ml @@ -70,6 +70,22 @@ let deferrable_register_use label expr builddir loc last_loc count_tbl = else register_use () else register_use () +let options_of_args args = + #if OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + (* Texp_apply's args changed in OCaml 5.4, from expression option + to arg_or_omitted. This does the reverse conversion *) + let args = + List.map + (fun (lab, arg) -> + match arg with + | Arg expr -> lab, Some expr + | Omitted _ -> lab, None + ) + args + in + #endif + args + let rec register_uses builddir loc args = List.iter (fun (_, e) -> Option.iter (register_higher_order_uses builddir) e) @@ -132,7 +148,11 @@ and register_higher_order_uses builddir e = in let$ (c_lhs, c_rhs) = match expr.exp_desc with + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Texp_function {cases = [case]; _} -> + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) | Texp_function (_, Tfunction_cases {cases = [case]; _}) -> + #endif Some (case.c_lhs, case.c_rhs) | _ -> None in @@ -140,7 +160,9 @@ and register_higher_order_uses builddir e = | (Tpat_var _, Texp_apply (_, args)) -> if c_lhs.pat_loc.loc_ghost && c_rhs.exp_loc.loc_ghost && expr.exp_loc.loc_ghost - then register_uses builddir ident_loc args + then + let args = options_of_args args in + register_uses builddir ident_loc args | _ -> () ) | _ -> () @@ -156,32 +178,35 @@ let register_uses val_loc args = let rec bind loc expr = let state = State.get_current () in match expr.exp_desc with - | Texp_function (params, body) -> ( - let check_param_style = function - | Tparam_pat {pat_type; _} - | Tparam_optional_default ({pat_type; _}, _) -> - DeadType.check_style pat_type expr.exp_loc.Location.loc_start - in - let register_optional_param = function - | Asttypes.Optional s - when Config.must_report_opt_args state.config -> - let (opts, next) = VdNode.get loc in - VdNode.update loc (s :: opts, next) - | _ -> () + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Texp_function {arg_label; cases; _} -> + let expr_loc = expr.exp_loc.Location.loc_start in + bind_function loc expr_loc arg_label cases + | Texp_let (_, [_], in_expr) -> + (* optional arguments with default value + `fun ?(opt = default) x -> ...` + are translated into + ``` + fun ?opt -> + (let opt = match opt with + Some sth -> sth | None -> default + in + fun x -> ... + )[@@#default] + ``` + Checking if we have a `let ... in` with a "#default" attribute + is enough to identify those cases. + *) + let is_default expr = + List.exists + (fun Parsetree.{attr_name={txt; _}; _} -> String.equal txt "#default") + expr.exp_attributes in - List.iter - (fun {fp_kind; fp_arg_label; _} -> - check_param_style fp_kind; - register_optional_param fp_arg_label - ) - params; - match body with - | Tfunction_body exp -> bind loc exp - | Tfunction_cases {cases = [{c_lhs = {pat_type; _}; c_rhs = exp; _}]; _} -> - DeadType.check_style pat_type expr.exp_loc.Location.loc_start; - bind loc exp - | _ -> () - ) + if is_default expr then bind loc in_expr + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + | Texp_function (params, body) -> + bind_function loc params body + #endif | exp_desc when Config.must_report_opt_args state.config && DeadType.nb_args ~keep:`Opt expr.exp_type > 0 -> @@ -197,6 +222,59 @@ let rec bind loc expr = VdNode.merge_locs loc loc2 | _ -> () +and bind_function loc = + let state = State.get_current () in + let register_optional_param = function + | Asttypes.Optional s + when Config.must_report_opt_args state.config -> + let (opts, next) = VdNode.get loc in + VdNode.update loc (s :: opts, next) + | _ -> () + in + let arg_type arg_label pat_type = + match arg_label with + | Asttypes.Optional _ -> + (* The type of optional arguments is wrapped in option *) + begin match get_deep_desc pat_type with + | Tconstr (_, [typ], _) -> typ + | _ -> pat_type + end + | _ -> pat_type + in + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + fun expr_loc arg_label -> function + | {c_lhs = {pat_type; _}; c_rhs; _}::[] -> + let arg_type = arg_type arg_label pat_type in + DeadType.check_style arg_type expr_loc; + register_optional_param arg_label; + bind loc c_rhs + | _ -> () + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + let process_params params = + let check_param_style arg_loc arg_label = function + | Tparam_pat {pat_type; _} + | Tparam_optional_default ({pat_type; _}, _) -> + let arg_type = arg_type arg_label pat_type in + DeadType.check_style arg_type arg_loc.Location.loc_start + in + List.iter + (fun {fp_kind; fp_arg_label; fp_loc; _} -> + check_param_style fp_loc fp_arg_label fp_kind; + register_optional_param fp_arg_label + ) + params + in + let process_body = function + | Tfunction_body exp + | Tfunction_cases {cases = [{c_rhs = exp; _}]; _} -> + bind loc exp + | _ -> () + in + fun params body -> + process_params params; + process_body body + #endif + (******** WRAPPING ********) let wrap f x y = diff --git a/src/deadArg.mli b/src/deadArg.mli index c5b19aac..23e75431 100644 --- a/src/deadArg.mli +++ b/src/deadArg.mli @@ -27,6 +27,17 @@ val eocb : unit -> unit locations, their respective files. [eocb] = end of code base. *) +val options_of_args : + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 4, 0) + (Asttypes.arg_label * expression option) list + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + (Asttypes.arg_label * (expression, unit) arg_or_omitted) list + #endif + -> (Asttypes.arg_label * expression option) list +(** Convert Texp_apply's args representation to its OCaml 5.3 representation. + In particular, the type of a single arg changed in OCaml 5.4, from + expression option to arg_or_omitted. This does the reverse conversion. +*) val register_uses : Lexing.position -> (Asttypes.arg_label * expression option) list -> unit diff --git a/src/deadCode.ml b/src/deadCode.ml index 63893c0e..73095ba4 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -34,13 +34,20 @@ let main_files = Hashtbl.create 256 (* names -> paths *) let rec treat_exp exp args = match exp.exp_desc with - | Texp_apply (exp, in_args) -> treat_exp exp (in_args @ args) + | Texp_apply (exp, in_args) -> + let in_args = DeadArg.options_of_args in_args in + treat_exp exp (in_args @ args) | Texp_ident (_, _, {Types.val_loc = {Location.loc_start = loc; _}; _}) | Texp_field (_, _, {lbl_loc = {Location.loc_start = loc; _}; _}) -> DeadArg.register_uses loc args + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + | Texp_match (_, comp_l, _) -> + let val_l = [] in (* effect cases appear in OCaml 5.3 *) + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) | Texp_match (_, comp_l, val_l, _) -> + #endif let process_cases l = List.iter (fun {c_rhs = exp; _} -> treat_exp exp args) l in @@ -62,32 +69,24 @@ let value_binding super self x = DeadArg.at_eof := []; incr depth; let open Asttypes in - begin match x with - | { vb_pat = - { pat_desc = Tpat_var ( - _, - {loc = {Location.loc_start = loc1; loc_ghost = false; _}; _}, _); - _}; - vb_expr = - { exp_desc = Texp_ident ( - _, - _, - {val_loc = {Location.loc_start = loc2; loc_ghost = false; _}; _}); - _}; - _ - } -> - VdNode.merge_locs loc1 loc2; - DeadObj.add_equal loc1 loc2 - | { vb_pat = - { pat_desc = Tpat_var ( - _, - {loc = {Location.loc_start = loc; loc_ghost = false; _}; _}, _); - _}; - vb_expr = exp; - _ - } -> - DeadArg.bind loc exp; - DeadObj.add_var loc exp + begin match x.vb_pat.pat_desc with + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_var (_, {loc; _}) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_var (_, {loc; _}, _) + #endif + when not loc.Location.loc_ghost -> + let loc = loc.Location.loc_start in + begin match x.vb_expr.exp_desc with + | Texp_ident (_, _, {val_loc; _}) when not val_loc.Location.loc_ghost -> + let val_loc = val_loc.Location.loc_start in + VdNode.merge_locs loc val_loc; + DeadObj.add_equal loc val_loc + | _ -> + let exp = x.vb_expr in + DeadArg.bind loc exp; + DeadObj.add_var loc exp + end | _ -> () end; @@ -126,6 +125,27 @@ let structure_item super self i = r +let id_of_var : type k . k pattern_desc -> Ident.t option = function + (* helper function to extract the var's id in tpat_var and + tpat_alias(tpat_any) patterns for all OCaml versions *) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_var (id, _) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_var (id, _, _) + #endif + (* x *) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_alias ({pat_desc=Tpat_any; _}, id, _) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 4, 0) + | Tpat_alias ({pat_desc=Tpat_any; _}, id, _, _) + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_alias ({pat_desc=Tpat_any; _}, id, _, _, _) + #endif + (* (x: t) *) + -> Some id + | _ -> None + + let pat: type k. Tast_mapper.mapper -> Tast_mapper.mapper -> k general_pattern -> k general_pattern = fun super self p -> let state = State.get_current () in @@ -138,22 +158,37 @@ let pat: type k. Tast_mapper.mapper -> Tast_mapper.mapper -> k general_pattern - if DeadType.is_unit p.pat_type && sections.style.unit_pat then begin match p.pat_desc with | Tpat_construct _ -> () - | Tpat_var (_, {txt = "eta"; loc = _}, _) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_var (_, {txt = "eta"; _}) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_var (_, {txt = "eta"; _}, _) + #endif when p.pat_loc = Location.none -> () - | Tpat_var (_, {txt; _}, _) -> if check_underscore txt then u txt | Tpat_any -> if state.config.underscore then u "_" | Tpat_value tpat_arg -> begin match (tpat_arg :> value general_pattern) with | {pat_desc=(Tpat_construct _ | Tpat_var _ | Tpat_any); _} -> () | _ -> u "!!pattern!!" end - | _ -> u "!!pattern!!" + | var -> + match id_of_var var with + | Some id -> + let txt = Ident.name id in + if check_underscore txt then u txt + | None -> u "!!pattern!!" end; begin match p.pat_desc with | Tpat_record (l, _) -> List.iter - (fun (_, {Types.lbl_loc = {Location.loc_start = lab_loc; _}; _}, _) -> - if exported ~is_type:true sections.types lab_loc then + (fun (_, lab, _) -> + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 4, 0) + let lab : Types.label_description = lab in + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + (* The type of lab moved in OCaml 5.4 *) + let lab : Data_types.label_description = lab in + #endif + let lab_loc = lab.lbl_loc.Location.loc_start in + if exported ~is_type:true sections.types lab_loc then DeadType.collect_references lab_loc pat_loc ) l @@ -194,6 +229,7 @@ let expr super self e = | Texp_apply (exp, args) -> + let args = DeadArg.options_of_args args in if Config.must_report_opt_args state.config then treat_exp exp args; begin match exp.exp_desc with @@ -210,15 +246,19 @@ let expr super self e = | Texp_let (_, [{vb_pat; _}], _) when DeadType.is_unit vb_pat.pat_type && sections.style.seq -> - begin match vb_pat.pat_desc with - | Tpat_var (id, _, _) when not (check_underscore (Ident.name id)) -> () + begin match id_of_var vb_pat.pat_desc with + | Some id when not (check_underscore (Ident.name id)) -> () | _ -> register_style vb_pat.pat_loc.Location.loc_start "let () = ... in ... (=> use sequence)" end + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + | Texp_match (_, [{c_lhs; _}], _) + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) | Texp_match (_, [{c_lhs; _}], [], _) + #endif when DeadType.is_unit c_lhs.pat_type && sections.style.seq -> begin match c_lhs.pat_desc with | Tpat_value tpat_arg -> @@ -232,14 +272,22 @@ let expr super self e = | _ -> () end - | Texp_let ( - Asttypes.Nonrecursive, - [{vb_pat = {pat_desc = Tpat_var (id1, _, _); pat_loc = {loc_start = loc; _}; _}; _}], - {exp_desc = Texp_ident (Path.Pident id2, _, _); exp_extra = []; _}) - when id1 = id2 - && sections.style.binding - && check_underscore (Ident.name id1) -> - register_style loc "let x = ... in x (=> useless binding)" + | Texp_let (Asttypes.Nonrecursive, + [{vb_pat; _}], + {exp_desc; exp_extra = []; _}) + -> + let pat_id = id_of_var vb_pat.pat_desc in + begin match pat_id, exp_desc with + | Some pat_id, Texp_ident (Path.Pident exp_id, _, _) + (* let x = ... in y *) + when pat_id = exp_id (* x = y *) + && sections.style.binding + && check_underscore (Ident.name pat_id) + -> + let loc = vb_pat.pat_loc.loc_start in + register_style loc "let x = ... in x (=> useless binding)" + | _ -> () + end | _ -> () end; diff --git a/src/deadCommon.ml b/src/deadCommon.ml index 01b16d46..bbcd3e7c 100644 --- a/src/deadCommon.ml +++ b/src/deadCommon.ml @@ -138,7 +138,9 @@ let file_exists fn = (* We often simply traverse a Tlink to process the linked type *) let rec get_deep_desc typ = match Types.get_desc typ with - | Tlink t -> get_deep_desc t + | Tlink t + | Tpoly (t, []) -> + get_deep_desc t | t -> t diff --git a/src/deadLexiFi.ml b/src/deadLexiFi.ml index 6f1446ea..6f8ff48e 100644 --- a/src/deadLexiFi.ml +++ b/src/deadLexiFi.ml @@ -47,8 +47,13 @@ module Extension = struct let sig_value (value : Types.value_description) = let add strct = match strct.pstr_desc with + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + | Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _, _)); + _}, _) -> + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) | Pstr_eval ({pexp_desc = Pexp_constant {pconst_desc= (Pconst_string (s, _, _)); _}; _}, _) -> + #endif hashtbl_add_unique_to_list str s value.val_loc.loc_start | _ -> () in @@ -129,7 +134,13 @@ module Extension = struct let rec process (p, typ, call_site) = match get_deep_desc typ with | Tarrow (_, t, _, _) -> process (p, t, call_site) - | Ttuple ts -> List.iter (fun t -> process (p, t, call_site)) ts + | Ttuple ts -> + #if OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + (* Ttuple's ts' content changed in OCaml 5.4, from type_expr to + (string option * type_expr). This does the reverse conversion *) + let ts = List.map snd ts in + #endif + List.iter (fun t -> process (p, t, call_site)) ts | Tconstr (path, ts, _) -> let name = Path.name path in let name = diff --git a/src/deadObj.ml b/src/deadObj.ml index dff43646..0e7e1993 100644 --- a/src/deadObj.ml +++ b/src/deadObj.ml @@ -145,8 +145,12 @@ let rec treat_fields action typ = match get_deep_desc typ with let rec repr_exp expr f = match expr.exp_desc with | Texp_sequence (_, expr) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Texp_function {cases = {c_rhs=expr; _}::_ ; _} + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) | Texp_function (_, Tfunction_cases { cases = {c_rhs=expr; _}::_ ; _ }) | Texp_function (_, Tfunction_body expr) + #endif | Texp_let (_, _, expr) | Texp_apply (expr, _) -> repr_exp expr f | _ -> f expr @@ -288,10 +292,17 @@ let add_var loc expr = | Texp_ident (_, _, {Types.val_loc; _}) -> `Ident val_loc.Location.loc_start (* Cases not traversed by repr_exp *) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + | Texp_match (_, cases, _) -> + find_first_case_kind cases + | Texp_try (_, cases) -> + find_first_case_kind cases + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) | Texp_match (_, cases, _, _) -> find_first_case_kind cases | Texp_try (_, cases, _) -> find_first_case_kind cases + #endif | Texp_ifthenelse (_, then_, Some else_) -> find_first_kind [then_; else_] (* Default *) @@ -317,7 +328,14 @@ let class_structure cl_struct = add_equal pat.pat_loc.Location.loc_start !last_class | _ -> () end; match pat.pat_desc with - | Tpat_alias (pat, _, _, _) -> add_aliases pat + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_alias (pat, _, _) -> + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 4, 0) + | Tpat_alias (pat, _, _, _) -> + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_alias (pat, _, _, _, _) -> + #endif + add_aliases pat | _ -> () in add_aliases cl_struct.cstr_self diff --git a/src/deadSign.ml b/src/deadSign.ml index 3209518a..475cc5e3 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -169,11 +169,25 @@ let collect_export_from_structure ~path ~comp_unit structure = | Tpat_constant _ | Tpat_variant (_, None, _) -> () + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_var (id, {loc; _}) -> + let uid = Shape.Uid.internal_not_actually_unique in + (* uid appear in OCaml 5.2. Dummy value because we do not rely on it *) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) | Tpat_var (id, {loc; _}, uid) -> + #endif let id = Ident.name id in let value = value_of pat loc uid in export export_value ~path id value + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + | Tpat_alias (sub_pat, id, {loc; _}) -> + let uid = Shape.Uid.internal_not_actually_unique in + (* uid appear in OCaml 5.2. Dummy value because we do not rely on it *) + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 4, 0) | Tpat_alias (sub_pat, id, {loc; _}, uid) -> + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_alias (sub_pat, id, {loc; _}, uid, _) -> + #endif let id = Ident.name id in let value = value_of pat loc uid in export export_value ~path id value; @@ -185,9 +199,19 @@ let collect_export_from_structure ~path ~comp_unit structure = | Tpat_variant (_, Some pat, _) | Tpat_lazy pat -> collect_value ~path pat - | Tpat_tuple pats + | Tpat_tuple pats -> + #if OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + (* Tpat_tuple's pats changed in OCaml 5.4, from pat list to + (string option * pat) list. This does the reverse conversion *) + let pats = List.map snd pats in + #endif + List.iter (collect_value ~path) pats | Tpat_construct (_, _, pats, _) + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 4, 0) | Tpat_array pats -> + #elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0) + | Tpat_array (_, pats) -> + #endif List.iter (collect_value ~path) pats | Tpat_record (fields, _) -> List.iter (fun (_, _, pat) -> collect_value ~path pat) fields @@ -202,7 +226,9 @@ let collect_export_from_structure ~path ~comp_unit structure = collect_structure ~path structure | Tmod_functor (_, m) | Tmod_apply (m, _, _) - | Tmod_apply_unit m + #if OCAML_VERSION >= (5, 1, 0) && OCAML_VERSION < (5, 6, 0) + | Tmod_apply_unit m (* Constructor introduced in OCaml 5.1 *) + #endif | Tmod_constraint (m, _, Tmodtype_implicit, _) -> collect_module ~path m | Tmod_constraint (_, _, Tmodtype_explicit mt, _) -> @@ -290,7 +316,9 @@ let collect_from_include incl_decl = (None, signature) | Tmod_functor (_, mod_expr) | Tmod_apply (mod_expr, _, _) - | Tmod_apply_unit mod_expr + #if OCAML_VERSION >= (5, 1, 0) && OCAML_VERSION < (5, 6, 0) + | Tmod_apply_unit mod_expr (* Constructor introduced in OCaml 5.1 *) + #endif | Tmod_constraint (mod_expr, _, _, _) -> get_mod_path_and_signature mod_expr in @@ -398,8 +426,10 @@ let collect_eq_from_module_alias ~path module_binding = mt | Tmod_constraint (mod_expr, _, _, _) | Tmod_functor (_, mod_expr) - | Tmod_apply (mod_expr, _, _) - | Tmod_apply_unit mod_expr -> + #if OCAML_VERSION >= (5, 1, 0) && OCAML_VERSION < (5, 6, 0) + | Tmod_apply_unit mod_expr (* Constructor introduced in OCaml 5.1 *) + #endif + | Tmod_apply (mod_expr, _, _) -> collect_from_module_expr mod_expr | Tmod_structure _ | Tmod_unpack (_, _) -> () diff --git a/src/deadType.ml b/src/deadType.ml index 3a97e548..a7673b8f 100644 --- a/src/deadType.ml +++ b/src/deadType.ml @@ -27,7 +27,7 @@ let equivalences = ref [] (* t1 = t2 *) (******** HELPERS ********) -let is_unit t = match get_desc t with +let is_unit t = match get_deep_desc t with | Tconstr (p, [], _) -> Path.same p Predef.path_unit | _ -> false diff --git a/src/dune b/src/dune index 20d1c70f..81af7f69 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,8 @@ (executable (public_name dead_code_analyzer) (name deadCode) - (libraries compiler-libs.common)) + (libraries compiler-libs.common) + (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) +) (include_subdirs unqualified) diff --git a/src/state/file_infos.ml b/src/state/file_infos.ml index f8ea0bc7..f45a6a41 100644 --- a/src/state/file_infos.ml +++ b/src/state/file_infos.ml @@ -44,7 +44,11 @@ let init_from_all_cm_infos ~cm_file cmt_infos = let cm_infos = match cmt_infos.cmt_annots with | Interface sign -> + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + let cmti_uid_to_decl = Location_dependencies.NA in + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) let cmti_uid_to_decl = cmt_infos.cmt_uid_to_decl in + #endif Cmti {sign; cmti_uid_to_decl} | Implementation strc -> let location_dependencies = Location_dependencies.empty in diff --git a/src/state/location_dependencies.ml b/src/state/location_dependencies.ml index d951af2a..db268ac2 100644 --- a/src/state/location_dependencies.ml +++ b/src/state/location_dependencies.ml @@ -4,6 +4,26 @@ let empty = [] module UidTbl = Shape.Uid.Tbl +#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + +type uid_to_decl = NA + +let init ~comp_unit_to_path:_ cmt_infos _cmti_uid_to_decl = + match cmt_infos with + | Cmt_format.{cmt_annots = Implementation _; cmt_value_dependencies; _} -> + let loc_of_vd vd = vd.Types.val_loc.loc_start in + cmt_value_dependencies + |> List.map (fun (vd1, vd2) -> loc_of_vd vd1, loc_of_vd vd2) + |> Result.ok + | _ -> Result.error "No implementation found in cmt_infos" + +#elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) +(* Since OCaml 5.3, cmt_infos.cmt_value_dependencies is not available. + We try to reproduce it using the cmti_uid_to_decl and comp_unit_to_path + information, respectively found in a .cmti's cmt_infos and built using + the config.paths_to_analyze. +*) + type uid_to_decl = Typedtree.item_declaration UidTbl.t let loc_opt_of_item_decl = function @@ -22,6 +42,9 @@ let fill_from_cmt_tbl uid_to_decl res_uid_to_loc = let find_opt_external_uid_loc ~comp_unit_to_path = function | Shape.Uid.(Compilation_unit _ | Internal | Predef _) -> None + #if OCAML_VERSION >= (5, 5, 0) && OCAML_VERSION < (5, 6, 0) + | Local_opaque_item _ -> None + #endif | Item {comp_unit; from; _} as uid -> let ( let* ) x f = Option.bind x f in let cached = @@ -82,3 +105,5 @@ let init ~comp_unit_to_path cmt_infos cmti_uid_to_decl = |> cmt_decl_dep_to_loc_dep ~comp_unit_to_path cmt_infos.cmt_declaration_dependencies |> Result.ok | _ -> Result.error "No implementation found in cmt_infos" + +#endif diff --git a/src/state/location_dependencies.mli b/src/state/location_dependencies.mli index f7a124b0..bce18d2f 100644 --- a/src/state/location_dependencies.mli +++ b/src/state/location_dependencies.mli @@ -3,18 +3,36 @@ type t = (Lexing.position * Lexing.position) list val empty : t (** No signature read *) +#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) +(* The corresponding [cmt_infos.cmt_uid_to_decl] is introduced in + OCaml 5.2 but not used until OCaml 5.3 (see {!init} below). + We still provide a constructor to keep the state representation as + uniform as possible. +*) +type uid_to_decl = NA +#elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) type uid_to_decl = Typedtree.item_declaration Shape.Uid.Tbl.t +#endif val init : comp_unit_to_path: (string, string) Hashtbl.t -> Cmt_format.cmt_infos -> uid_to_decl option -> (t, string) result -(** [init ~comp_unit_to_path cmt_infos cmti_infos cmti_uid_to_decl] expects +(** [init ~comp_unit_to_path cmt_infos cmti_uid_to_decl] expects [cmt_infos.cmt_annots = Implementation _]. - It reads the [cmt_infos] and the [cmti_uid_to_decl] to retrieve their - and converts [cmt_infos.cmt_declaration_dependencies] into a single [t]. It returns an [Ok t] with [t] on success. - In case the [cmt_infos] does not contain an implementation, it returns an - [Err msg] with msg a string describing the issue. - [comp_unit_to_path] is used to load external cm files if necessary. *) + In case the [cmt_infos] does not contain an implementation, it returns + an [Err msg] with msg a string describing the issue. + + In OCaml <= 5.2, it simply maps [cmt_infos.cmt_value_dependencies] to + the correpsonding locations. [comp_unit_to_path] and [cmti_uid_to_decl] + are unused. + + In OCaml >= 5.3, it reads [cmt_infos.cmt_uid_to_decl] and + [cmti_uid_to_decl] to convert [cmt_infos.cmt_declaration_dependencies] + into a single [t] (equivalent to the result provided in OCaml <= 5.2 + using [cmt_infos.cmt_value_dependencies]). + [comp_unit_to_path] is used to load external .cmt and .cmti files if + necessary. +*) diff --git a/src/utils.ml b/src/utils.ml index 8c9b037d..6a4bd761 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -10,7 +10,17 @@ module Filepath = struct | _ -> filepath let unit filepath = + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0) + (* reproduce https://github.com/ocaml/ocaml/blob/5.3/parsing/unit_info.ml#L60 *) + let remove_all_ext basename = + match String.index basename '.' with + | dot_pos -> String.sub basename 0 dot_pos + | exception Not_found -> basename + in + filepath |> Filename.basename |> remove_all_ext |> String.capitalize_ascii + #elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0) Unit_info.lax_modname_from_source filepath + #endif type kind = | Cmti @@ -61,12 +71,29 @@ module Envaux = struct let setup = ref (Lazy.from_val ()) let force_setup () = Lazy.force !setup - let set_loadpaths (paths : Load_path.paths) = + type paths = + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + string list + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + Load_path.paths + #endif + + let init_load_path paths = + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 0, 0) + Load_path.init paths + #elif OCAML_VERSION >= (5, 0, 0) && OCAML_VERSION < (5, 2, 0) + let auto_include = Load_path.no_auto_include in + Load_path.init ~auto_include paths + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + let auto_include = Load_path.no_auto_include in + let visible = paths.Load_path.visible in + let hidden = paths.Load_path.hidden in + Load_path.init ~auto_include ~visible ~hidden + #endif + + let set_loadpaths paths = let reset () = - let auto_include = Load_path.no_auto_include in - let visible = paths.visible in - let hidden = paths.hidden in - Load_path.init ~auto_include ~visible ~hidden; + init_load_path paths; Envaux.reset_cache () in setup := Lazy.from_fun reset diff --git a/src/utils.mli b/src/utils.mli index 12994a43..e5d20e4a 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -42,7 +42,14 @@ val typedtree_signature_of_modtype : module StringSet : Set.S with type elt = String.t module Envaux : sig - val set_loadpaths : Load_path.paths -> unit + type paths = + #if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0) + string list + #elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0) + Load_path.paths + #endif + + val set_loadpaths : paths -> unit (** Reset the load_path to the [paths]. Also calls Envaux.reset_cache. To call when loading a new .cmt *)