Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ocaml-bisect_ppx for
openSUSE:Factory checked in at 2026-07-17 01:37:26
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ocaml-bisect_ppx (Old)
and /work/SRC/openSUSE:Factory/.ocaml-bisect_ppx.new.24530 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-bisect_ppx"
Fri Jul 17 01:37:26 2026 rev:9 rq:1365529 version:2.8.3
Changes:
--------
--- /work/SRC/openSUSE:Factory/ocaml-bisect_ppx/ocaml-bisect_ppx.changes
2024-01-16 21:39:53.112631131 +0100
+++
/work/SRC/openSUSE:Factory/.ocaml-bisect_ppx.new.24530/ocaml-bisect_ppx.changes
2026-07-17 01:38:54.383978312 +0200
@@ -1,0 +2,13 @@
+Tue Jul 7 07:07:07 UTC 2026 - [email protected]
+
+- Support ppxlib 0.36.0
+- Add e30265643e77bcf2c9eba7322429c779122106fc.patch
+- Add f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
+- Add 07bfceec652773de4b140cebc236a15e2429809e.patch
+- Add 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
+- Add 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
+- Add ebb352612bf32d74f26a9318dc668a54872b0cad.patch
+- Add a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
+- Add a64e135a91b6fedbc25c743816b6208f7e5874c4.patch
+
+-------------------------------------------------------------------
New:
----
07bfceec652773de4b140cebc236a15e2429809e.patch
2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
a64e135a91b6fedbc25c743816b6208f7e5874c4.patch
e30265643e77bcf2c9eba7322429c779122106fc.patch
ebb352612bf32d74f26a9318dc668a54872b0cad.patch
f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
----------(New B)----------
New:- Add f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
- Add 07bfceec652773de4b140cebc236a15e2429809e.patch
- Add 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
New:- Add 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
- Add 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
- Add ebb352612bf32d74f26a9318dc668a54872b0cad.patch
New:- Add 07bfceec652773de4b140cebc236a15e2429809e.patch
- Add 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
- Add 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
New:- Add ebb352612bf32d74f26a9318dc668a54872b0cad.patch
- Add a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
- Add a64e135a91b6fedbc25c743816b6208f7e5874c4.patch
New:- Add a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
- Add a64e135a91b6fedbc25c743816b6208f7e5874c4.patch
New:- Support ppxlib 0.36.0
- Add e30265643e77bcf2c9eba7322429c779122106fc.patch
- Add f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
New:- Add 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
- Add ebb352612bf32d74f26a9318dc668a54872b0cad.patch
- Add a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
New:- Add e30265643e77bcf2c9eba7322429c779122106fc.patch
- Add f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
- Add 07bfceec652773de4b140cebc236a15e2429809e.patch
----------(New E)----------
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ocaml-bisect_ppx.spec ++++++
--- /var/tmp/diff_new_pack.Hz87Y7/_old 2026-07-17 01:38:55.044000619 +0200
+++ /var/tmp/diff_new_pack.Hz87Y7/_new 2026-07-17 01:38:55.044000619 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ocaml-bisect_ppx
#
-# Copyright (c) 2023 SUSE LLC
+# Copyright (c) 2026 SUSE LLC and contributors
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -22,11 +22,11 @@
%if %{without ocaml_bisect_ppx_testsuite}
ExclusiveArch: do-not-build
%else
-ExclusiveArch: aarch64 ppc64 ppc64le riscv64 s390x x86_64
+ExclusiveArch: aarch64 ppc64le riscv64 s390x x86_64
%endif
%define nsuffix -testsuite
%else
-ExclusiveArch: aarch64 ppc64 ppc64le riscv64 s390x x86_64
+ExclusiveArch: aarch64 ppc64le riscv64 s390x x86_64
%define nsuffix %nil
%endif
@@ -37,22 +37,25 @@
%{?ocaml_preserve_bytecode}
Summary: Code coverage for OCaml and Reason
License: GPL-2.0-only
-Group: Development/Languages/OCaml
-URL: https://opam.ocaml.org/packages/bisect_ppx
+URL: https://opam.ocaml.org/packages/bisect_ppx/
Source0: %pkg-%version.tar.xz
+Patch4480001: e30265643e77bcf2c9eba7322429c779122106fc.patch
+Patch4480003: f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch
+Patch4480006: 07bfceec652773de4b140cebc236a15e2429809e.patch
+Patch4480007: 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch
+Patch4480009: 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch
+Patch4480010: ebb352612bf32d74f26a9318dc668a54872b0cad.patch
+Patch4480011: a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch
+Patch4480012: a64e135a91b6fedbc25c743816b6208f7e5874c4.patch
BuildRequires: ocaml
BuildRequires: ocaml-dune >= 3.0
-BuildRequires: ocaml-rpm-macros >= 20230101
-%if 1
+BuildRequires: ocaml-rpm-macros >= 20260707
BuildRequires: ocamlfind(cmdliner)
-BuildRequires: ocamlfind(ppxlib)
-BuildRequires: ocamlfind(str)
-BuildRequires: ocamlfind(unix)
-%endif
+BuildRequires: ocamlfind(ppxlib) >= 0.36.0
%if "%build_flavor" == "testsuite"
BuildRequires: git-core
-BuildRequires: ocamlfind(bisect_ppx)
+BuildRequires: ocamlfind(bisect_ppx) = %version
BuildRequires: ocamlfind(ocamlformat)
%endif
@@ -61,8 +64,7 @@
%package devel
Summary: Development files for %name
-Group: Development/Languages/OCaml
-Requires: %name = %version
+Requires: %name = %version-%release
%description devel
The %name-devel package contains libraries and signature files for
++++++ 07bfceec652773de4b140cebc236a15e2429809e.patch ++++++
>From 07bfceec652773de4b140cebc236a15e2429809e Mon Sep 17 00:00:00 2001
From: Nathan Rebours <[email protected]>
Date: Thu, 18 Sep 2025 15:01:30 +0200
Subject: Add regression test for function_cases instrumentation bug
Signed-off-by: Nathan Rebours <[email protected]>
---
bisect_ppx.opam | 2 +-
dune-project | 2 +-
test/instrument/dune | 4 +++-
test/instrument/function.t | 38 ++++++++++++++++++++++++++++++++++++++
4 files changed, 43 insertions(+), 3 deletions(-)
create mode 100644 test/instrument/function.t
diff --git a/dune-project b/dune-project
index e1e4354..ae73029 100644
--- a/dune-project
+++ b/dune-project
@@ -1,2 +1,2 @@
-(lang dune 2.7)
+(lang dune 2.9)
(cram enable)
diff --git a/test/instrument/dune b/test/instrument/dune
index a29f94b..49a57bb 100644
--- a/test/instrument/dune
+++ b/test/instrument/dune
@@ -1,3 +1,5 @@
(cram
- (deps test.sh)
+ (deps
+ test.sh
+ (package bisect_ppx))
(alias compatible))
diff --git a/test/instrument/function.t b/test/instrument/function.t
new file mode 100644
index 0000000..bc706c5
--- /dev/null
+++ b/test/instrument/function.t
@@ -0,0 +1,38 @@
+This is a regression test for #450:
https://github.com/aantron/bisect_ppx/issues/450
+
+ $ cat > dune-project <<'EOF'
+ > (lang dune 2.7)
+ > EOF
+
+ $ cat > dune <<'EOF'
+ > (library
+ > (name lib)
+ > (modules lib)
+ > (instrumentation (backend bisect_ppx)))
+ >
+ > (test
+ > (name test)
+ > (libraries lib)
+ > (modules test))
+ > EOF
+
+ $ cat > lib.ml <<'EOF'
+ > let is_hex_digit = function '0' .. '9' | 'a' .. 'f' -> true | _ -> false
+ > EOF
+
+ $ cat > test.ml <<'EOF'
+ > let () =
+ > if Lib.is_hex_digit '1' then begin
+ > Printf.printf "Test success!";
+ > exit 0
+ > end else
+ > Printf.printf "Test failure!";
+ > exit 1
+ > EOF
+
+ $ dune runtest --instrument-with bisect_ppx
+ File "lib.ml", line 1, characters 19-72:
+ 1 | let is_hex_digit = function '0' .. '9' | 'a' .. 'f' -> true | _ -> false
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ Error: broken invariant in parsetree: Function without any value parameters
+ [1]
++++++ 2d8dffbbfc0c431a37319d4d9a143836c9ec542e.patch ++++++
>From 2d8dffbbfc0c431a37319d4d9a143836c9ec542e Mon Sep 17 00:00:00 2001
From: Anton Bachin <[email protected]>
Date: Sun, 12 Oct 2025 18:12:24 +0300
Subject: Adapt to Cmdliner 2.0.0
Bisect_ppx now effectively requires OCaml 4.08, because Cmdliner 2.0.0
requires it. However, the code of Bisect_ppx proper can still easily be
made to compile against OCaml 4.03.
Resolves #444.
---
.github/workflows/test.yml | 7 +++----
Makefile | 2 +-
bisect_ppx.opam | 2 +-
src/report/main.ml | 35 ++++++++++++-----------------------
test/report/send-to.t | 8 ++++----
5 files changed, 21 insertions(+), 33 deletions(-)
diff --git a/src/report/main.ml b/src/report/main.ml
index 9f4f719..37a2013 100644
--- a/src/report/main.ml
+++ b/src/report/main.ml
@@ -21,29 +21,15 @@ let esy_source_dir =
| exception Not_found -> []
| directory -> [Filename.concat directory "default"]
-(* Many of the values used from Cmdliner.Term are deprecated in favor of values
- from Cmdliner.Cmd. However, Cmdliner.Cmd was introduced in Cmdliner 1.1.0,
- which requires OCaml 4.08.0. Bisect_ppx still supports OCaml 4.04, so Bisect
- cannot use this recent version of Cmdliner. The 4.04 constraint itself is
- only due to ppxlib.
-
- So, suppress the deprecation warnings. *)
-module Term =
-struct
- include Cmdliner.Term
-
- let eval_choice = Cmdliner.Term.eval_choice [@ocaml.warning "-3"]
- let exit = Cmdliner.Term.exit [@ocaml.warning "-3"]
- let info = Cmdliner.Term.info [@ocaml.warning "-3"]
-end
-
module Arg = Cmdliner.Arg
+module Cmd = Cmdliner.Cmd
+module Term = Cmdliner.Term
(* Common arguments. *)
-let term_info = Term.info ~sdocs:"COMMON OPTIONS"
+let term_info = Cmd.info ~sdocs:"COMMON OPTIONS"
let coverage_files from_position =
Arg.(value @@ pos_right (from_position - 1) string [] @@
@@ -303,9 +289,8 @@ let merge =
(* Entry point. *)
let () =
- Term.(eval_choice
- (ret (const (`Help (`Auto, None))),
- term_info
+ Cmd.group
+ (term_info
"bisect-ppx-report"
~doc:"Generate coverage reports for OCaml and Reason."
~man:[
@@ -316,6 +301,10 @@ let () =
`P
("See bisect-ppx-report $(i,COMMAND) --help for further " ^
"information on each command, including options.")
- ]))
- [html; send_to; text; cobertura; coveralls; merge]
- |> Term.exit
+ ]
+ ~exits:((Cmd.Exit.info ~doc:"on error." 1)::Cmd.Exit.defaults)
+ )
+ ([html; send_to; text; cobertura; coveralls; merge]
+ |> List.map (fun (term, info) -> Cmd.v info term))
+ |> Cmd.eval
+ |> exit
diff --git a/test/report/send-to.t b/test/report/send-to.t
index 7506a31..f0aee70 100644
--- a/test/report/send-to.t
+++ b/test/report/send-to.t
@@ -16,16 +16,16 @@
From Travis to Coveralls.
$ bisect-ppx-report send-to --dry-run No-such-service --verbose 2>&1 | sed
s/…/.../g | sed s/\`/\'/g
+ Usage: bisect-ppx-report send-to [--help] [OPTION]... SERVICE
+ [COVERAGE_FILES]...
bisect-ppx-report: SERVICE argument: invalid value 'No-such-service',
expected either 'Codecov' or 'Coveralls'
- Usage: bisect-ppx-report send-to [OPTION]... SERVICE [COVERAGE_FILES]...
- Try 'bisect-ppx-report send-to --help' or 'bisect-ppx-report --help' for
more information.
$ bisect-ppx-report send-to --dry-run coveralls --verbose 2>&1 | sed
s/…/.../g | sed s/\`/\'/g
+ Usage: bisect-ppx-report send-to [--help] [OPTION]... SERVICE
+ [COVERAGE_FILES]...
bisect-ppx-report: SERVICE argument: invalid value 'coveralls', expected
either 'Codecov' or 'Coveralls'
- Usage: bisect-ppx-report send-to [OPTION]... SERVICE [COVERAGE_FILES]...
- Try 'bisect-ppx-report send-to --help' or 'bisect-ppx-report --help' for
more information.
$ bisect-ppx-report send-to --dry-run Coveralls --verbose
Info: will write coverage report to 'coverage.json'
++++++ 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12.patch ++++++
>From 4f0cb2a2e1b0b786b6b5f1c94985b201aa012f12 Mon Sep 17 00:00:00 2001
From: Nathan Rebours <[email protected]>
Date: Thu, 18 Sep 2025 15:33:15 +0200
Subject: Fix instrumentation of [function _ ->] expressions
Signed-off-by: Nathan Rebours <[email protected]>
---
src/ppx/instrument.ml | 25 +++++++++++++++----------
test/instrument/function.t | 6 +-----
2 files changed, 16 insertions(+), 15 deletions(-)
diff --git a/src/ppx/instrument.ml b/src/ppx/instrument.ml
index bd72711..884b2d2 100644
--- a/src/ppx/instrument.ml
+++ b/src/ppx/instrument.ml
@@ -1327,8 +1327,8 @@ class instrumenter =
Ppxlib.With_errors.combine_errors new_params
>>= fun new_params ->
- traverse_function_body ~is_in_tail_position:true body
- >>| fun new_body ->
+ traverse_function_body ~is_in_tail_position:true
~params:new_params body
+ >>| fun (new_body, new_params) ->
let new_body =
match new_body with
| Pfunction_body { pexp_desc = Pexp_function _; _ } -> new_body
@@ -1648,24 +1648,29 @@ class instrumenter =
end
|> collect_errors
- and traverse_function_body ~is_in_tail_position body =
+ and traverse_function_body ~is_in_tail_position ~params body =
let open Ppxlib in
match body with
| Pfunction_body e ->
traverse ~is_in_tail_position e
- >>| fun e -> Pfunction_body e
+ >>| fun e -> (Pfunction_body e, params)
| Pfunction_cases (cases, loc, attrs) ->
traverse_cases ~is_in_tail_position:true cases
>>| fun cases_new ->
let cases, _, _, need_binding = instrument_cases cases_new in
if need_binding then
- Pfunction_body
- (Exp.fun_ ~loc ~attrs
- Ppxlib.Nolabel None ([%pat? ___bisect_matched_value___])
- (Exp.match_ ~loc
- ([%expr ___bisect_matched_value___]) cases))
+ let extra_param =
+ Ast_builder.Default.pparam_val ~loc Nolabel None
+ [%pat? ___bisect_matched_value___]
+ in
+ let body =
+ Pfunction_body
+ (Exp.match_ ~loc
+ ([%expr ___bisect_matched_value___]) cases)
+ in
+ (body, params @ [extra_param])
else
- Pfunction_cases (cases, loc, attrs)
+ (Pfunction_cases (cases, loc, attrs), params)
in
diff --git a/test/instrument/function.t b/test/instrument/function.t
index bc706c5..6441de3 100644
--- a/test/instrument/function.t
+++ b/test/instrument/function.t
@@ -31,8 +31,4 @@ This is a regression test for #450:
https://github.com/aantron/bisect_ppx/issues
> EOF
$ dune runtest --instrument-with bisect_ppx
- File "lib.ml", line 1, characters 19-72:
- 1 | let is_hex_digit = function '0' .. '9' | 'a' .. 'f' -> true | _ -> false
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- Error: broken invariant in parsetree: Function without any value parameters
- [1]
+ Test success!
++++++ _service ++++++
--- /var/tmp/diff_new_pack.Hz87Y7/_old 2026-07-17 01:38:55.132003594 +0200
+++ /var/tmp/diff_new_pack.Hz87Y7/_new 2026-07-17 01:38:55.136003729 +0200
@@ -1,5 +1,5 @@
<services>
- <service name="tar_scm" mode="disabled">
+ <service name="tar_scm" mode="manual">
<param name="filename">ocaml-bisect_ppx</param>
<param name="revision">004a9139916a82a187969ad711a66f02b89466aa</param>
<param name="scm">git</param>
@@ -9,10 +9,10 @@
<param name="versionrewrite-pattern">[v]?([^\+]+)(.*)</param>
<param name="versionrewrite-replacement">\1</param>
</service>
- <service name="recompress" mode="disabled">
+ <service name="recompress" mode="manual">
<param name="file">*.tar</param>
<param name="compression">xz</param>
</service>
- <service name="set_version" mode="disabled"/>
+ <service name="set_version" mode="manual"/>
</services>
++++++ a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809.patch ++++++
>From a0ff8cf6ea06d7f052c8d0fceac92a42d57e7809 Mon Sep 17 00:00:00 2001
From: Nathan Rebours <[email protected]>
Date: Tue, 4 Nov 2025 17:24:58 +0100
Subject: Add regression test for @AllanBlanchard instrumentation bug
Signed-off-by: Nathan Rebours <[email protected]>
---
test/instrument/function.t | 27 +++++++++++++++++++++++++++
1 file changed, 27 insertions(+)
diff --git a/test/instrument/function.t b/test/instrument/function.t
index 6441de3..a94fd85 100644
--- a/test/instrument/function.t
+++ b/test/instrument/function.t
@@ -32,3 +32,30 @@ This is a regression test for #450:
https://github.com/aantron/bisect_ppx/issues
$ dune runtest --instrument-with bisect_ppx
Test success!
+
+This is a regression test for
https://github.com/aantron/bisect_ppx/pull/448#issuecomment-3477888423
+
+ $ cat > lib.ml << EOF
+ > let is_hex_digit (f : bool -> bool) : char -> bool = function
+ > | '0' .. '9' | 'a' .. 'f' -> f true
+ > | _ -> f false
+ > EOF
+
+ $ cat > test.ml <<'EOF'
+ > let () =
+ > if Lib.is_hex_digit (fun x -> x) '1' then begin
+ > Printf.printf "Test success!";
+ > exit 0
+ > end else
+ > Printf.printf "Test failure!";
+ > exit 1
+ > EOF
+
+ $ dune runtest --instrument-with bisect_ppx
+ File "lib.ml", line 2, characters 31-37:
+ 2 | | '0' .. '9' | 'a' .. 'f' -> f true
+ ^^^^^^
+ Error: This expression has type bool but an expression was expected of type
+ char -> bool
+ [1]
+
++++++ a64e135a91b6fedbc25c743816b6208f7e5874c4.patch ++++++
>From a64e135a91b6fedbc25c743816b6208f7e5874c4 Mon Sep 17 00:00:00 2001
From: Nathan Rebours <[email protected]>
Date: Tue, 4 Nov 2025 17:53:26 +0100
Subject: Fix instrumentation of Pexp_function
Signed-off-by: Nathan Rebours <[email protected]>
---
src/ppx/instrument.ml | 35 ++++++++++++++++++++---------------
test/instrument/function.t | 7 +------
2 files changed, 21 insertions(+), 21 deletions(-)
diff --git a/src/ppx/instrument.ml b/src/ppx/instrument.ml
index fe86238..f147da1 100644
--- a/src/ppx/instrument.ml
+++ b/src/ppx/instrument.ml
@@ -1315,10 +1315,14 @@ class instrumenter =
(* The case where we have [function A -> ... | B -> ...] *)
| Pexp_function ([], constraint_, (Pfunction_cases _ as cases)) ->
- traverse_function_body ~is_in_tail_position ~params:[] cases
- >>| fun (new_body, new_params) ->
- let e = Ast_builder.Default.pexp_function ~loc new_params
constraint_ new_body in
- { e with pexp_attributes = attrs }
+ traverse_function_body ~is_in_tail_position cases
+ >>| fun new_body ->
+ (match (new_body : Parsetree.function_body) with
+ | Pfunction_body e ->
+ { e with pexp_attributes = attrs }
+ | Pfunction_cases _ ->
+ let e = Ast_builder.Default.pexp_function ~loc [] constraint_
new_body in
+ { e with pexp_attributes = attrs })
(* Expressions that have subexpressions that might not get visited.
*)
| Pexp_function (params, constraint_, body) ->
@@ -1334,8 +1338,8 @@ class instrumenter =
Ppxlib.With_errors.combine_errors new_params
>>= fun new_params ->
- traverse_function_body ~is_in_tail_position:true
~params:new_params body
- >>| fun (new_body, new_params) ->
+ traverse_function_body ~is_in_tail_position:true body
+ >>| fun new_body ->
let new_body =
match new_body with
| Pfunction_body { pexp_desc = Pexp_function _; _ } -> new_body
@@ -1655,12 +1659,12 @@ class instrumenter =
end
|> collect_errors
- and traverse_function_body ~is_in_tail_position ~params body =
+ and traverse_function_body ~is_in_tail_position body =
let open Ppxlib in
match body with
| Pfunction_body e ->
traverse ~is_in_tail_position e
- >>| fun e -> (Pfunction_body e, params)
+ >>| fun e -> Pfunction_body e
| Pfunction_cases (cases, loc, attrs) ->
traverse_cases ~is_in_tail_position:true cases
>>| fun cases_new ->
@@ -1670,14 +1674,15 @@ class instrumenter =
Ast_builder.Default.pparam_val ~loc Nolabel None
[%pat? ___bisect_matched_value___]
in
- let body =
- Pfunction_body
- (Exp.match_ ~loc
- ([%expr ___bisect_matched_value___]) cases)
- in
- (body, params @ [extra_param])
+ Pfunction_body
+ (Ast_builder.Default.pexp_function ~loc
+ [extra_param]
+ None
+ (Pfunction_body
+ (Exp.match_ ~loc
+ ([%expr ___bisect_matched_value___]) cases)))
else
- (Pfunction_cases (cases, loc, attrs), params)
+ Pfunction_cases (cases, loc, attrs)
in
diff --git a/test/instrument/function.t b/test/instrument/function.t
index a94fd85..d8db1c5 100644
--- a/test/instrument/function.t
+++ b/test/instrument/function.t
@@ -52,10 +52,5 @@ This is a regression test for
https://github.com/aantron/bisect_ppx/pull/448#iss
> EOF
$ dune runtest --instrument-with bisect_ppx
- File "lib.ml", line 2, characters 31-37:
- 2 | | '0' .. '9' | 'a' .. 'f' -> f true
- ^^^^^^
- Error: This expression has type bool but an expression was expected of type
- char -> bool
- [1]
+ Test success!
++++++ e30265643e77bcf2c9eba7322429c779122106fc.patch ++++++
>From e30265643e77bcf2c9eba7322429c779122106fc Mon Sep 17 00:00:00 2001
From: Mathieu Barbin <[email protected]>
Date: Mon, 12 Feb 2024 04:24:27 +0100
Subject: Add --sort-by-stats flag to HTML reporter (#433)
---
src/report/html.ml | 43 +++++++++++++++++++++++++++++++++++++++++--
src/report/html.mli | 1 +
src/report/main.ml | 12 ++++++++++--
3 files changed, 52 insertions(+), 4 deletions(-)
diff --git a/src/report/html.ml b/src/report/html.ml
index 85dc053..ebf70b9 100644
--- a/src/report/html.ml
+++ b/src/report/html.ml
@@ -31,7 +31,36 @@ type index_element =
| File of index_file
| Directory of (string * index_element list * (int * int))
-let output_html_index ~tree title theme filename files =
+module Index_element :
+sig
+ val sort_by_stats : index_element list -> index_element list
+ val flatten : index_element list -> index_element list
+end =
+struct
+ let percentage = function
+ | File (_, _, stat) -> percentage stat
+ | Directory (_, _, stat) -> percentage stat
+
+ let compare_by_stat e1 e2 =
+ compare (percentage e1, e1) (percentage e2, e2)
+
+ let rec sort_by_stats files =
+ files
+ |> List.map (function
+ | (File _) as f -> f
+ | Directory (name, files, stats) ->
+ Directory (name, sort_by_stats files, stats))
+ |> List.sort compare_by_stat
+
+ let rec flatten files =
+ files
+ |> List.map (function
+ | (File _) as f -> [f]
+ | Directory (_, files, _) -> flatten files)
+ |> List.concat
+end
+
+let output_html_index ~tree ~sort_by_stats title theme filename files =
Util.info "Writing index file...";
let add_stats (visited, total) (visited', total') =
@@ -138,6 +167,14 @@ let output_html_index ~tree title theme filename files =
let (files, stats) = collate files in
+ let files =
+ match sort_by_stats, tree with
+ | false, _ -> files
+ | true, false ->
+ files |> Index_element.flatten |> Index_element.sort_by_stats
+ | true, true -> files |> Index_element.sort_by_stats
+ in
+
let overall_coverage =
Printf.sprintf "%.02f%%" (floor ((percentage stats) *. 100.) /. 100.) in
write {|<!DOCTYPE html>
@@ -501,7 +538,8 @@ let output_string_to_separate_file content filename =
let output
~to_directory ~title ~tab_size ~theme ~coverage_files ~coverage_paths
- ~source_paths ~ignore_missing_files ~expect ~do_not_expect ~tree =
+ ~source_paths ~ignore_missing_files ~expect ~do_not_expect ~tree
+ ~sort_by_stats =
(* Read all the [.coverage] files and get per-source file visit counts. *)
let coverage =
@@ -535,6 +573,7 @@ let output
(* Write the coverage report landing page. *)
output_html_index
~tree
+ ~sort_by_stats
title
theme
(Filename.concat to_directory "index.html")
diff --git a/src/report/html.mli b/src/report/html.mli
index aac2f4e..b5d3c4d 100644
--- a/src/report/html.mli
+++ b/src/report/html.mli
@@ -16,4 +16,5 @@ val output :
expect:string list ->
do_not_expect:string list ->
tree:bool ->
+ sort_by_stats:bool ->
unit
diff --git a/src/report/main.ml b/src/report/main.ml
index 4beec68..9f4f719 100644
--- a/src/report/main.ml
+++ b/src/report/main.ml
@@ -179,17 +179,25 @@ let html =
info ["tree"] ~doc:
("Generate collapsible directory tree with per-directory summaries."))
in
+ let sort_by_stats =
+ Arg.(value @@ flag @@
+ info ["sort-by-stats"] ~doc:
+ ("Sort files in order of increasing coverage stats."))
+ in
let call_with_labels
to_directory title tab_size theme coverage_files coverage_paths
- source_paths ignore_missing_files expect do_not_expect tree =
+ source_paths ignore_missing_files expect do_not_expect tree
+ sort_by_stats =
Html.output
~to_directory ~title ~tab_size ~theme ~coverage_files ~coverage_paths
~source_paths ~ignore_missing_files ~expect ~do_not_expect ~tree
+ ~sort_by_stats
in
Term.(const set_verbose $ verbose $ const call_with_labels $ to_directory
$ title $ tab_size $ theme $ coverage_files 0 $ coverage_paths
- $ source_paths $ ignore_missing_files $ expect $ do_not_expect $ tree),
+ $ source_paths $ ignore_missing_files $ expect $ do_not_expect $ tree
+ $ sort_by_stats),
term_info "html" ~doc:"Generate HTML report locally."
~man:[
`S "USAGE EXAMPLE";
++++++ ebb352612bf32d74f26a9318dc668a54872b0cad.patch ++++++
>From ebb352612bf32d74f26a9318dc668a54872b0cad Mon Sep 17 00:00:00 2001
From: Patrick Ferris <[email protected]>
Date: Tue, 21 Oct 2025 10:05:54 +0100
Subject: Catch function cases earlier in instrumentation
---
src/ppx/instrument.ml | 9 ++++++++-
test/instrument/control/newtype.t | 3 ++-
test/instrument/recent/dune | 2 +-
3 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/src/ppx/instrument.ml b/src/ppx/instrument.ml
index 884b2d2..fe86238 100644
--- a/src/ppx/instrument.ml
+++ b/src/ppx/instrument.ml
@@ -1313,6 +1313,13 @@ class instrumenter =
>>| fun e_new ->
instrument_expr ~use_loc_of:e ~post:true (Exp.assert_ e_new)
+ (* The case where we have [function A -> ... | B -> ...] *)
+ | Pexp_function ([], constraint_, (Pfunction_cases _ as cases)) ->
+ traverse_function_body ~is_in_tail_position ~params:[] cases
+ >>| fun (new_body, new_params) ->
+ let e = Ast_builder.Default.pexp_function ~loc new_params
constraint_ new_body in
+ { e with pexp_attributes = attrs }
+
(* Expressions that have subexpressions that might not get visited.
*)
| Pexp_function (params, constraint_, body) ->
let open Parsetree in
@@ -1440,7 +1447,7 @@ class instrumenter =
>>| fun e ->
let e =
match e.pexp_desc with
- | Pexp_function _ -> e
+ | Pexp_function ([], _, Pfunction_cases _) -> e
| _ -> instrument_expr e
in
Exp.poly ~loc ~attrs e t
diff --git a/test/instrument/control/newtype.t
b/test/instrument/control/newtype.t
index 630a122..5ff9268 100644
--- a/test/instrument/control/newtype.t
+++ b/test/instrument/control/newtype.t
@@ -12,7 +12,8 @@ Recursive instrumentation of subexpression.
> let _ = fun (type _t) -> fun x -> x
> EOF
let _ =
- fun (type _t) x ->
+ fun (type _t) ->
+ fun x ->
___bisect_visit___ 0;
x
diff --git a/test/instrument/recent/dune b/test/instrument/recent/dune
index 6327a6c..3f97365 100644
--- a/test/instrument/recent/dune
+++ b/test/instrument/recent/dune
@@ -1,2 +1,2 @@
(cram
- (deps ../test.sh))
+ (deps ../test.sh (package bisect_ppx)))
++++++ f35fdf4bdcb82c308d70f7c9c313a77777f54bdf.patch ++++++
>From f35fdf4bdcb82c308d70f7c9c313a77777f54bdf Mon Sep 17 00:00:00 2001
From: Patrick Ferris <[email protected]>
Date: Fri, 20 Jun 2025 12:21:20 +0100
Subject: Support ppxlib.0.36.0
---
src/ppx/instrument.ml | 79 +++++++++++++++++++++++++------------------
1 file changed, 46 insertions(+), 33 deletions(-)
diff --git a/src/ppx/instrument.ml b/src/ppx/instrument.ml
index 7a30033..bd72711 100644
--- a/src/ppx/instrument.ml
+++ b/src/ppx/instrument.ml
@@ -1314,38 +1314,32 @@ class instrumenter =
instrument_expr ~use_loc_of:e ~post:true (Exp.assert_ e_new)
(* Expressions that have subexpressions that might not get visited.
*)
- | Pexp_function cases ->
- traverse_cases ~is_in_tail_position:true cases
- >>| fun cases_new ->
- let cases, _, _, need_binding = instrument_cases cases_new in
- if need_binding then
- Exp.fun_ ~loc ~attrs
- Ppxlib.Nolabel None ([%pat? ___bisect_matched_value___])
- (Exp.match_ ~loc
- ([%expr ___bisect_matched_value___]) cases)
- else
- Exp.function_ ~loc ~attrs cases
-
- | Pexp_fun (label, default_value, p, e) ->
- begin match default_value with
- | None ->
- return None
- | Some e ->
- traverse ~is_in_tail_position:false e
- >>| fun e ->
- Some (instrument_expr e)
- end
- >>= fun default_value ->
- traverse ~is_in_tail_position:true e
- >>| fun e ->
- let e =
- match e.pexp_desc with
- | Pexp_function _ | Pexp_fun _ -> e
- | Pexp_constraint (e', t) ->
- {e with pexp_desc = Pexp_constraint (instrument_expr e', t)}
- | _ -> instrument_expr e
+ | Pexp_function (params, constraint_, body) ->
+ let open Parsetree in
+ let new_params =
+ List.map (function
+ | { pparam_desc = Pparam_val (lbl, Some default_value, c); _ }
as p ->
+ traverse ~is_in_tail_position:false default_value
+ >>| fun e -> { p with pparam_desc = Pparam_val (lbl, Some
(instrument_expr e), c) }
+ | e -> return e
+ ) params
+ in
+ Ppxlib.With_errors.combine_errors new_params
+ >>= fun new_params ->
+
+ traverse_function_body ~is_in_tail_position:true body
+ >>| fun new_body ->
+ let new_body =
+ match new_body with
+ | Pfunction_body { pexp_desc = Pexp_function _; _ } -> new_body
+ | Pfunction_body { pexp_desc = Pexp_constraint (e', t); _ } ->
+ Pfunction_body {e with pexp_desc = Pexp_constraint
(instrument_expr e', t)}
+ | Pfunction_body e -> Pfunction_body (instrument_expr e)
+ | Pfunction_cases _ as cases -> cases
in
- Exp.fun_ ~loc ~attrs label default_value p e
+
+ let e = Ast_builder.Default.pexp_function ~loc new_params
constraint_ new_body in
+ { e with pexp_attributes = attrs }
| Pexp_match (e, cases) ->
traverse_cases ~is_in_tail_position cases
@@ -1418,7 +1412,7 @@ class instrumenter =
| Pexp_lazy e ->
let rec is_trivial_syntactic_value e =
match e.Parsetree.pexp_desc with
- | Pexp_function _ | Pexp_fun _ | Pexp_poly _ | Pexp_ident _
+ | Pexp_function _ | Pexp_poly _ | Pexp_ident _
| Pexp_constant _ | Pexp_construct (_, None) ->
true
| Pexp_constraint (e, _) | Pexp_coerce (e, _, _) ->
@@ -1446,7 +1440,7 @@ class instrumenter =
>>| fun e ->
let e =
match e.pexp_desc with
- | Pexp_function _ | Pexp_fun _ -> e
+ | Pexp_function _ -> e
| _ -> instrument_expr e
in
Exp.poly ~loc ~attrs e t
@@ -1654,6 +1648,25 @@ class instrumenter =
end
|> collect_errors
+ and traverse_function_body ~is_in_tail_position body =
+ let open Ppxlib in
+ match body with
+ | Pfunction_body e ->
+ traverse ~is_in_tail_position e
+ >>| fun e -> Pfunction_body e
+ | Pfunction_cases (cases, loc, attrs) ->
+ traverse_cases ~is_in_tail_position:true cases
+ >>| fun cases_new ->
+ let cases, _, _, need_binding = instrument_cases cases_new in
+ if need_binding then
+ Pfunction_body
+ (Exp.fun_ ~loc ~attrs
+ Ppxlib.Nolabel None ([%pat? ___bisect_matched_value___])
+ (Exp.match_ ~loc
+ ([%expr ___bisect_matched_value___]) cases))
+ else
+ Pfunction_cases (cases, loc, attrs)
+
in
traverse ~is_in_tail_position:false e
++++++ ocaml-bisect_ppx-2.8.3.tar.xz ++++++
