implement native for windows

dune-project

@@ -58,6 +58,7 @@
   (eio (= :version))
   (fmt (>= 0.8.9))
   (kcas (and (>= 0.3.0) :with-test))
+  (mdx (and (>= 2.4.1) :with-test))
   (alcotest (and (>= 1.7.0) :with-test))))
 (package
  (name eio_main)

eio_windows.opam

@@ -13,6 +13,7 @@ depends: [
   "eio" {= version}
   "fmt" {>= "0.8.9"}
   "kcas" {>= "0.3.0" & with-test}
+  "mdx" {>= "2.4.1" & with-test}
   "alcotest" {>= "1.7.0" & with-test}
   "odoc" {with-doc}
 ]

lib_eio_windows/fs.ml

@@ -187,8 +187,20 @@ end = struct
 
   let pp f t = Fmt.string f (String.escaped t.label)
 
-  let native _t _path =
-    failwith "TODO: Windows native"
+  let native_internal t path =
+    if Filename.is_relative path then (
+      let p =
+        if t.dir_path = "." then path
+        else Filename.concat t.dir_path path
+      in
+      if p = "" then "."
+      else if p = "." then p
+      else if Filename.is_implicit p then ".\\" ^ p
+      else p
+    ) else path
+
+  let native t path =
+    Some (native_internal t path)
 end
 and Handler : sig
   val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler

lib_eio_windows/test/dune

@@ -1,3 +1,8 @@
+(mdx
+  (package eio_windows)
+  (enabled_if (= %{os_type} "Win32"))
+  (deps (package eio_windows)))
+
 (test
   (name test)
   (package eio_windows)

lib_eio_windows/test/test_fs.ml

@@ -264,6 +264,34 @@ let test_remove_dir env () =
   in
   ()
 
+let test_native env () =
+  let cwd = Sys.getcwd () ^ "\\" in
+  let test x =
+    let native = Eio.Path.native x in
+    let result =
+      native |> Option.map @@ fun native ->
+      if String.starts_with ~prefix:cwd native then
+        ".\\" ^ String.sub native (String.length cwd) (String.length native - String.length cwd)
+      else native
+    in
+    traceln "%a -> %a" Eio.Path.pp x Fmt.(Dump.option string) result
+  in
+  test env#fs;
+  test (env#fs / "\\");
+  test (env#fs / "\\etc\\hosts");
+  test (env#fs / ".");
+  test (env#fs / "foo\\bar");
+  test env#cwd;
+  test (env#cwd / "..");
+  let sub = env#cwd / "native-sub" in
+  Eio.Path.mkdir sub ~perm:0o700;
+  Eio.Path.with_open_dir sub @@ fun sub ->
+  test sub;
+  test (sub / "foo.txt");
+  test (sub / ".");
+  test (sub / "..");
+  test (sub / "\\etc\\passwd")
+
 let tests env = [
   "create-write-read", `Quick, test_create_and_read env;
   "cwd-abs-path", `Quick, test_cwd_no_access_abs env;
@@ -277,4 +305,5 @@ let tests env = [
   "unlink", `Quick, test_unlink env;
   "failing-unlink", `Quick, try_failing_unlink env;
   "rmdir", `Quick, test_remove_dir env;
-]
+  "native", `Quick, test_native env;
+]