implement native for windows

Author: kentookura

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/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;
+]