fs_fake: implement rename

CHANGES.md

@@ -2,6 +2,7 @@
 
 ## Features/Changes
 * Compiler: exit-loop-early in more cases (#2077)
+* Runtime: support rename in fake filesystem (#2080)
 
 # 6.1.1 (2025-07-07) - Lille
 

compiler/tests-compiler/sys_fs.ml

@@ -19,7 +19,7 @@
 
 open Util
 
-let%expect_test _ =
+let%expect_test "readdir fails on non-existing directory and existing files" =
   compile_and_run
     {|
 let f () =
@@ -31,15 +31,19 @@ let f () =
   | e -> print_endline (Printexc.to_string e));
   (try ignore(Sys.readdir "aaa/bbb") with
   | Sys_error _ -> ()
-  | e -> print_endline (Printexc.to_string e));
+     | e -> print_endline (Printexc.to_string e));
+  Array.iter print_endline (Sys.readdir "aaa");
   Sys.remove "aaa/bbb";
   Sys.rmdir "aaa"
 in
 f (); Sys.chdir "/static"; f ()
   |};
-  [%expect {| |}]
+  [%expect {|
+    bbb
+    bbb
+    |}]
 
-let%expect_test _ =
+let%expect_test "rmdir work on empty directory only" =
   compile_and_run
     {|
 let f () =
@@ -48,7 +52,7 @@ let f () =
   let l = Sys.readdir "aaa" |> Array.to_list in
   List.iter print_endline l;
   (match Sys.rmdir "aaa" with
-  | exception _ -> ()
+  | exception _ -> print_endline "EXPECTED ERROR"
   | _ -> print_endline "BUG");
   Sys.rmdir "aaa/bbb";
   Sys.rmdir "aaa"
@@ -57,24 +61,217 @@ f (); Sys.chdir "/static"; f ()
   |};
   [%expect {|
     bbb
-    bbb|}]
+    EXPECTED ERROR
+    bbb
+    EXPECTED ERROR
+    |}]
 
-let%expect_test _ =
+let%expect_test "Rename a directory" =
   compile_and_run
     {|
-  (match Sys.mkdir "/not/exists" 0o777 with
+let f () =
+  Sys.mkdir "aaa" 0o777;
+  Sys.mkdir "aaa/bbb" 0o777;
+  Sys.mkdir "aaa/bbb/ccc" 0o777;
+  let oc = open_out "aaa/bbb/ccc/ddd" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  Sys.rename "aaa/bbb" "aaa/bbb2";
+  let ic = open_in "aaa/bbb2/ccc/ddd" in
+  let line = input_line ic in
+  close_in ic;
+  Printf.printf "new file contents: %s\n%!" line;
+  Sys.remove "aaa/bbb2/ccc/ddd";
+  Sys.rmdir "aaa/bbb2/ccc";
+  Sys.rmdir "aaa/bbb2";
+  Sys.rmdir "aaa"
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect
+    {|
+    new file contents: Hello world
+    new file contents: Hello world
+    |}]
+
+let%expect_test "Rename a directory over another (empty) directory" =
+  compile_and_run
+    {|
+let f () =
+  Sys.mkdir "aaa" 0o777;
+  Sys.mkdir "aaa/bbb" 0o777;
+  Sys.mkdir "aaa/bbb/ccc" 0o777;
+  let oc = open_out "aaa/bbb/ccc/ddd" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  Sys.mkdir "aaa/bbb2" 0o777;
+  Sys.rename "aaa/bbb" "aaa/bbb2";
+  let ic = open_in "aaa/bbb2/ccc/ddd" in
+  let line = input_line ic in
+  close_in ic;
+  Printf.printf "new file contents: %s\n%!" line;
+  Sys.remove "aaa/bbb2/ccc/ddd";
+  Sys.rmdir "aaa/bbb2/ccc";
+  Sys.rmdir "aaa/bbb2";
+  Sys.rmdir "aaa"
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect
+    {|
+    new file contents: Hello world
+    new file contents: Hello world
+    |}]
+
+let%expect_test "Can't rename a directory over another non-empty directory" =
+  compile_and_run
+    {|
+let f () =
+  Sys.mkdir "aaa" 0o777;
+  Sys.mkdir "aaa/bbb" 0o777;
+  Sys.mkdir "aaa/bbb/ccc" 0o777;
+  let oc = open_out "aaa/bbb/ccc/ddd" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  Sys.mkdir "aaa/bbb2" 0o777;
+  let oc = open_out "aaa/bbb2/ccc" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  (match Sys.rename "aaa/bbb" "aaa/bbb2" with
+  | exception Sys_error _ -> print_endline "EXPECTED ERROR"
+  | _ -> failwith "BUG: rename should have failed");
+  Sys.remove "aaa/bbb/ccc/ddd";
+  Sys.rmdir "aaa/bbb/ccc";
+  Sys.rmdir "aaa/bbb";
+  Sys.remove "aaa/bbb2/ccc";
+  Sys.rmdir "aaa/bbb2";
+  Sys.rmdir "aaa"
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect {|
+    EXPECTED ERROR
+    EXPECTED ERROR
+    |}]
+
+let%expect_test "Rename a file to a pre-existing file" =
+  compile_and_run
+    {|
+let f () =
+  let mk f content =
+    let oc = open_out f in
+    Printf.fprintf oc "%s\n" content;
+    close_out oc
+  in
+  mk "aaa" "aaa";
+  mk "bbb" "bbb";
+  Sys.rename "aaa" "bbb";
+  let ic = open_in "bbb" in
+  let line = input_line ic in
+  close_in ic;
+  Printf.printf "contents of 'bbb': %s\n%!" line;
+  Sys.remove "bbb";
+  (match Sys.remove "aaa" with
+  | exception _ -> print_endline "EXPECTED ERROR"
+  | _ -> print_endline "BUG")
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect
+    {|
+    contents of 'bbb': aaa
+    EXPECTED ERROR
+    contents of 'bbb': aaa
+    EXPECTED ERROR
+    |}]
+
+let%expect_test "Can't rename a directory over a file" =
+  compile_and_run
+    {|
+let f () =
+  Sys.mkdir "aaa" 0o777;
+  Sys.mkdir "aaa/bbb" 0o777;
+  Sys.mkdir "aaa/bbb/ccc" 0o777;
+  let oc = open_out "aaa/bbb/ccc/ddd" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  let oc = open_out "aaa/bbb2" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  (match Sys.rename "aaa/bbb" "aaa/bbb2"
+   with
+   | () -> failwith "BUG: rename should have failed"
+   | exception Sys_error _ -> print_endline "EXPECTED ERROR");
+  Sys.remove "aaa/bbb/ccc/ddd";
+  Sys.rmdir "aaa/bbb/ccc";
+  Sys.rmdir "aaa/bbb";
+  Sys.remove "aaa/bbb2";
+  Sys.rmdir "aaa"
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect {|
+    EXPECTED ERROR
+    EXPECTED ERROR
+    |}]
+
+let%expect_test "Can't rename a file over a directory" =
+  compile_and_run
+    {|
+let f () =
+  Sys.mkdir "aaa" 0o777;
+  Sys.mkdir "aaa/bbb" 0o777;
+  Sys.mkdir "aaa/bbb/ccc" 0o777;
+  let oc = open_out "aaa/bbb/ccc/ddd" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  let oc = open_out "aaa/bbb2" in
+  Printf.fprintf oc "Hello world\n";
+  close_out oc;
+  (match Sys.rename "aaa/bbb2" "aaa/bbb" with
+   | exception Sys_error _ -> print_endline "EXPECTED ERROR"
+   | _ -> failwith "BUG: rename should have failed");
+  Sys.remove "aaa/bbb/ccc/ddd";
+  Sys.rmdir "aaa/bbb/ccc";
+  Sys.rmdir "aaa/bbb";
+  Sys.remove "aaa/bbb2";
+  Sys.rmdir "aaa"
+in
+f (); Sys.chdir "/static"; f ()
+  |};
+  [%expect {|
+    EXPECTED ERROR
+    EXPECTED ERROR
+    |}]
+
+let%expect_test "mkdir in non-existing directory" =
+  compile_and_run
+    {|
+let f () =
+  (match Sys.mkdir "not/exists" 0o777 with
   | exception Sys_error path -> print_endline "EXPECTED ERROR"
   | exception err -> print_endline (Printexc.to_string err)
-  | _ -> print_endline "BUG");
+  | _ -> print_endline "BUG")
+in
+f (); Sys.chdir "/static"; f ()
   |};
