Unverified Commit 1287f061 authored by Dimitrije Radojević's avatar Dimitrije Radojević Committed by GitHub
Browse files

ocamlPackages.janestreet: 0.16 -> 0.17 (#329201)

parent 363da968
Loading
Loading
Loading
Loading
+3 −0
Original line number Diff line number Diff line
@@ -15,6 +15,9 @@ buildDunePackage rec {

  buildInputs = [ cmdliner base stdio ];

  # core v0.17 compatibility, obtained by `git diff -r 3e37827~2..3e37827`
  patches = [ ./merge-fmt.patch ];

  meta = with lib; {
    description = "Git mergetool leveraging code formatters";
    homepage = "https://github.com/hhugo/merge-fmt";
+248 −0
Original line number Diff line number Diff line
diff --git a/.ocamlformat b/.ocamlformat
index fe6ed57..3532006 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -3,4 +3,4 @@ type-decl=sparse
 break-separators=before
 if-then-else=keyword-first
 dock-collection-brackets=false
-version=0.24.1
\ No newline at end of file
+version=0.26.1
\ No newline at end of file
diff --git a/dune b/dune
index 61ec19c..9446de9 100644
--- a/dune
+++ b/dune
@@ -2,22 +2,34 @@
  (targets merge-fmt-help.txt)
  (deps ./src/merge_fmt.exe)
  (mode promote)
- (action (with-stdout-to %{targets} (run ./src/merge_fmt.exe --help=plain))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./src/merge_fmt.exe --help=plain))))
 
 (rule
  (targets merge-fmt-mergetool-help.txt)
  (deps ./src/merge_fmt.exe)
  (mode promote)
- (action (with-stdout-to %{targets} (run ./src/merge_fmt.exe mergetool --help=plain))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./src/merge_fmt.exe mergetool --help=plain))))
 
 (rule
  (targets merge-fmt-setup-mergetool-help.txt)
  (deps ./src/merge_fmt.exe)
  (mode promote)
- (action (with-stdout-to %{targets} (run ./src/merge_fmt.exe setup-mergetool --help=plain))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./src/merge_fmt.exe setup-mergetool --help=plain))))
 
 (rule
  (targets merge-fmt-setup-merge-help.txt)
  (deps ./src/merge_fmt.exe)
  (mode promote)
- (action (with-stdout-to %{targets} (run ./src/merge_fmt.exe setup-merge --help=plain))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./src/merge_fmt.exe setup-merge --help=plain))))
diff --git a/dune-project b/dune-project
index 4b39e3f..2bc4ec2 100644
--- a/dune-project
+++ b/dune-project
@@ -1,3 +1,2 @@
-(lang dune 1.6)
-(using fmt 1.0)
+(lang dune 3.0)
 (name merge-fmt)
diff --git a/merge-fmt.opam b/merge-fmt.opam
index 6827173..579f6a1 100644
--- a/merge-fmt.opam
+++ b/merge-fmt.opam
@@ -11,7 +11,7 @@ build: [["dune" "build" "-p" name "-j" jobs]]
 
 depends: [
   "ocaml" {>= "4.06.1"}
-  "dune" {>= "1.6"}
+  "dune" {>= "3.0"}
   "cmdliner" {>= "1.1.0"}
   "base"
   "stdio"
diff --git a/src/common.ml b/src/common.ml
index 3ca6809..f88bbd9 100644
--- a/src/common.ml
+++ b/src/common.ml
@@ -18,8 +18,8 @@ let open_process_in_respect_exit ~echo fmt =
       let contents = In_channel.input_all ic in
       match Unix.close_process_in ic with
       | WEXITED 0 -> contents
-      | WEXITED n -> Caml.exit n
-      | WSIGNALED _ | WSTOPPED _ -> Caml.exit 1)
+      | WEXITED n -> Stdlib.exit n
+      | WSIGNALED _ | WSTOPPED _ -> Stdlib.exit 1)
     fmt
 
 let system ~echo fmt =
@@ -35,8 +35,8 @@ let system_respect_exit ~echo fmt =
       if echo then eprintf "+ %s\n%!" s;
       match Unix.system s with
       | WEXITED 0 -> ()
-      | WEXITED n -> Caml.exit n
-      | WSIGNALED _ | WSTOPPED _ -> Caml.exit 1)
+      | WEXITED n -> Stdlib.exit n
+      | WSIGNALED _ | WSTOPPED _ -> Stdlib.exit 1)
     fmt
 
 module Flags = struct
