Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ocaml-dune for openSUSE:Factory checked in at 2026-02-18 17:10:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-dune (Old) and /work/SRC/openSUSE:Factory/.ocaml-dune.new.1977 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-dune" Wed Feb 18 17:10:42 2026 rev:53 rq:1333673 version:3.21.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-dune/ocaml-dune.changes 2026-02-10 21:12:18.499275855 +0100 +++ /work/SRC/openSUSE:Factory/.ocaml-dune.new.1977/ocaml-dune.changes 2026-02-18 17:11:35.741123633 +0100 @@ -1,0 +2,6 @@ +Wed Feb 11 11:11:11 UTC 2026 - [email protected] + +- Update to version 3.21.1 + see included CHANGES.md file for details + +------------------------------------------------------------------- Old: ---- ocaml-dune-3.21.0.tar.xz New: ---- ocaml-dune-3.21.1.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-dune.spec ++++++ --- /var/tmp/diff_new_pack.H6wQfs/_old 2026-02-18 17:11:36.929173158 +0100 +++ /var/tmp/diff_new_pack.H6wQfs/_new 2026-02-18 17:11:36.933173324 +0100 @@ -25,7 +25,7 @@ %define pkg ocaml-dune %global _buildshell /bin/bash Name: %pkg%nsuffix -Version: 3.21.0 +Version: 3.21.1 Release: 0 %{?ocaml_preserve_bytecode} License: MIT ++++++ _service ++++++ --- /var/tmp/diff_new_pack.H6wQfs/_old 2026-02-18 17:11:36.985175492 +0100 +++ /var/tmp/diff_new_pack.H6wQfs/_new 2026-02-18 17:11:36.993175826 +0100 @@ -1,7 +1,7 @@ <services> <service name="tar_scm" mode="manual"> <param name="filename">ocaml-dune</param> - <param name="revision">832d2384ce30cf98e32d797aecf81088d1bd354b</param> + <param name="revision">0b5863d9be475453b3cc2bd321fde222af2544d4</param> <param name="scm">git</param> <param name="submodules">disable</param> <param name="url">https://github.com/ocaml/dune.git</param> ++++++ ocaml-dune-3.21.0.tar.xz -> ocaml-dune-3.21.1.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/.github/workflows/workflow.yml new/ocaml-dune-3.21.1/.github/workflows/workflow.yml --- old/ocaml-dune-3.21.0/.github/workflows/workflow.yml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/.github/workflows/workflow.yml 2026-02-11 04:32:57.000000000 +0100 @@ -146,6 +146,29 @@ gc-max-store-size-linux: 2G - run: nix develop -i .#bootstrap-check_4_08 -c make release + nix-build-ox: + # This builds OxCaml with the flake version which is typically ahead of the + # OxCaml opam repository + name: Build with OxCaml + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v6 + - uses: nixbuild/nix-quick-install-action@v34 + with: + nix_conf: ${{ env.EXTRA_NIX_CONFIG }} + - uses: nix-community/cache-nix-action@v6 + with: + primary-key: | + nix-${{ runner.os }}-${{ github.job }}-${{ hashFiles('**/*.nix', '**/flake.lock') }} + restore-prefixes-first-match: nix-${{ runner.os }}-${{ github.job }}- + gc-max-store-size-linux: 2G + - run: nix develop -i .#bootstrap-ox -c make release + # # Stage 2 # diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/CHANGES.md new/ocaml-dune-3.21.1/CHANGES.md --- old/ocaml-dune-3.21.0/CHANGES.md 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/CHANGES.md 2026-02-11 04:32:57.000000000 +0100 @@ -1,3 +1,17 @@ +3.21.1 (2026-02-10) +------------------- + +### Fixed + +- Fix build issues on NetBSD and OpenBSD via update of vendored ocaml-lmdb + (#13074, @Alizter) +- Fix `melange.emit` not respecting the package mask via `-p <PKG>` (#13522, + @anmonteiro) + +### Changed + +- Stop starting RPC server with `$ dune promote` (#13428, @rgrinberg) + 3.21.0 (2026-01-12) ------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/bin/promotion.ml new/ocaml-dune-3.21.1/bin/promotion.ml --- old/ocaml-dune-3.21.0/bin/promotion.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/bin/promotion.ml 2026-02-11 04:32:57.000000000 +0100 @@ -78,7 +78,7 @@ let files_to_promote = files_to_promote ~common files in match Dune_util.Global_lock.lock ~timeout:None with | Ok () -> - Scheduler.go_with_rpc_server ~common ~config (fun () -> + Scheduler.go_without_rpc_server ~common ~config (fun () -> let open Fiber.O in let+ () = Fiber.return () in Diff_promotion.promote_files_registered_in_last_run files_to_promote) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/flake.lock new/ocaml-dune-3.21.1/flake.lock --- old/ocaml-dune-3.21.0/flake.lock 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/flake.lock 2026-02-11 04:32:57.000000000 +0100 @@ -162,11 +162,11 @@ ] }, "locked": { - "lastModified": 1764950604, - "narHash": "sha256-ihghtDwL4ioBLg9yphaK2RXoZjJYPvoKgLWGR6GGwPk=", + "lastModified": 1765456638, + "narHash": "sha256-Q/BaBegWD0FlxIndp4roXfPSWxHEQF/+PeLHmg3AbHs=", "owner": "oxcaml", "repo": "oxcaml", - "rev": "847bf56d6bd9fa8744546a96db820466c4a6ead2", + "rev": "8e7b3655a43711d05419647a3bcda4a6b0374f93", "type": "github" }, "original": { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/otherlibs/configurator/src/v1.ml new/ocaml-dune-3.21.1/otherlibs/configurator/src/v1.ml --- old/ocaml-dune-3.21.0/otherlibs/configurator/src/v1.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/otherlibs/configurator/src/v1.ml 2026-02-11 04:32:57.000000000 +0100 @@ -134,13 +134,13 @@ let prog_command_line = command_line prog args in logf t "run: %s" prog_command_line; let n = gen_id t in - let create_process = + let create_process stdin stdout stderr = let args = Array.of_list (prog :: args) in match env with - | None -> Unix.create_process prog args + | None -> Unix.create_process prog args stdin stdout stderr | Some env -> let env = Array.of_list env in - Unix.create_process_env prog args env + Unix.create_process_env prog args env stdin stdout stderr in let stdout_fn = t.dest_dir ^/ sprintf "stdout-%d" n in let stderr_fn = t.dest_dir ^/ sprintf "stderr-%d" n in @@ -795,7 +795,7 @@ let t = create_from_inside_dune ~dest_dir:!dest_dir - ~log:(if !verbose then prerr_endline else log) + ~log:(if !verbose then fun s -> prerr_endline s else fun s -> log s) ~build_dir ~name in diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/otherlibs/stdune/src/fpath.ml new/ocaml-dune-3.21.1/otherlibs/stdune/src/fpath.ml --- old/ocaml-dune-3.21.0/otherlibs/stdune/src/fpath.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/otherlibs/stdune/src/fpath.ml 2026-02-11 04:32:57.000000000 +0100 @@ -128,7 +128,7 @@ retry_loop 30) ;; -let unlink_exn = if Stdlib.Sys.win32 then win32_unlink else Unix.unlink +let unlink_exn = if Stdlib.Sys.win32 then win32_unlink else fun t -> Unix.unlink t type unlink_status = | Success diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/src/csexp_rpc/csexp_rpc.ml new/ocaml-dune-3.21.1/src/csexp_rpc/csexp_rpc.ml --- old/ocaml-dune-3.21.0/src/csexp_rpc/csexp_rpc.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/src/csexp_rpc/csexp_rpc.ml 2026-02-11 04:32:57.000000000 +0100 @@ -238,7 +238,7 @@ let write t b = match Platform.OS.value with | Linux -> send t b - | _ -> Unix.single_write t b + | _ -> fun pos len -> Unix.single_write t b pos len ;; let rec csexp_write_loop fd out_buf token = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/src/dune_rules/stanzas/stanzas.ml new/ocaml-dune-3.21.1/src/dune_rules/stanzas/stanzas.ml --- old/ocaml-dune-3.21.0/src/dune_rules/stanzas/stanzas.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/src/dune_rules/stanzas/stanzas.ml 2026-02-11 04:32:57.000000000 +0100 @@ -135,6 +135,7 @@ | Tests.T { package = Some package; _ } -> Some package | Coq_stanza.Theory.T { package = Some package; _ } -> Some package | Rocq_stanza.Theory.T { package = Some package; _ } -> Some package + | Melange_stanzas.Emit.T { package = Some package; _ } -> Some package | _ -> None) |> Option.map ~f:Package.id with diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/src/dune_trace/dune_trace.ml new/ocaml-dune-3.21.1/src/dune_trace/dune_trace.ml --- old/ocaml-dune-3.21.0/src/dune_trace/dune_trace.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/src/dune_trace/dune_trace.ml 2026-02-11 04:32:57.000000000 +0100 @@ -47,7 +47,7 @@ let create dst = let print = match dst with - | Out out -> Stdlib.output_string out + | Out out -> fun str -> Stdlib.output_string out str | Custom c -> c.write in let close = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/formatting/no-gen.t new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/formatting/no-gen.t --- old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/formatting/no-gen.t 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/formatting/no-gen.t 2026-02-11 04:32:57.000000000 +0100 @@ -55,13 +55,9 @@ $ touch other_gen.mli $ touch parser_raw.mli -We format again. - $ dune build @fmt +We format again. Filter menhir warnings (which vary by version) to keep output stable. + $ dune build @fmt 2>&1 | grep -v "end-of-stream" | grep -v "never reduced" | grep -v 'File "parser_raw.mly"' | grep -v "in total" fake ocamlformat is running: "--intf" "other_gen.mli" - Warning: one state end-of-stream conflict was arbitrarily resolved. - File "parser_raw.mly", line 5, characters 4-7: - Warning: production prog -> EOL is never reduced. - Warning: in total, 1 production is never reduced. fake ocamlformat is running: "--intf" "parser_raw.mli" File "other_gen.mli", line 1, characters 0-0: Error: Files _build/default/other_gen.mli and @@ -69,7 +65,6 @@ File "parser_raw.mli", line 1, characters 0-0: Error: Files _build/default/parser_raw.mli and _build/default/.formatted/parser_raw.mli differ. - [1] FIXME: unexpectedly, Dune generated the missing parser $ dune_cmd exists _build/default/parser_raw.ml diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/melange/melange-emit-package.t new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/melange/melange-emit-package.t --- old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/melange/melange-emit-package.t 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/melange/melange-emit-package.t 2026-02-11 04:32:57.000000000 +0100 @@ -80,14 +80,11 @@ $ dune build -p my-ppx -and fails if it can't resolve libraries to build the alias +and fails to build any `@melange`-related stuff, because none is defined for +the package `my-ppx` $ dune build @melange -p my-ppx - File "test/dune", line 6, characters 12-19: - 6 | (libraries mel-foo)) - ^^^^^^^ - Error: Library "mel-foo" not found. - -> required by _build/default/test/js-out/test/test_entry.js - -> required by alias test/melange + Error: Alias "melange" specified on the command line is empty. + It is not defined in . or any of its descendants. [1] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/melange/melange-runtest-multiple-packages.t new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/melange/melange-runtest-multiple-packages.t --- old/ocaml-dune-3.21.0/test/blackbox-tests/test-cases/melange/melange-runtest-multiple-packages.t 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-dune-3.21.1/test/blackbox-tests/test-cases/melange/melange-runtest-multiple-packages.t 2026-02-11 04:32:57.000000000 +0100 @@ -0,0 +1,40 @@ +Show interaction of `dune runtest -p ..` and `(melange.emit ..)` + + $ cat > dune-project <<EOF + > (lang dune 3.21) + > (using melange 1.0) + > (package (name a)) + > (package (name b)) + > EOF + + $ mkdir a b + $ cat > a/dune <<EOF + > (melange.emit + > (alias runtest) + > (package a) + > (emit_stdlib false) + > (target out)) + > EOF + $ cat > a/x.ml <<EOF + > let () = print_endline "hello" + > EOF + + $ cat > b/dune <<EOF + > (melange.emit + > (alias runtest) + > (package b) + > (emit_stdlib false) + > (target out)) + > EOF + $ cat > b/x.ml <<EOF + > let () = print_endline "hello" + > EOF + +Selecting only the package a should not build b + + $ dune runtest -p a + $ test -e _build/default/b/out/b/x.js + [1] + + $ dune runtest -p b + $ test -e _build/default/b/out/b/x.js diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb.ml new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb.ml --- old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb.ml 2026-02-11 04:32:57.000000000 +0100 @@ -279,172 +279,14 @@ } end -module Map = struct - type ('k, 'v, -'dup) t = - { env :Env.t - ; mutable dbi :Mdb.dbi - ; flags :Mdb.DbiFlags.t - ; key : 'k Conv.t - ; value : 'v Conv.t - } - constraint 'dup = [< `Dup | `Uni ] - - let env { env; _ } = env - - type 'a card = - | Nodup : [ `Uni ] card - | Dup : [ `Dup | `Uni ] card - - let create - (type dup key value) - (perm : 'openperm perm) - (dup : (dup as 'dup) card) - ~(key : key Conv.t) - ~(value : value Conv.t) - ?(txn : 'openperm Txn.t option) - ?(name : string option) - (env : Env.t) - :(key, value, 'dup) t - = - let create_of_perm (type p) (perm :p perm) = - match perm with - | Ro -> Conv.Flags.none - | Rw -> Conv.Flags.create - in - let flags = - let open Conv.Flags in - create_of_perm perm + - key.flags * (reverse_key + integer_key) + - match dup with - | Nodup -> Conv.Flags.none - | Dup when name = None -> - invalid_arg "Lmdb.Map.create: The unnamed map does not support duplicates" - | Dup -> - dup_sort + - value.flags * (dup_fixed + integer_dup + reverse_dup) - in - let dbi, flags = - Txn.trivial perm ?txn env @@ fun txn -> - let dbi = Mdb.dbi_open txn name flags in - let flags' = Mdb.dbi_flags txn dbi in - if not Conv.Flags.(eq (unset create flags) flags') - then begin - Mdb.dbi_close env dbi; - Printf.sprintf "Lmdb.Map.create: While opening %s got flags %0#x, but expected %0#x\n" - (match name with None -> "<unnamed>" | Some name -> name) - (Conv.Flags.to_int flags') - (Conv.Flags.to_int flags) - |> invalid_arg - end; - dbi, flags - in - { env; dbi; flags; key; value } - - let create dup ~key ~value ?txn ?name env = - create Rw dup ~key ~value ?txn ?name env - and open_existing dup ~key ~value ?txn ?name env = - create Ro dup ~key ~value ?txn ?name env - - let close ({env; dbi; _} as map) = - map.dbi <- Mdb.invalid_dbi; - Mdb.dbi_close env dbi - - let stat ?txn {env; dbi; _} = - Txn.trivial Ro ?txn env @@ fun txn -> - Mdb.dbi_stat txn dbi - - let _flags ?txn {env; dbi; _} = - Txn.trivial Ro env ?txn @@ fun txn -> - Mdb.dbi_flags txn dbi - - let drop ?txn ?(delete=false) ({dbi ;env ;_ } as map) = - if delete then map.dbi <- Mdb.invalid_dbi; - Txn.trivial Rw ?txn env @@ fun txn -> - Mdb.drop txn dbi delete - - let get map ?txn k = - Txn.trivial Ro ?txn map.env @@ fun txn -> - Mdb.get txn map.dbi (map.key.serialise Bigstring.create k) - |> map.value.deserialise - - module Flags = Mdb.PutFlags - - let put_raw_key map ?txn ?(flags=Flags.none) ka v = - if Conv.Flags.(test dup_sort map.flags) - then begin - let va = map.value.serialise Bigstring.create v in - Txn.trivial Rw ?txn map.env @@ fun txn -> - Mdb.put txn map.dbi ka va flags - end - else begin - Txn.trivial Rw ?txn map.env @@ fun txn -> - let va_opt = ref Mdb.Block_option.none in - let alloc len = - if Mdb.Block_option.is_some !va_opt then - invalid_arg "Lmdb: converting function tried to allocate twice."; - let va = Mdb.put_reserve txn map.dbi ka len flags in - va_opt := Mdb.Block_option.some va; - va - in - let va = map.value.serialise alloc v in - if Mdb.Block_option.is_some !va_opt - then begin - if Mdb.Block_option.get_unsafe !va_opt != va then - invalid_arg "Lmdb: converting function allocated, but returned different buffer." - end - else Mdb.put txn map.dbi ka va flags - end - - let add map ?txn ?(flags=Flags.none) k v = - let flags = - if Conv.Flags.(test dup_sort map.flags) - then flags - else Flags.(flags + no_overwrite) - in - let ka = map.key.serialise Bigstring.create k in - put_raw_key map ?txn ~flags ka v - - let set map ?txn ?flags k v = - let ka = map.key.serialise Bigstring.create k in - if Conv.Flags.(test dup_sort map.flags) - then begin - Txn.trivial Rw ?txn map.env @@ fun txn -> - (try Mdb.del txn map.dbi ka Mdb.Block_option.none with Not_found -> ()); - put_raw_key map ~txn ?flags ka v - end - else - put_raw_key map ?txn ?flags ka v - - let remove map ?txn ?value:v k = - let key = map.key and value = map.value in - let ka = key.serialise Bigstring.create k in - let va = match v with - | None -> Mdb.Block_option.none - | Some v -> - Mdb.Block_option.some @@ value.serialise Bigstring.create v - in - Txn.trivial Rw ?txn map.env @@ fun txn -> - Mdb.del txn map.dbi ka va - - let compare_key map ?txn x y = - let key = map.key in - let xa = key.serialise Bigstring.create x in - let ya = key.serialise Bigstring.create y in - Txn.trivial Ro ?txn map.env @@ fun txn -> - Mdb.cmp txn map.dbi xa ya - - let compare_val map ?txn = - if not Conv.Flags.(test dup_sort map.flags) then - invalid_arg "Lmdb: elements are only comparable in a dup_sort map"; - let value = map.value in - fun x y -> - let xa = value.serialise Bigstring.create x in - let ya = value.serialise Bigstring.create y in - Txn.trivial Ro ?txn map.env @@ fun txn -> - Mdb.dcmp txn map.dbi xa ya - - let compare = compare_key -end +type ('k, 'v, -'dup) map = + { env :Env.t + ; mutable dbi :Mdb.dbi + ; flags :Mdb.DbiFlags.t + ; key : 'k Conv.t + ; value : 'v Conv.t + } + constraint 'dup = [< `Dup | `Uni ] module Cursor = struct @@ -454,11 +296,13 @@ type ('k, 'v, -'perm, -'dup) t = { cursor: Mdb.cursor - ; map: ('k, 'v, 'dup) Map.t } + ; map: ('k, 'v, 'dup) map } constraint 'dup = [< `Dup | `Uni ] constraint 'perm = [< `Read | `Write ] - let go perm ?txn (map :_ Map.t) f = + let txn {cursor; _} = Mdb.cursor_txn cursor + + let go perm ?txn map f = Txn.trivial perm map.env ?txn @@ fun t -> let cursor = { cursor = Mdb.cursor_open t map.dbi @@ -475,7 +319,8 @@ (*Printexc.raise_with_backtrace exn bt - since OCaml 4.05 *) (* Used internally for trivial functions, not exported. *) - let trivial perm ?cursor (map :_ Map.t) f = + (* + let trivial perm ?cursor map f = match (cursor :_ t option) with | Some cursor -> if cursor.map != map @@ -484,6 +329,7 @@ f cursor | None -> go perm map f + *) let seek { cursor ; map } k = let key = map.key and value = map.value in @@ -569,72 +415,54 @@ let cursor_none cursor = Mdb.cursor_get cursor.cursor Mdb.Block_option.none Mdb.Block_option.none - let get_values_multiple cursor len = - let value = cursor.map.value in + let get_values_multiple (cursor :(_, _, [> `Read ], [> `Dup ]) t) len = assert Conv.Flags.(test dup_fixed cursor.map.flags); let _, first = cursor_none cursor Ops.first_dup in let size = Bigstring.length first in - let values = Array.make len (Obj.magic ()) in let _, buf = cursor_none cursor Ops.get_multiple in - let rec convert buf off i = - if off+size <= Bigstring.length buf + let off, buf = ref 0, ref buf in + let values = + Array.init len @@ fun _ -> + if !off = Bigstring.length !buf then begin - values.(i) <- value.deserialise @@ Bigstring.sub buf ~off ~len:size; - convert buf (off+size) (i+1) - end - else begin - assert (off = Bigstring.length buf); - i + buf := snd @@ cursor_none cursor Ops.next_multiple; + off := 0; end + else + assert (!off + size <= Bigstring.length !buf); + let v = Bigstring.sub !buf ~off:!off ~len:size in + off := !off + size; + cursor.map.value.deserialise v in - let i = convert buf 0 0 in - let rec loop i = - match - try Some (cursor_none cursor Ops.next_multiple) with Not_found -> None - with - | None -> i - | Some (_, buf) -> - loop (convert buf 0 i); - in - let i = loop i in - assert (i = len); - values - + try cursor_none cursor Ops.next_multiple |> ignore; assert false + with Not_found -> values let get_values_from_first cursor first = - if not Conv.Flags.(test dup_sort cursor.map.flags) - then [| first |] + let len = Mdb.cursor_count cursor.cursor in + if len > 1 && Conv.Flags.(test (dup_sort + dup_fixed) cursor.map.flags) + then get_values_multiple cursor len else begin - let len = Mdb.cursor_count cursor.cursor in - if len > 1 && Conv.Flags.(test (dup_sort + dup_fixed) cursor.map.flags) - then get_values_multiple cursor len - else begin - let values = Array.make len first in - for i = 1 to len - 1 do - values.(i) <- next_dup cursor - done; - values - end + let values = Array.make len first in + for i = 1 to len - 1 do + values.(i) <- next_dup cursor + done; + values end let get_values_from_last cursor last = - if not Conv.Flags.(test dup_sort cursor.map.flags) - then [| last |] + let len = Mdb.cursor_count cursor.cursor in + if len > 1 && Conv.Flags.(test (dup_sort + dup_fixed) cursor.map.flags) + then begin + let values = get_values_multiple cursor len in + cursor_none cursor Ops.first_dup |> ignore; + values + end else begin - let len = Mdb.cursor_count cursor.cursor in - if len > 1 && Conv.Flags.(test (dup_sort + dup_fixed) cursor.map.flags) - then begin - let values = get_values_multiple cursor len in - cursor_none cursor Ops.first_dup |> ignore; - values - end - else begin - let values = Array.make len last in - for i = len - 2 downto 0 do - values.(i) <- prev_dup cursor - done; - values - end + let values = Array.make len last in + for i = len - 2 downto 0 do + values.(i) <- prev_dup cursor + done; + values end let get_all cursor k = @@ -724,64 +552,259 @@ in put_raw_key cursor ~flags:Flags.current ka v - let fold_prim init step ?cursor ~f acc map = - let fold cursor = - match init cursor with - | exception Not_found -> acc - | key, value -> - let acc = f acc key value in - let rec loop acc = - match step cursor - with - | exception Not_found -> acc - | key, value -> - let acc = f acc key value in - loop acc - in loop acc - in - trivial Ro map ?cursor fold + type ('a, 'b, 'c, 'd) state = + | Init of ('a, 'b, 'c, 'd) t + | Running of ('a, 'b, 'c, 'd) t + | Finished + + let to_dispenser_prim init step ?cursor ?txn:parent map = + let state = + match cursor with + | Some cursor -> + if cursor.map != map + then invalid_arg + "Lmdb.Cursor.fold: Got cursor for wrong map"; + ref (Init cursor) + | None -> + let txn = Mdb.txn_begin map.env parent Env.Flags.read_only in + ref (Init { cursor = Mdb.cursor_open txn map.dbi; map }) + in + let next c f = + try Some (f c) with Not_found -> + if cursor = None + then begin + let txn = Mdb.cursor_txn c.cursor in + Mdb.cursor_close c.cursor; + Mdb.txn_commit txn; + end; + state := Finished; + None + in + let dispenser () = + match !state with + | Init c -> + state := Running c; + next c init + | Running c -> next c step + | Finished -> None + in + dispenser + + (* Seq.of_dispenser only available since OCaml 4.14 *) + let seq_of_dispenser d = + let rec s () = + match d () with + | None -> Seq.Nil + | Some x -> Seq.Cons (x, s) + in s + + let to_dispenser ?cursor map = + to_dispenser_prim first next ?cursor map + let to_dispenser_rev ?cursor map = + to_dispenser_prim last prev ?cursor map + let to_dispenser_all ?cursor map = + to_dispenser_prim first_all next_all ?cursor map + let to_dispenser_rev_all ?cursor map = + to_dispenser_prim last_all prev_all ?cursor map let fold_left ?cursor ~f acc map = - fold_prim first next ?cursor ~f acc map + to_dispenser ?cursor map |> seq_of_dispenser + |> Seq.fold_left (fun a (k,v) -> f a k v) acc let fold_right ?cursor ~f map acc = - let f acc key values = f key values acc in - fold_prim last prev ?cursor ~f acc map + to_dispenser_rev ?cursor map |> seq_of_dispenser + |> Seq.fold_left (fun a (k,v) -> f k v a) acc let iter ?cursor ~f map = - fold_left ?cursor () map ~f:(fun _acc key value -> f key value) + to_dispenser ?cursor map |> seq_of_dispenser + |> Seq.iter (fun (k,v) -> f k v) let iter_rev ?cursor ~f map = - fold_right ?cursor map () ~f:(fun key value _acc -> f key value) - - let fold_prim_all init step get_all ?cursor ~f acc map = - let fold cursor = - match init cursor with - | exception Not_found -> acc - | key, first -> - let values = get_all cursor first in - let acc = f acc key values in - let rec loop acc = - match step cursor with - | exception Not_found -> acc - | key, first -> - let values = get_all cursor first in - let acc = f acc key values in - loop acc - in loop acc - in - trivial Ro ?cursor map fold + to_dispenser_rev ?cursor map |> seq_of_dispenser + |> Seq.iter (fun (k,v) -> f k v) let fold_left_all ?cursor ~f acc map = - fold_prim_all first next_nodup get_values_from_first ?cursor ~f acc map + to_dispenser_all ?cursor map |> seq_of_dispenser + |> Seq.fold_left (fun a (k,v) -> f a k v) acc let fold_right_all ?cursor ~f map acc = - let f acc key values = f key values acc in - fold_prim_all last prev_nodup get_values_from_last ?cursor ~f acc map + to_dispenser_rev_all ?cursor map |> seq_of_dispenser + |> Seq.fold_left (fun a (k,v) -> f k v a) acc let iter_all ?cursor ~f map = - fold_left_all ?cursor () map ~f:(fun () key values -> f key values) + to_dispenser_all ?cursor map |> seq_of_dispenser + |> Seq.iter (fun (k,v) -> f k v) let iter_rev_all ?cursor ~f map = - fold_right_all ?cursor map () ~f:(fun key values () -> f key values) + to_dispenser_rev_all ?cursor map |> seq_of_dispenser + |> Seq.iter (fun (k,v) -> f k v) +end + +module Map = struct + type ('k, 'v, -'dup) t = ('k, 'v, 'dup) map + + let env { env; _ } = env + + type 'a card = + | Nodup : [ `Uni ] card + | Dup : [ `Dup | `Uni ] card + + let create + (perm : 'openperm perm) + (dup : 'dup card) + ~(key : 'key Conv.t) + ~(value : 'value Conv.t) + ?(txn : 'openperm Txn.t option) + ?(name : string option) + (env : Env.t) + :('key, 'value, 'dup) t + = + let create_of_perm (type p) (perm :p perm) = + match perm with + | Ro -> Conv.Flags.none + | Rw -> Conv.Flags.create + and flags_of_dup (type dup) (dup : dup card) = + match dup with + | Nodup -> Conv.Flags.none + | Dup when name = None -> + invalid_arg "Lmdb.Map.create: The unnamed map does not support duplicates" + | Dup -> + let open Conv.Flags in + dup_sort + value.flags * (dup_fixed + integer_dup + reverse_dup) + in + let flags = + let open Conv.Flags in + create_of_perm perm + + key.flags * (reverse_key + integer_key) + flags_of_dup dup + in + let dbi, flags = + Txn.trivial perm ?txn env @@ fun txn -> + let dbi = Mdb.dbi_open txn name flags in + let flags' = Mdb.dbi_flags txn dbi in + if not Conv.Flags.(eq (unset create flags) flags') + then begin + Mdb.dbi_close env dbi; + Printf.sprintf "Lmdb.Map.create: While opening %s got flags %0#x, but expected %0#x\n" + (match name with None -> "<unnamed>" | Some name -> name) + (Conv.Flags.to_int flags') + (Conv.Flags.to_int flags) + |> invalid_arg + end; + dbi, flags + in + { env; dbi; flags; key; value } + + let create dup ~key ~value ?txn ?name env = + create Rw dup ~key ~value ?txn ?name env + and open_existing dup ~key ~value ?txn ?name env = + create Ro dup ~key ~value ?txn ?name env + + let close ({env; dbi; _} as map) = + map.dbi <- Mdb.invalid_dbi; + Mdb.dbi_close env dbi + + let stat ?txn {env; dbi; _} = + Txn.trivial Ro ?txn env @@ fun txn -> + Mdb.dbi_stat txn dbi + + let _flags ?txn {env; dbi; _} = + Txn.trivial Ro env ?txn @@ fun txn -> + Mdb.dbi_flags txn dbi + + let drop ?txn ?(delete=false) ({dbi ;env ;_ } as map) = + if delete then map.dbi <- Mdb.invalid_dbi; + Txn.trivial Rw ?txn env @@ fun txn -> + Mdb.drop txn dbi delete + + let get map ?txn k = + Txn.trivial Ro ?txn map.env @@ fun txn -> + Mdb.get txn map.dbi (map.key.serialise Bigstring.create k) + |> map.value.deserialise + + module Flags = Mdb.PutFlags + + let put_raw_key map ?txn ?(flags=Flags.none) ka v = + if Conv.Flags.(test dup_sort map.flags) + then begin + let va = map.value.serialise Bigstring.create v in + Txn.trivial Rw ?txn map.env @@ fun txn -> + Mdb.put txn map.dbi ka va flags + end + else begin + Txn.trivial Rw ?txn map.env @@ fun txn -> + let va_opt = ref Mdb.Block_option.none in + let alloc len = + if Mdb.Block_option.is_some !va_opt then + invalid_arg "Lmdb: converting function tried to allocate twice."; + let va = Mdb.put_reserve txn map.dbi ka len flags in + va_opt := Mdb.Block_option.some va; + va + in + let va = map.value.serialise alloc v in + if Mdb.Block_option.is_some !va_opt + then begin + if Mdb.Block_option.get_unsafe !va_opt != va then + invalid_arg "Lmdb: converting function allocated, but returned different buffer." + end + else Mdb.put txn map.dbi ka va flags + end + + let add map ?txn ?(flags=Flags.none) k v = + let flags = + if Conv.Flags.(test dup_sort map.flags) + then flags + else Flags.(flags + no_overwrite) + in + let ka = map.key.serialise Bigstring.create k in + put_raw_key map ?txn ~flags ka v + + let set map ?txn ?flags k v = + let ka = map.key.serialise Bigstring.create k in + if Conv.Flags.(test dup_sort map.flags) + then begin + Txn.trivial Rw ?txn map.env @@ fun txn -> + (try Mdb.del txn map.dbi ka Mdb.Block_option.none with Not_found -> ()); + put_raw_key map ~txn ?flags ka v + end + else + put_raw_key map ?txn ?flags ka v + + let remove map ?txn ?value:v k = + let key = map.key and value = map.value in + let ka = key.serialise Bigstring.create k in + let va = match v with + | None -> Mdb.Block_option.none + | Some v -> + Mdb.Block_option.some @@ value.serialise Bigstring.create v + in + Txn.trivial Rw ?txn map.env @@ fun txn -> + Mdb.del txn map.dbi ka va + + let to_dispenser ?txn map = + Cursor.(to_dispenser_prim first next) ?txn map + let to_dispenser_rev ?txn map = + Cursor.(to_dispenser_prim last prev) ?txn map + let to_dispenser_all ?txn map = + Cursor.(to_dispenser_prim first_all next_all) ?txn map + let to_dispenser_rev_all ?txn map = + Cursor.(to_dispenser_prim last_all prev_all) ?txn map + + let compare_key map ?txn x y = + let key = map.key in + let xa = key.serialise Bigstring.create x in + let ya = key.serialise Bigstring.create y in + Txn.trivial Ro ?txn map.env @@ fun txn -> + Mdb.cmp txn map.dbi xa ya + + let compare_val map ?txn = + if not Conv.Flags.(test dup_sort map.flags) then + invalid_arg "Lmdb: elements are only comparable in a dup_sort map"; + let value = map.value in + fun x y -> + let xa = value.serialise Bigstring.create x in + let ya = value.serialise Bigstring.create y in + Txn.trivial Ro ?txn map.env @@ fun txn -> + Mdb.dcmp txn map.dbi xa ya + + let compare = compare_key end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb.mli new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb.mli --- old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb.mli 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb.mli 2026-02-11 04:32:57.000000000 +0100 @@ -195,7 +195,7 @@ interface when appropriate to avoid calls to [malloc] and [memcpy]. @param deserialise - The passed {!bigstring} is only valid as long as the current transaction. + The passed {!type:bigstring} is only valid as long as the current transaction. It is therefore strongly recommended not to leak it out of [deserialise]. @param flags Flags to be set on a map using this converter. @@ -307,6 +307,9 @@ (** [env map] returns the environment of [map]. *) val env : _ t -> Env.t + + (** {2 Accessors} *) + (** [get map key] returns the first value associated to [key]. @raise Not_found if the key is not in the map. *) @@ -320,8 +323,8 @@ @param flags {!Flags} @raise Exists on maps not supporting duplicates if the key already exists. - @raise Exists if key is already bound to [value] and {! - Map.Flags.no_dup_data} was passed. + @raise Exists if key is already bound to [value] and + {!Map.Flags.no_dup_data} was passed. *) val add : ('key, 'value, _) t -> ?txn:[> `Write ] Txn.t -> ?flags:Flags.t -> 'key -> 'value -> unit @@ -346,6 +349,46 @@ ?txn:[> `Write ] Txn.t -> ?value:'value -> 'key -> unit + (** {2 Iterators} *) + + (** Dispensers / Generators are iterators meant to be used via + [Stdlib.Seq.of_dispenser] or the + {{:https://c-cube.github.io/gen/last/gen/Gen/index.html}Gen} module + + They create a read-only (child) transaction and cursor which are + automatically closed when the Dispenser is exhausted. Therefore be sure + to completely exhaust a dispenser in a timely fashion. + *) + + (** [to_dispenser map] + returns key-value pairs in order. *) + val to_dispenser : + ?txn: [> `Read ] Txn.t -> + ('key, 'value, _) t -> + (unit -> ('key * 'value) option) + + (** [to_dispenser_rev map] + returns key-value pairs in reverse order. *) + val to_dispenser_rev : + ?txn: [> `Read ] Txn.t -> + ('key, 'value, _) t -> + (unit -> ('key * 'value) option) + + (** [to_dispenser_all map] + returns keys with their associated values in order. *) + val to_dispenser_all : + ?txn: [> `Read ] Txn.t -> + ('key, 'value, [> `Dup ]) t -> + (unit -> ('key * 'value array) option) + + (** [to_dispenser_all map] + returns keys with their associated values in reverse order. *) + val to_dispenser_rev_all : + ?txn: [> `Read ] Txn.t -> + ('key, 'value, [> `Dup ]) t -> + (unit -> ('key * 'value array) option) + + (** {2 Misc} *) val stat : ?txn: [> `Read ] Txn.t -> ('key, 'value, _) t -> Mdb.stat @@ -391,14 +434,14 @@ Here is an example that returns the first 5 elements of a [map]: {[ -go ro map begin fun c -> -let h = first c in -let rec aux i = - if i < 5 then next c :: aux (i+1) - else [] -in -h :: aux 1 -end + go ro map begin fun c -> + let h = first c in + let rec aux i = + if i < 5 then next c :: aux (i+1) + else [] + in + h :: aux 1 + end ]} @param txn if omitted a transient transaction will implicitely be @@ -407,6 +450,8 @@ val go : 'perm perm -> ?txn:'perm Txn.t -> ('key, 'value, 'dup) Map.t -> (('key, 'value, 'perm, 'dup) t -> 'a) -> 'a + val txn : (_, _, 'perm, _) t -> 'perm Txn.t + (** [env txn] returns the transaction of [cursor] *) (** {2 Modification} *) @@ -583,6 +628,8 @@ (** {2 Convenient Iterators} *) + (** @deprecated Since 1.1. Use {!val:Map.to_dispenser} instead *) + (** Call [f] once for each key-value pair. Will call [f] multiple times with the same key for duplicates *) @@ -593,7 +640,7 @@ unit val iter_rev : - ?cursor:('key, 'value, [> `Read ] as 'perm, 'dup) t -> + ?cursor:('key, 'value, [> `Read ], 'dup) t -> f:('key -> 'value -> unit) -> ('key, 'value, 'dup) Map.t -> unit @@ -619,7 +666,7 @@ unit val iter_rev_all : - ?cursor:('key, 'value, [> `Read ] as 'perm, 'dup) t -> + ?cursor:('key, 'value, [> `Read ], 'dup) t -> f:('key -> 'value array -> unit) -> ('key, 'value, [> `Dup ] as 'dup) Map.t -> unit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_bindings.ml new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_bindings.ml --- old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_bindings.ml 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_bindings.ml 2026-02-11 04:32:57.000000000 +0100 @@ -216,7 +216,10 @@ external get_unsafe : 'a t -> 'a = "%identity" let is_some o = Obj.(is_block (repr o)) let is_none o = not (is_some o) - let some x = assert (is_some x); some_unsafe x + let some x = + if is_some x + then some_unsafe x + else invalid_arg "Mdb.Block_option: is no block value" let get_exn o = if is_some o then get_unsafe o @@ -279,6 +282,8 @@ let set_range = set_range (* let prev_multiple = prev_multiple - only since lmdb 0.9.19 *) end +external cursor_txn : cursor -> txn + = "mdbs_cursor_txn" external cursor_open : txn -> dbi -> cursor = "mdbs_cursor_open" external cursor_close : cursor -> unit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_bindings.mli new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_bindings.mli --- old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_bindings.mli 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_bindings.mli 2026-02-11 04:32:57.000000000 +0100 @@ -192,8 +192,8 @@ val none : 'a t external some_unsafe : 'a -> 'a t = "%identity" external get_unsafe : 'a t -> 'a = "%identity" - val is_some : 'a -> bool - val is_none : 'a -> bool + val is_some : 'a t -> bool + val is_none : 'a t -> bool val some : 'a -> 'a t val get_exn : 'a t -> 'a end @@ -254,6 +254,8 @@ val set_key : t val set_range : t end +external cursor_txn : cursor -> txn + = "mdbs_cursor_txn" external cursor_open : txn -> dbi -> cursor = "mdbs_cursor_open" external cursor_close : cursor -> unit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_stubs.c new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_stubs.c --- old/ocaml-dune-3.21.0/vendor/ocaml-lmdb/lmdb_stubs.c 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/ocaml-lmdb/lmdb_stubs.c 2026-02-11 04:32:57.000000000 +0100 @@ -17,7 +17,7 @@ #ifdef _WIN32 #include <malloc.h> -#elif defined(__FreeBSD__) +#elif defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFlyBSD__) #include <stdlib.h> #else #include <alloca.h> @@ -428,6 +428,19 @@ return hide(env); } +CAMLprim value mdbs_cursor_txn (value cursor) +{ + MDB_txn *txn; + caml_release_runtime_system(); + txn = mdb_cursor_txn(unhide(cursor)); + caml_acquire_runtime_system(); + + if (txn == NULL) + caml_invalid_argument("Lmdb.Cursor.txn: invalid cursor handle."); + + return hide(txn); +} + CAMLprim value mdbs_txn_begin (value env, value parent, value flags) { MDB_txn *cparent, *txn; @@ -585,7 +598,7 @@ CAMLprim value mdbs_cursor_get(value cursor, value keyopt, value valopt, value op) { CAMLparam2(keyopt, valopt); - CAMLlocal1(ret); + CAMLlocal3(ret, rkey, rval); MDB_val ckey, cval; void *dkey, *dval; @@ -600,17 +613,18 @@ &cval, Unsigned_int_val(op))); - ret = caml_alloc_small(2,0); - Field(ret, 0) = Val_unit; - Field(ret, 1) = Val_unit; if (ckey.mv_data == dkey && Is_block(keyopt)) - Field(ret, 0) = keyopt; + rkey = keyopt; else - Field(ret, 0) = ba_of_mvp(&ckey); + rkey = ba_of_mvp(&ckey); if (cval.mv_data == dval && Is_block(valopt)) - Field(ret, 1) = valopt; + rval = valopt; else - Field(ret, 1) = ba_of_mvp(&cval); + rval = ba_of_mvp(&cval); + + ret = caml_alloc_small(2,0); + Field(ret, 0) = rkey; + Field(ret, 1) = rval; CAMLreturn(ret); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-dune-3.21.0/vendor/update-ocaml-lmdb.sh new/ocaml-dune-3.21.1/vendor/update-ocaml-lmdb.sh --- old/ocaml-dune-3.21.0/vendor/update-ocaml-lmdb.sh 2026-01-12 19:35:07.000000000 +0100 +++ new/ocaml-dune-3.21.1/vendor/update-ocaml-lmdb.sh 2026-02-11 04:32:57.000000000 +0100 @@ -1,6 +1,6 @@ #!/bin/sh -version=2a73ea2016d6af88931d01f7b2e60800adfc2003 +version=43b466d43766bb5d75cfa05dce9efe82e4946490 lmdb_version=14d6629bc8a9fe40d8a6bee1bf71c45afe7576b6 set -e -o pipefail