-  [%expect {|EXPECTED ERROR|}]
+  [%expect {|
+    EXPECTED ERROR
+    EXPECTED ERROR
+    |}]
 
-let%expect_test _ =
+let%expect_test "rmdir non-existing directory" =
   compile_and_run
     {|
-  (match Sys.rmdir "/not/exists" with
+let f () =
+  (match Sys.rmdir "not/exists" with
   | exception Sys_error path -> print_endline "EXPECTED ERROR"
   | exception err -> print_endline (Printexc.to_string err)
-  | _ -> print_endline "BUG");
+  | _ -> print_endline "BUG")
+in
+f (); Sys.chdir "/static"; f ()
   |};
-  [%expect {|EXPECTED ERROR|}]
+  [%expect {|
+    EXPECTED ERROR
+    EXPECTED ERROR
+    |}]

runtime/js/fs_fake.js

@@ -81,6 +81,42 @@ class MlFakeDevice {
     }
   }
 
+  rename_dir(oldname, newname) {
+    if (this.exists(newname)) {
+      if (!this.is_dir(newname)) {
+        caml_raise_sys_error(
+          this.nm(newname) + " : file already exists and is not a directory",
+        );
+      }
+      if (this.readdir(newname).length > 0) {
+        caml_raise_sys_error(this.nm(newname) + " : directory not empty");
+      }
+    }
+    var old_slash = this.slash(oldname);
+    var new_slash = this.slash(newname);
+    this.create_dir_if_needed(new_slash);
+    for (const f of this.readdir(oldname)) {
+      this.rename(old_slash + f, new_slash + f);
+    }
+    delete this.content[old_slash];
+  }
+
+  rename(oldname, newname) {
+    if (!this.exists(oldname))
+      caml_raise_sys_error(this.nm(oldname) + " : no such file or directory");
+    if (this.is_dir(oldname)) {
+      this.rename_dir(oldname, newname);
+    } else {
+      if (this.exists(newname) && this.is_dir(newname)) {
+        caml_raise_sys_error(
+          this.nm(newname) + " : file already exists and is a directory",
+        );
+      }
+      this.content[newname] = this.content[oldname];
+      delete this.content[oldname];
+    }
+  }
+
   mkdir(name, _mode, raise_unix) {
     if (this.exists(name))
       caml_raise_system_error(