diff --git a/src/dune b/src/dune
index 1ae55ce..1cfd576 100644
--- a/src/dune
+++ b/src/dune
@@ -1,5 +1,4 @@
 (executables
-  (names merge_fmt)
-  (public_names merge-fmt)
-  (libraries base stdio unix cmdliner)
-)
\ No newline at end of file
+ (names merge_fmt)
+ (public_names merge-fmt)
+ (libraries base stdio unix cmdliner))
diff --git a/src/fmters.ml b/src/fmters.ml
index e190f4b..43616ab 100644
--- a/src/fmters.ml
+++ b/src/fmters.ml
@@ -36,7 +36,7 @@ let dune ~bin =
 
 let find ~config ~filename ~name =
   let filename = Option.value ~default:filename name in
-  match (filename, Caml.Filename.extension filename, config) with
+  match (filename, Stdlib.Filename.extension filename, config) with
   | _, (".ml" | ".mli"), { ocamlformat_path; _ } ->
       Some (ocamlformat ~bin:ocamlformat_path ~name)
   | _, (".re" | ".rei"), { refmt_path; _ } -> Some (refmt ~bin:refmt_path)
diff --git a/src/merge_cmd.ml b/src/merge_cmd.ml
index a0fa68f..6cd5377 100644
--- a/src/merge_cmd.ml
+++ b/src/merge_cmd.ml
@@ -2,7 +2,12 @@ open Base
 open Stdio
 open Common
 
-let debug_oc = lazy (Out_channel.create ~append:true "/tmp/merge-fmt.log")
+let debug_oc =
+  lazy
+    (Out_channel.create ~append:true
+       (Stdlib.Filename.concat
+          (Stdlib.Filename.get_temp_dir_name ())
+          "merge-fmt.log"))
 
 let debug fmt =
   if true
@@ -12,7 +17,7 @@ let debug fmt =
 let merge config echo current base other output name =
   match (current, base, other) with
   | (None | Some ""), _, _ | _, (None | Some ""), _ | _, _, (None | Some "") ->
-      Caml.exit 1
+      Stdlib.exit 1
   | Some current, Some base, Some other -> (
       match Fmters.find ~config ~filename:current ~name with
       | None ->
@@ -30,7 +35,7 @@ let merge config echo current base other output name =
             |> Result.map_error ~f:(Fn.const "base")
           in
           match Result.combine_errors [ x; y; z ] with
-          | Error _ -> Caml.exit 1
+          | Error _ -> Stdlib.exit 1
           | Ok (_ : unit list) ->
               debug "process all three revision successfully\n%!";
               debug "running git merge-file\n%!";
@@ -41,7 +46,7 @@ let merge config echo current base other output name =
               (match output with
               | None -> Out_channel.output_string stdout result
               | Some o -> Out_channel.write_all o ~data:result);
-              Caml.exit 0))
+              Stdlib.exit 0))
 
 open Cmdliner
 
diff --git a/src/resolve_cmd.ml b/src/resolve_cmd.ml
index bd7f5e3..60a36a4 100644
--- a/src/resolve_cmd.ml
+++ b/src/resolve_cmd.ml
@@ -67,9 +67,9 @@ let show ~echo version versions =
 
 let create_tmp ~echo fn version versions =
   let content = show ~echo version versions in
-  let ext = Caml.Filename.extension fn in
+  let ext = Stdlib.Filename.extension fn in
   let base =
-    if String.equal ext "" then fn else Caml.Filename.chop_extension fn
+    if String.equal ext "" then fn else Stdlib.Filename.chop_extension fn
   in
   let fn' = sprintf "%s.%s%s" base (string_of_version version) ext in
   let oc = Out_channel.create fn' in
@@ -114,7 +114,7 @@ let resolve config echo () =
   if Map.is_empty all
   then (
     eprintf "Nothing to resolve\n%!";
-    Caml.exit 1);
+    Stdlib.exit 1);
   Map.iteri all ~f:(fun ~key:filename ~data:versions ->
       match versions with
       | Ok versions -> (
@@ -131,7 +131,7 @@ let resolve config echo () =
           | None -> eprintf "Ignore %s (no formatter register)\n%!" filename)
       | Error reason -> eprintf "Ignore %s (%s)\n%!" filename reason);
   let all = ls ~echo () in
