From 7f87a238179b01ba27f440a07e1039f438ee223c Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 9 Mar 2026 13:35:06 +0000 Subject: [PATCH 1/5] Upgrade to trace 0.12 --- .github/workflows/gh-pages.yml | 1 - dune-project | 15 +++++++--- imandrakit.opam | 2 +- src/leb128/stubs.c | 4 +-- src/log/trace_async.ml | 54 +++++++++++++++++----------------- 5 files changed, 41 insertions(+), 35 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 64284fcee..525870f69 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -20,7 +20,6 @@ jobs: allow-prerelease-opam: true # Until there's a new release of `trace`, we need to pin it. - - run: opam pin https://github.com/c-cube/ocaml-trace.git#HEAD -y -n - run: opam pin . -y -n - run: opam install odig imandrakit imandrakit-thread imandrakit-io imandrakit-log - run: opam exec -- odig odoc --cache-dir=_doc/ imandrakit imandrakit-thread imandrakit-io imandrakit-log diff --git a/dune-project b/dune-project index 3f02c8671..0aeab8f8f 100644 --- a/dune-project +++ b/dune-project @@ -36,15 +36,19 @@ (moonpool (>= 0.11)) (yojson - (and (>= 1.6) (< 3.0))) + (and + (>= 1.6) + (< 3.0))) (mtime (>= 2.0)) ppx_deriving ppx_deriving_yojson (ppxlib - (and (>= 0.25.0) (< 0.36))) + (and + (>= 0.25.0) + (< 0.36))) (trace - (and (>= 0.10) (< 0.11))) + (>= 0.12)) (qcheck-core (and (>= 0.18) @@ -120,7 +124,10 @@ (depends imandrakit imandrakit-log - (yojson (and (>= 1.6) (< 3.0))) + (yojson + (and + (>= 1.6) + (< 3.0))) hex ppx_deriving logs diff --git a/imandrakit.opam b/imandrakit.opam index 4c48eff75..f9966b204 100644 --- a/imandrakit.opam +++ b/imandrakit.opam @@ -24,7 +24,7 @@ depends: [ "ppx_deriving" "ppx_deriving_yojson" "ppxlib" {>= "0.25.0" & < "0.36"} - "trace" {>= "0.10" & < "0.11"} + "trace" {>= "0.12"} "qcheck-core" {>= "0.18" & with-test} "trace-tef" {with-test} "ocaml-lsp-server" {with-dev-setup} diff --git a/src/leb128/stubs.c b/src/leb128/stubs.c index b67097ff8..becf0ae49 100644 --- a/src/leb128/stubs.c +++ b/src/leb128/stubs.c @@ -58,14 +58,14 @@ static inline void ix_leb128_varint(unsigned char *str, uint64_t i) { // write `i` starting at `idx` CAMLprim value caml_ix_leb128_varint(value _str, intnat idx, int64_t i) { - char *str = Bytes_val(_str); + unsigned char *str = Bytes_val(_str); ix_leb128_varint(str + idx, i); return Val_unit; } CAMLprim value caml_ix_leb128_varint_byte(value _str, value _idx, value _i) { CAMLparam3(_str, _idx, _i); - char *str = Bytes_val(_str); + unsigned char *str = Bytes_val(_str); int idx = Int_val(_idx); int64_t i = Int64_val(_i); ix_leb128_varint(str + idx, i); diff --git a/src/log/trace_async.ml b/src/log/trace_async.ml index 15edc5535..6d743d0a6 100644 --- a/src/log/trace_async.ml +++ b/src/log/trace_async.ml @@ -10,7 +10,7 @@ type span_kind = [@@deriving eq, twine, show { with_path = false }] type Trace.extension_event += - | Ev_link_span of Trace.explicit_span * Trace.explicit_span_ctx + | Ev_link_span of Trace.span * Trace.span (** Link the given span to the given context. The context isn't the parent, but the link can be used to correlate both spans. *) | Ev_record_exn of { @@ -20,67 +20,67 @@ type Trace.extension_event += error: bool; (** Is this an actual internal error? *) } (** Record exception and potentially turn span to an error *) - | Ev_push_async_parent of Trace.explicit_span_ctx + | Ev_push_async_parent of Trace.span (** Set current async span *) - | Ev_pop_async_parent of Trace.explicit_span_ctx + | Ev_pop_async_parent of Trace.span (** Remove current async span *) | Ev_set_span_kind of Trace.span * span_kind (** Link the given span to the given context *) -let[@inline] link_spans (sp1 : Trace.explicit_span) - ~(src : Trace.explicit_span_ctx) : unit = +let[@inline] link_spans (sp1 : Trace.span) + ~(src : Trace.span) : unit = if Trace.enabled () then Trace.extension_event @@ Ev_link_span (sp1, src) let[@inline] set_span_kind sp k : unit = if Trace.enabled () then Trace.extension_event @@ Ev_set_span_kind (sp, k) (** Current parent scope for async spans *) -let k_span_ctx : Trace.explicit_span_ctx Hmap.key = Hmap.Key.create () +let k_span_ctx : Trace.span Hmap.key = Hmap.Key.create () (** Record exception in the span *) let add_exn_to_span ~is_error (sp : Trace.span) (exn : exn) (bt : Printexc.raw_backtrace) = Trace.extension_event @@ Ev_record_exn { sp; exn; bt; error = is_error } -let push_async_parent (sp : Trace.explicit_span_ctx) : unit = +let push_async_parent (sp : Trace.span) : unit = Trace.extension_event @@ Ev_push_async_parent sp -let pop_async_parent (sp : Trace.explicit_span_ctx) : unit = +let pop_async_parent (sp : Trace.span) : unit = Trace.extension_event @@ Ev_pop_async_parent sp -let[@inline] with_async_parent (sp : Trace.explicit_span_ctx) f = +let[@inline] with_async_parent (sp : Trace.span) f = push_async_parent sp; Fun.protect ~finally:(fun () -> pop_async_parent sp) f open struct - let auto_enrich_span_l_ : (Trace.explicit_span -> unit) list Atomic.t = + let auto_enrich_span_l_ : (Trace.span -> unit) list Atomic.t = Atomic.make [] let with_span_real_ ~level ~parent ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ - name (f : Trace_core.explicit_span * Trace_core.explicit_span_ctx -> 'a) : + name (f : Trace_core.span * Trace_core.span -> 'a) : 'a = let span = - Trace.enter_manual_span ~parent ~flavor:`Async ?data ~level ?__FUNCTION__ + Trace.enter_span ~parent ~flavor:`Async ?data ~level ?__FUNCTION__ ~__FILE__ ~__LINE__ name in - push_async_parent (Trace_core.ctx_of_span span); + push_async_parent span; (* apply automatic enrichment *) - if span.span != Trace.Collector.dummy_span then + if span != Trace.Collector.dummy_span then List.iter (fun f -> f span) (Atomic.get auto_enrich_span_l_); let cleanup () = - pop_async_parent (Trace_core.ctx_of_span span); - Trace.exit_manual_span span + pop_async_parent span; + Trace.exit_span span in try - let x = f (span, Trace.ctx_of_span span) in + let x = f (span, span) in cleanup (); x with e -> let bt = Printexc.get_raw_backtrace () in - add_exn_to_span ~is_error:true span.span e bt; + add_exn_to_span ~is_error:true span e bt; cleanup (); Printexc.raise_with_backtrace e bt end @@ -88,7 +88,7 @@ end (** Wrap [f()] in a async span. *) let with_span ?(level = Trace.get_default_level ()) ?parent ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ name - (f : Trace.explicit_span * Trace.explicit_span_ctx -> 'a) : 'a = + (f : Trace.span * Trace.span -> 'a) : 'a = let trace_enabled = Trace.enabled () in if trace_enabled && level <= Trace.get_current_level () then with_span_real_ ~level ~parent ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ name @@ -98,11 +98,11 @@ let with_span ?(level = Trace.get_default_level ()) ?parent ?data ?__FUNCTION__ | Some p when trace_enabled -> (* make sure we still link spans in [f()] to [p] *) let@ () = with_async_parent p in - f (Trace.Collector.dummy_explicit_span, p) + f (Trace.Collector.dummy_span, p) | _ -> f - ( Trace.Collector.dummy_explicit_span, - Trace.Collector.dummy_explicit_span_ctx ) + ( Trace.Collector.dummy_span, + Trace.Collector.dummy_span ) ) open struct @@ -112,21 +112,21 @@ open struct | Some v -> (name, `String v) :: l end -let enrich_span_service ?version (span : Trace.explicit_span) : unit = +let enrich_span_service ?version (span : Trace.span) : unit = let data = [] |> cons_assoc_opt_ "service.version" version in - Trace.add_data_to_manual_span span data + Trace.add_data_to_span span data -let enrich_span_deployment ?id ?name ~deployment (span : Trace.explicit_span) : +let enrich_span_deployment ?id ?name ~deployment (span : Trace.span) : unit = let data = [ "deployment.environment.name", `String deployment ] |> cons_assoc_opt_ "deployment.id" id |> cons_assoc_opt_ "deployment.name" name in - Trace.add_data_to_manual_span span data + Trace.add_data_to_span span data (** Add a hook that will be called on every explicit span *) -let add_auto_enrich_span (f : Trace.explicit_span -> unit) : unit = +let add_auto_enrich_span (f : Trace.span -> unit) : unit = while let l = Atomic.get auto_enrich_span_l_ in not (Atomic.compare_and_set auto_enrich_span_l_ l (f :: l)) From a3502c53d4b808fdce622e0ad147c4bb4be77f88 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 9 Mar 2026 13:40:28 +0000 Subject: [PATCH 2/5] Update workflow --- .github/workflows/main.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 3a5913920..2a3954bdb 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -30,7 +30,6 @@ jobs: dune-cache: true allow-prerelease-opam: true - - run: opam pin trace --dev -y -n; opam pin trace-tef --dev -y -n - run: opam install -t imandrakit imandrakit-log imandrakit-io --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-log,imandrakit-io - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-log,imandrakit-io @@ -52,6 +51,7 @@ jobs: ocaml-compiler: - '5.1' - '5.2' + - '5.3' runs-on: ${{ matrix.os }} steps: @@ -63,7 +63,6 @@ jobs: dune-cache: true allow-prerelease-opam: true - - run: opam pin trace --dev -y -n; opam pin trace-tef --dev -y -n - run: opam install -t imandrakit imandrakit-log imandrakit-io imandrakit-thread --deps-only - run: opam exec -- dune build @install -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-io,imandrakit-log,imandrakit-thread From 501fbd4a78e4664b0ed10b11a9b73442806bdb67 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 9 Mar 2026 13:44:29 +0000 Subject: [PATCH 3/5] Remove support for OCaml 4.x (Moonpool requires 5.x) --- .github/workflows/main.yml | 35 ++--------------------------------- 1 file changed, 2 insertions(+), 33 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 2a3954bdb..52eaf8d92 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -7,39 +7,8 @@ on: pull_request: jobs: - build-all-versions: - name: build - timeout-minutes: 15 - strategy: - fail-fast: true - matrix: - os: - - ubuntu-latest - #- macos-latest - #- windows-latest - ocaml-compiler: - - '4.14' - - runs-on: ${{ matrix.os }} - steps: - - uses: actions/checkout@main - - name: Use OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v3 - with: - ocaml-compiler: ${{ matrix.ocaml-compiler }} - dune-cache: true - allow-prerelease-opam: true - - - run: opam install -t imandrakit imandrakit-log imandrakit-io --deps-only - - run: opam exec -- dune build @install -p imandrakit,imandrakit-log,imandrakit-io - - run: opam exec -- dune build @runtest -p imandrakit,imandrakit-log,imandrakit-io - - # install some depopts and build+test again - - run: opam install camlzip - - run: opam exec -- dune build @install @runtest -p imandrakit,imandrakit-log,imandrakit-io - - build-ocaml5: - name: build-ocaml5 + build: + name: Build and Test timeout-minutes: 15 strategy: fail-fast: true From eeed87c9c22fe173ce743984b596a6e8be13196e Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 9 Mar 2026 13:54:26 +0000 Subject: [PATCH 4/5] Formatting --- src/log/trace_async.ml | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/src/log/trace_async.ml b/src/log/trace_async.ml index 6d743d0a6..084acc1fa 100644 --- a/src/log/trace_async.ml +++ b/src/log/trace_async.ml @@ -20,15 +20,12 @@ type Trace.extension_event += error: bool; (** Is this an actual internal error? *) } (** Record exception and potentially turn span to an error *) - | Ev_push_async_parent of Trace.span - (** Set current async span *) - | Ev_pop_async_parent of Trace.span - (** Remove current async span *) + | Ev_push_async_parent of Trace.span (** Set current async span *) + | Ev_pop_async_parent of Trace.span (** Remove current async span *) | Ev_set_span_kind of Trace.span * span_kind (** Link the given span to the given context *) -let[@inline] link_spans (sp1 : Trace.span) - ~(src : Trace.span) : unit = +let[@inline] link_spans (sp1 : Trace.span) ~(src : Trace.span) : unit = if Trace.enabled () then Trace.extension_event @@ Ev_link_span (sp1, src) let[@inline] set_span_kind sp k : unit = @@ -53,12 +50,10 @@ let[@inline] with_async_parent (sp : Trace.span) f = Fun.protect ~finally:(fun () -> pop_async_parent sp) f open struct - let auto_enrich_span_l_ : (Trace.span -> unit) list Atomic.t = - Atomic.make [] + let auto_enrich_span_l_ : (Trace.span -> unit) list Atomic.t = Atomic.make [] let with_span_real_ ~level ~parent ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ - name (f : Trace_core.span * Trace_core.span -> 'a) : - 'a = + name (f : Trace_core.span * Trace_core.span -> 'a) : 'a = let span = Trace.enter_span ~parent ~flavor:`Async ?data ~level ?__FUNCTION__ ~__FILE__ ~__LINE__ name @@ -87,8 +82,7 @@ end (** Wrap [f()] in a async span. *) let with_span ?(level = Trace.get_default_level ()) ?parent ?data ?__FUNCTION__ - ~__FILE__ ~__LINE__ name - (f : Trace.span * Trace.span -> 'a) : 'a = + ~__FILE__ ~__LINE__ name (f : Trace.span * Trace.span -> 'a) : 'a = let trace_enabled = Trace.enabled () in if trace_enabled && level <= Trace.get_current_level () then with_span_real_ ~level ~parent ?data ?__FUNCTION__ ~__FILE__ ~__LINE__ name @@ -99,10 +93,7 @@ let with_span ?(level = Trace.get_default_level ()) ?parent ?data ?__FUNCTION__ (* make sure we still link spans in [f()] to [p] *) let@ () = with_async_parent p in f (Trace.Collector.dummy_span, p) - | _ -> - f - ( Trace.Collector.dummy_span, - Trace.Collector.dummy_span ) + | _ -> f (Trace.Collector.dummy_span, Trace.Collector.dummy_span) ) open struct @@ -116,8 +107,7 @@ let enrich_span_service ?version (span : Trace.span) : unit = let data = [] |> cons_assoc_opt_ "service.version" version in Trace.add_data_to_span span data -let enrich_span_deployment ?id ?name ~deployment (span : Trace.span) : - unit = +let enrich_span_deployment ?id ?name ~deployment (span : Trace.span) : unit = let data = [ "deployment.environment.name", `String deployment ] |> cons_assoc_opt_ "deployment.id" id From dc8c6a0d4c29249e1e7bc644fe40f02f7f247929 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 9 Mar 2026 14:26:12 +0000 Subject: [PATCH 5/5] Formatting --- src/twine-utils/dune | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/twine-utils/dune b/src/twine-utils/dune index e26981f0a..de2ab258b 100644 --- a/src/twine-utils/dune +++ b/src/twine-utils/dune @@ -1,6 +1,7 @@ (executable (name main) - (modes (byte exe)) + (modes + (byte exe)) (public_name twine_utils) (package twine-utils) (preprocess