Merge pull request #117 from mspwn/fix-path-relocate-when-partial-common-prefix

Fix path relocate when partial common prefix

Author: xhtmlboi

CHANGES.md

@@ -2,6 +2,7 @@
 
 #### Yocaml
 
+- Fix `Path.relocate` (by [mspwn](https://github.com/mspwn))
 - Add `Data.Validation.req` and `Data.Validation.opt` for compact validation and alternative name (by [xhtmlboi](https://github.com/xhtmlboi))
 - Add `Data.Validation.where_opt` (and `String`, `Int` and `Float` version) (by [xvw](https://xvw.lol))
 - Improve pretty-printing of validation errors (by [Linda-Njau](https://github.com/Linda-Njau))

lib/core/path.ml

@@ -148,8 +148,8 @@ let move ~into source =
   match basename source with None -> into | Some x -> append into [ x ]
 
 let remove_common_prefix into source =
-  let rec aux acc into source =
-    match (into, source) with
+  let rec aux acc s_into s_source =
+    match (s_into, s_source) with
     | [ x ], y :: xs when String.equal x y -> List.rev_append acc (x :: xs)
     | x :: xs, y :: ys when String.equal x y -> aux (x :: acc) xs ys
     | _ -> into @ source

test/yocaml/path_test.ml

@@ -332,7 +332,7 @@ let test_relocate4 =
 
 let test_relocate5 =
   let open Alcotest in
-  test_case "relocate when common suffixes 1" `Quick (fun () ->
+  test_case "relocate when common prefixes 1" `Quick (fun () ->
       let open Yocaml.Path in
       let expected = rel [ "foo"; "bar"; "index.html" ]
       and computed =
@@ -344,7 +344,7 @@ let test_relocate5 =
 
 let test_relocate6 =
   let open Alcotest in
-  test_case "relocate when common suffixes 2" `Quick (fun () ->
+  test_case "relocate when common prefixes 2" `Quick (fun () ->
       let open Yocaml.Path in
       let expected = rel [ "foo"; "bar"; "baz"; "index.html" ]
       and computed =
@@ -354,6 +354,18 @@ let test_relocate6 =
       in
       check Testable.path "should be equal" expected computed)
 
+let test_relocate7 =
+  let open Alcotest in
+  test_case "relocate when partial common prefixes" `Quick (fun () ->
+      let open Yocaml.Path in
+      let expected = rel [ "foo"; "bar"; "foo"; "baz"; "index.html" ]
+      and computed =
+        relocate
+          ~into:(rel [ "foo"; "bar" ])
+          (rel [ "foo"; "baz"; "index.html" ])
+      in
+      check Testable.path "should be equal" expected computed)
+
 let test_from_string1 =
   let open Alcotest in
   test_case "from_string 1" `Quick (fun () ->
@@ -435,6 +447,7 @@ let cases =
     ; test_relocate4
     ; test_relocate5
     ; test_relocate6
+    ; test_relocate7
     ; test_from_string1
     ; test_from_string2
     ; test_from_string3