-  if Map.is_empty all then Caml.exit 0 else Caml.exit 1
+  if Map.is_empty all then Stdlib.exit 0 else Stdlib.exit 1
 
 open Cmdliner
 
diff --git a/test/dune b/test/dune
index c0e4f3a..2fde0ee 100644
--- a/test/dune
+++ b/test/dune
@@ -1,17 +1,22 @@
 (library
-  (name merge_fmt_test)
-  (libraries base stdio unix core_unix core_unix.filename_unix)
-  (inline_tests)
-  (preprocessor_deps ../src/merge_fmt.exe)
-  (preprocess (pps ppx_expect)))
-
+ (name merge_fmt_test)
+ (libraries base stdio unix core_unix core_unix.filename_unix)
+ (inline_tests)
+ (preprocessor_deps ../src/merge_fmt.exe)
+ (preprocess
+  (pps ppx_expect)))
 
 ;; [rebase_a.ml] and [rebase_b.ml] should be the same expect that
 ;; [rebase_b.ml] does rebase in an intermediate revision.
+
 (rule
-  (targets rebase.diff.gen)
-  (action (with-stdout-to %{targets} (bash "diff %{dep:rebase_a.ml} %{dep:rebase_b.ml} || true"))))
+ (targets rebase.diff.gen)
+ (action
+  (with-stdout-to
+   %{targets}
+   (bash "diff %{dep:rebase_a.ml} %{dep:rebase_b.ml} || true"))))
 
-(alias
-  (name runtest)
-  (action (diff rebase.diff rebase.diff.gen)))
\ No newline at end of file
+(rule
+ (alias runtest)
+ (action
+  (diff rebase.diff rebase.diff.gen)))
+4 −8
Original line number Diff line number Diff line
@@ -16,19 +16,15 @@

buildDunePackage rec {
  pname = "bistro";
  version = "unstable-2022-05-07";

  duneVersion = "3";
  version = "unstable-2024-05-17";

  src = fetchFromGitHub {
    owner = "pveber";
    repo = pname;
    rev = "d363bd2d8257babbcb6db15bd83fd6465df7c268";
    sha256 = "0g11324j1s2631zzf7zxc8s0nqd4fwvcni0kbvfpfxg96gy2wwfm";
    rev = "d44c44b52148e58ca3842c3efedf3115e376d800";
    sha256 = "sha256-naoCEVBfydqSeGGbXYBXfg0PP+Fzk05jFoul7XAz/tM=";
  };

  patches = [ ./janestreet-0.16.patch ];

  propagatedBuildInputs = [
    base64
    bos
@@ -43,7 +39,7 @@ buildDunePackage rec {
    tyxml
  ];

  minimalOCamlVersion = "4.12";
  minimalOCamlVersion = "4.14";

  meta = {
    inherit (src.meta) homepage;
+0 −205
Original line number Diff line number Diff line
diff --git a/lib/engine/scheduler.ml b/lib/engine/scheduler.ml
index e32bd0f..93b566b 100644
--- a/lib/engine/scheduler.ml
+++ b/lib/engine/scheduler.ml
@@ -601,7 +601,7 @@ module Make(Backend : Backend) = struct
               )
         )
       | Trywith tw -> (
-          match Table.find sched.traces (Workflow.id tw.w) with
+          match Hashtbl.find sched.traces (Workflow.id tw.w) with
           | Some eventual_trace -> (
               eventual_trace >>= function
               | Ok (Run r) ->
@@ -667,10 +667,10 @@ module Make(Backend : Backend) = struct
   let register_build sched ~id ~build_trace =
     let open Eval_thread.Infix in
     (
-      match Table.find sched.traces id with
+      match Hashtbl.find sched.traces id with
       | None ->
         let trace = build_trace () in
-        Table.set sched.traces ~key:id ~data:trace ;
+        Hashtbl.set sched.traces ~key:id ~data:trace ;
         trace
       | Some trace -> trace
     ) >>= fun trace ->
@@ -854,7 +854,7 @@ module Make(Backend : Backend) = struct
         Eval_thread.join l.elts ~f:(build ?target sched)
       | Trywith tw -> (
           build sched ?target tw.w >> fun w_result ->
-          match Table.find sched.traces (Workflow.id tw.w) with
+          match Hashtbl.find sched.traces (Workflow.id tw.w) with
           | Some eventual_trace -> (
               eventual_trace >> function
               | Ok (Run r) when run_trywith_recovery r.details ->
diff --git a/lib/multinode/bistro_multinode.ml b/lib/multinode/bistro_multinode.ml
index 01dc5ac..3fc6b0e 100644
--- a/lib/multinode/bistro_multinode.ml
+++ b/lib/multinode/bistro_multinode.ml
@@ -130,7 +130,7 @@ module Server = struct
       let search (type s) (table : s String.Table.t) ~f =
         let module M = struct exception Found of string * s end in
         try
-          String.Table.fold table ~init:() ~f:(fun ~key ~data () -> if f ~key ~data then raise (M.Found (key, data))) ;
+          Hashtbl.fold table ~init:() ~f:(fun ~key ~data () -> if f ~key ~data then raise (M.Found (key, data))) ;
           None
         with M.Found (k, v) -> Some (k, v)
 
@@ -145,7 +145,7 @@ module Server = struct
               match allocation_attempt with
               | None -> Some elt
               | Some (worker_id, (Resource curr)) ->
-                String.Table.set pool.available ~key:worker_id ~data:(Resource { np = curr.np - np ; mem = curr.mem - mem }) ;
+                Hashtbl.set pool.available ~key:worker_id ~data:(Resource { np = curr.np - np ; mem = curr.mem - mem }) ;
                 Lwt.wakeup u (worker_id, Resource { np ; mem }) ;
                 None
             )
@@ -163,12 +163,12 @@ module Server = struct
         t
 
       let add_worker pool (Worker { id ; np ; mem ; _ }) =
-        match String.Table.add pool.available ~key:id ~data:(Allocator.Resource { np ; mem }) with
+        match Hashtbl.add pool.available ~key:id ~data:(Allocator.Resource { np ; mem }) with
         | `Ok -> allocation_pass pool
         | `Duplicate -> failwith "A worker has been added twice"
 
       let release pool worker_id (Allocator.Resource { np ; mem }) =
-        String.Table.update pool.available worker_id ~f:(function
+        Hashtbl.update pool.available worker_id ~f:(function
             | None -> failwith "Tried to release resources of inexistent worker"
             | Some (Resource r) -> Resource { np = r.np + np ; mem = r.mem + mem }
           )
@@ -235,13 +235,13 @@ module Server = struct
       | Subscript { np ; mem } ->
         let id = new_id () in
         let w = create_worker ~np ~mem id in
-        String.Table.set state.workers ~key:id ~data:w ;
+        Hashtbl.set state.workers ~key:id ~data:w ;
         Worker_allocator.add_worker state.alloc w ;
         log (Logger.Debug (sprintf "new worker %s" id)) ;
         Lwt.return (Client_id id)
 
       | Get_job { client_id } -> (
-          match String.Table.find state.workers client_id with
+          match Hashtbl.find state.workers client_id with
           | None -> Lwt.return None
           | Some (Worker worker) ->
             Lwt.choose [
@@ -250,22 +250,22 @@ module Server = struct
             ] >>= function
             | `Job wp ->
               let workflow_id = workflow_id_of_job_waiter wp in
-              String.Table.set worker.running_jobs ~key:workflow_id ~data:wp ;
+              Hashtbl.set worker.running_jobs ~key:workflow_id ~data:wp ;
               Lwt.return (Some (job_of_job_waiter wp))
             | `Stop -> Lwt.return None
         )
 
       | Plugin_result r ->
-        let Worker worker = String.Table.find_exn state.workers r.client_id in
+        let Worker worker = Hashtbl.find_exn state.workers r.client_id in
         Lwt.return (
-          match String.Table.find_exn worker.running_jobs r.workflow_id with
+          match Hashtbl.find_exn worker.running_jobs r.workflow_id with
           | Waiting_plugin wp -> Lwt.wakeup wp.waiter r.result
           | Waiting_shell_command _ -> assert false (* should never happen *)
         )
       | Shell_command_result r ->
-        let Worker worker = String.Table.find_exn state.workers r.client_id in
+        let Worker worker = Hashtbl.find_exn state.workers r.client_id in
         Lwt.return (
-          match String.Table.find_exn worker.running_jobs r.workflow_id with
+          match Hashtbl.find_exn worker.running_jobs r.workflow_id with
           | Waiting_plugin _ -> assert false (* should never happen *)
           | Waiting_shell_command wp -> Lwt.wakeup wp.waiter r.result
         )
@@ -307,7 +307,7 @@ module Server = struct
 
     let request_resource backend req =
       Worker_allocator.request backend.state.alloc req >|= fun (worker_id, resource) ->
-      String.Table.find_exn backend.state.workers worker_id, resource
+      Hashtbl.find_exn backend.state.workers worker_id, resource
 
     let release_resource backend worker_id res =
       Worker_allocator.release backend.state.alloc worker_id res
@@ -334,7 +334,7 @@ module Server = struct
          *   loop () *)
 
     let eval backend { worker_id ; workflow_id } f x =
-      let Worker worker = String.Table.find_exn backend.state.workers worker_id in
+      let Worker worker = Hashtbl.find_exn backend.state.workers worker_id in
       let f () = f x in
       let t, u = Lwt.wait () in
       let job_waiter = Waiting_plugin { waiter = u ; f ; workflow_id } in
@@ -342,7 +342,7 @@ module Server = struct
       t
 
     let run_shell_command backend { worker_id ; workflow_id } cmd =
-      let Worker worker = String.Table.find_exn backend.state.workers worker_id in
+      let Worker worker = Hashtbl.find_exn backend.state.workers worker_id in
       let t, u = Lwt.wait () in
       let job = Waiting_shell_command { waiter = u ; cmd ; workflow_id } in
       Lwt_queue.push worker.pending_jobs job ;
diff --git a/lib/utils/dot_output.ml b/lib/utils/dot_output.ml
index 90c299f..d13fceb 100644
--- a/lib/utils/dot_output.ml
+++ b/lib/utils/dot_output.ml
@@ -24,7 +24,7 @@ module G = struct
   (* let successors   g u = fold_succ (fun h t -> h :: t) g u [] *)
 
   let rec of_workflow_aux seen acc u =
-    if S.mem seen u then (seen, acc)
+    if Set.mem seen u then (seen, acc)
     else (
       let deps = W.Any.deps u in
       let seen, acc =
@@ -34,7 +34,7 @@ module G = struct
       in
       let acc = add_vertex acc u in
       let acc = List.fold deps ~init:acc ~f:(fun acc v -> add_edge acc u v) in
-      let seen = S.add seen u in
+      let seen = Set.add seen u in
       seen, acc
     )
 
@@ -109,7 +109,7 @@ let dot_output ?db oc g ~needed =
     ]
   in
   let vertex_attributes u =
-    let needed = (match db with None -> true | Some _ -> false) || S.mem needed u in
+    let needed = (match db with None -> true | Some _ -> false) || Set.mem needed u in
     let color = if needed then black else light_gray in
     let shape = `Shape (shape u) in
     let W.Any w = u in
@@ -141,7 +141,7 @@ let dot_output ?db oc g ~needed =
       | _ -> []
     in
     let color =
-      if (match db with None -> true | Some _ -> false) || (S.mem needed u && not (already_done u))
+      if (match db with None -> true | Some _ -> false) || (Set.mem needed u && not (already_done u))
       then black else light_gray in
     style @ [ `Color color ]
   in
diff --git a/lib/utils/repo.ml b/lib/utils/repo.ml
index 06abcd5..206a99e 100644
--- a/lib/utils/repo.ml
+++ b/lib/utils/repo.ml
@@ -160,7 +160,7 @@ let protected_set repo =
     | Select s -> fold_path_workflow acc (W.Any s.dir)
     | Input _ -> acc
     | Shell _
-    | Plugin _ -> String.Set.add acc (W.id w)
+    | Plugin _ -> Set.add acc (W.id w)
     | Trywith tw ->
       fold_path_workflow (fold_path_workflow acc (W.Any tw.w)) (W.Any tw.failsafe)
     | Ifelse ie ->
@@ -187,7 +187,7 @@ let cache_clip_fold ~bistro_dir repo ~f ~init =
   let protected = protected_set repo in
   let db = Db.init_exn bistro_dir in
   Db.fold_cache db ~init ~f:(fun acc id ->
-      f db acc (if String.Set.mem protected id then `Protected id else `Unprotected id)
+      f db acc (if Set.mem protected id then `Protected id else `Unprotected id)
     )
 
 let cache_clip_dry_run ~bistro_dir repo =
+103 −0
Original line number Diff line number Diff line
diff --git a/config/xConfigurator.ml b/config/xConfigurator.ml
index 268df4a..73e1850 100644
--- a/config/xConfigurator.ml
+++ b/config/xConfigurator.ml
@@ -8,7 +8,7 @@ let (!%) fmt = Printf.sprintf fmt
 module Configurator = struct
   include Configurator.V1
 
-  let ( ^/ ) = Caml.Filename.concat
+  let ( ^/ ) = Stdlib.Filename.concat
 
   let path_sep =
     if Sys.win32 then
@@ -19,7 +19,7 @@ module Configurator = struct
   let exe = if Sys.win32 then ".exe" else ""
 
   let get_path () =
-    match Caml.Sys.getenv "PATH" with
+    match Stdlib.Sys.getenv "PATH" with
     | exception Not_found -> []
     | s -> String.split ~on:path_sep s
 
@@ -27,7 +27,7 @@ module Configurator = struct
     List.find_map dirs ~f:(fun dir ->
       List.find_map bases ~f:(fun base ->
         let path = dir ^/ base in
-        if Caml.Sys.file_exists path then Some path else None))
+        if Stdlib.Sys.file_exists path then Some path else None))
 
   let find_program prog =
     let prog = prog ^ exe in
@@ -45,13 +45,13 @@ module Configurator = struct
     | s -> 
         (* findlib 1.7.3 installs META file for graphics 
            even when there is no graphics library installed. *)
-        let dest = Caml.Filename.temp_file "test" ".cma" in
-        let res = match Caml.Sys.command & !% "ocamlfind ocamlc -package %s -o %s -linkpkg" n dest with
+        let dest = Stdlib.Filename.temp_file "test" ".cma" in
+        let res = match Stdlib.Sys.command & !% "ocamlfind ocamlc -package %s -o %s -linkpkg" n dest with
           | 0 -> Some s
           | _ -> None
           | exception _ -> None
         in
-        (try Caml.Sys.remove dest with _ -> ());
+        (try Stdlib.Sys.remove dest with _ -> ());
         res
     | exception Findlib.No_such_package _ -> None
 
@@ -83,14 +83,14 @@ type item =
 module Make(A : sig val name : string end) = struct
   let t = create A.name
 
-  let log fmt = Caml.Format.eprintf fmt
+  let log fmt = Stdlib.Format.eprintf fmt
 
   module Package_conf = Package_conf
   open Package_conf
 
   let extract_package_conf xs =
-    Caml.List.fold_left merge empty
-      (Caml.List.map (fun item -> match item with
+    Stdlib.List.fold_left merge empty
+      (Stdlib.List.map (fun item -> match item with
            | Library (Some pkc) -> pkc
            | _ -> empty) xs)
 
@@ -167,8 +167,8 @@ module Make(A : sig val name : string end) = struct
   let by_cc ~c_flags ~link_flags ~headers ~functions:fnames () =
     log "Checking library %s by using C compiler... " (String.concat ~sep:" " link_flags);
     let headers = "stdio.h" :: headers in
-    let includes = Caml.List.map (!% "#include <%s>") headers in
-    let fcalls = Caml.List.map (!% "  ( (void(*)()) (%s) )();") fnames in
+    let includes = Stdlib.List.map (!% "#include <%s>") headers in
+    let fcalls = Stdlib.List.map (!% "  ( (void(*)()) (%s) )();") fnames in
     let code = 
       String.concat ~sep:"\n" 
       & includes 
diff --git a/core/images.ml b/core/images.ml
index 563ab7e..a53a6a4 100644
--- a/core/images.ml
+++ b/core/images.ml
@@ -102,7 +102,7 @@ let get_extension s =
   | _ -> s, ""
 
 let guess_extension s =
-  let s = String.lowercase s in
+  let s = String.lowercase_ascii s in
   match s with
   | "gif" -> Gif
   | "bmp" -> Bmp
diff --git a/core/units.ml b/core/units.ml
index 634bc9c..ddd6eae 100644
--- a/core/units.ml
+++ b/core/units.ml
@@ -30,7 +30,7 @@ let parse_length s = (* return in pt *)
     let digit,unit =
       if l > 2 then String.sub s 0 2, String.sub s (l-2) 2 else "", "" in
     try
-      (List.assoc (String.lowercase unit) units) *. float_of_string digit
+      (List.assoc (String.lowercase_ascii unit) units) *. float_of_string digit
     with
     | Not_found -> (* think it is in "pt" *)
       float_of_string s in
Loading