add some more util testing, hopefully fixes #284

ocaml_typing/402/untypeast.mli

@@ -10,6 +10,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+val untype_structure_item : Typedtree.structure_item -> Parsetree.structure_item
+val untype_signature_item : Typedtree.signature_item -> Parsetree.signature_item
 val untype_structure : Typedtree.structure -> Parsetree.structure
 val untype_signature : Typedtree.signature -> Parsetree.signature
 val untype_expression : Typedtree.expression -> Parsetree.expression

process_ocaml/402/Process_402.re

@@ -50,6 +50,50 @@ let astForCmt = cmt => {
     Ok(`Interface(Convert.copy_signature(signature)))
     /* Printast.interface(Stdlib.Format.str_formatter, signature);
     Ok(Format.flush_str_formatter()); */
+  | Partial_implementation(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_structure(str) => Some(str.str_items)
+            | Partial_structure_item(str) => Some([str])
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Implementation(
+        Convert.copy_structure(Obj.magic(List.map(
+          item => Untypeast.untype_structure_item(item),
+          items,
+        ))),
+      ),
+    );
+  | Partial_interface(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_signature(str) => Some(str.sig_items)
+            | Partial_signature_item(str) => Some([str])
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Interface(
+        Convert.copy_signature(Obj.magic(List.map(
+          item => Untypeast.untype_signature_item(item),
+          items,
+        ))),
+      ),
+    );
   | _ => Error("Not a well-typed implementation")
   }
 };

process_ocaml/406/Process_406.re

@@ -50,6 +50,53 @@ let astForCmt = cmt => {
     Ok(`Interface(Convert.copy_signature(Obj.magic(Untypeast.untype_signature(signature)))))
     /* Printast.interface(Stdlib.Format.str_formatter, Untypeast.untype_signature(signature));
     Ok(Format.flush_str_formatter()); */
+
+  | Partial_implementation(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_structure(str) => Some(str.str_items)
+            | Partial_structure_item(str) => Some([str])
+            /* | Partial_expression(exp) => Some([ str]) */
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Implementation(
+        Convert.copy_structure(Obj.magic(List.map(
+          item => Untypeast.default_mapper.structure_item(Untypeast.default_mapper, item),
+          items,
+        ))),
+      ),
+    );
+  | Partial_interface(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_signature(str) => Some(str.sig_items)
+            | Partial_signature_item(str) => Some([str])
+            /* | Partial_expression(exp) => Some([ str]) */
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Interface(
+        Convert.copy_signature(Obj.magic(List.map(
+          item => Untypeast.default_mapper.signature_item(Untypeast.default_mapper, item),
+          items,
+        ))),
+      ),
+    );
   | _ => Error("Not a well-typed implementation")
   }
 };

process_ocaml/407/Process_407.re

@@ -1,4 +1,3 @@
-
 open SharedTypes;
 open Belt.Result;
 
@@ -9,44 +8,87 @@ let fileForCmi = (~moduleName, cmi, uri, processDoc) => {
 
 let fileForCmt = (~moduleName, cmt, uri, processDoc) => {
   let%try infos = Shared.tryReadCmt(cmt);
-  ProcessCmt.forCmt(~moduleName, uri, processDoc, infos)
+  ProcessCmt.forCmt(~moduleName, uri, processDoc, infos);
 };
 
 let fullForCmt = (~moduleName, ~allLocations, cmt, uri, processDoc) => {
   let%try infos = Shared.tryReadCmt(cmt);
   let%try file = ProcessCmt.forCmt(~moduleName, uri, processDoc, infos);
   let%try_wrap extra = ProcessExtra.forCmt(~file, ~allLocations, infos);
-  {file, extra}
+  {file, extra};
 };
 
 /* let sourceForCmt = cmt => {
-  let%try infos = Shared.tryReadCmt(cmt);
-  switch (infos.cmt_annots) {
-  | Implementation(structure) => {
-    Pprintast.structure(Stdlib.Format.str_formatter, Untypeast.untype_structure(structure));
-    Ok(Format.flush_str_formatter());
-  }
-  | Interface(signature) =>
-    Pprintast.signature(Stdlib.Format.str_formatter, Untypeast.untype_signature(signature));
-    Ok(Format.flush_str_formatter());
-  | _ => Error("Cannot show ppxed source for files with type errors at the moment")
-  }
-}; */
+     let%try infos = Shared.tryReadCmt(cmt);
+     switch (infos.cmt_annots) {
+     | Implementation(structure) => {
+       Pprintast.structure(Stdlib.Format.str_formatter, Untypeast.untype_structure(structure));
+       Ok(Format.flush_str_formatter());
+     }
+     | Interface(signature) =>
+       Pprintast.signature(Stdlib.Format.str_formatter, Untypeast.untype_signature(signature));
+       Ok(Format.flush_str_formatter());
+     | _ => Error("Cannot show ppxed source for files with type errors at the moment")
+     }
+   }; */
 
 let astForCmt = cmt => {
   let%try infos = Shared.tryReadCmt(cmt);
   switch (infos.cmt_annots) {
-  | Implementation(structure) => {
-    Ok(`Implementation(Untypeast.untype_structure(structure)))
-    /* Printast.implementation(Stdlib.Format.str_formatter, );
-    Ok(Format.flush_str_formatter()); */
-  }
-  | Interface(signature) =>
-    Ok(`Interface(Untypeast.untype_signature(signature)))
-    /* Printast.interface(Stdlib.Format.str_formatter, Untypeast.untype_signature(signature));
-    Ok(Format.flush_str_formatter()); */
-  | _ => Error("Cannot show ppxed source for files with type errors at the moment")
-  }
+  | Implementation(structure) =>
+    Ok
+      (`Implementation(Untypeast.untype_structure(structure)))
+  | Interface(signature) => Ok(`Interface(Untypeast.untype_signature(signature)))
+
+  | Partial_implementation(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_structure(str) => Some(str.str_items)
+            | Partial_structure_item(str) => Some([str])
+            /* | Partial_expression(exp) => Some([ str]) */
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Implementation(
+        List.map(
+          item => Untypeast.default_mapper.structure_item(Untypeast.default_mapper, item),
+          items,
+        ),
+      ),
+    );
+  | Partial_interface(parts) =>
+    let items =
+      parts
+      ->Array.to_list
+      ->(
+          Belt.List.keepMap(p =>
+            switch (p) {
+            | Partial_signature(str) => Some(str.sig_items)
+            | Partial_signature_item(str) => Some([str])
+            /* | Partial_expression(exp) => Some([ str]) */
+            | _ => None
+            }
+          )
+        )
+      |> List.concat;
+    Ok(
+      `Interface(
+        List.map(
+          item => Untypeast.default_mapper.signature_item(Untypeast.default_mapper, item),
+          items,
+        ),
+      ),
+    );
+
+  | _ => Error("Cannot show ppxed source for packed cmt")
+  };
 };
 
-module PrintType = PrintType
+module PrintType = PrintType;

util/Files.re

@@ -14,18 +14,15 @@ let absify = path => {
 let removeExtraDots = path => Str.global_replace(Str.regexp_string("/./"), "/", path)
 |> Str.global_replace(Str.regexp({|^\./\.\./|}), "../");
 
-let startsWith = (text, prefix) => String.length(prefix) <= String.length(text)
-  && String.sub(text, 0, String.length(prefix)) == prefix;
+// Win32 & MacOS are case-insensitive
+let pathEq = Sys.os_type == "Linux" ? (a, b) => a == b : (a, b) => String.lowercase_ascii(a) == String.lowercase_ascii(b);
+
+let pathStartsWith = (text, prefix) => String.length(prefix) <= String.length(text)
+  && pathEq(String.sub(text, 0, String.length(prefix)), prefix);
 let sliceToEnd = (str, pos) => String.sub(str, pos, String.length(str) - pos);
 
-[@test [
-  (("/a/b/c", "/a/b/d"), "../d"),
-  (("/a/b/c", "/a/b/d/e"), "../d/e"),
-  (("/a/b/c", "/d/e/f"), "../../../d/e/f"),
-  (("/a/b/c", "/a/b/c/d/e"), "./d/e"),
-]]
 let relpath = (base, path) => {
-  if (startsWith(path, base)) {
+  if (pathStartsWith(path, base)) {
     let baselen = String.length(base);
     let rest = String.sub(path, baselen, String.length(path) - baselen);
     if (rest == "") {
@@ -46,7 +43,7 @@ let relpath = (base, path) => {
       switch (bp, pp) {
       | ([".", ...ra], _) => loop(ra, pp)
       | (_, [".", ...rb]) => loop(bp, rb)
-      | ([a, ...ra], [b, ...rb]) when a == b => loop(ra, rb)
+      | ([a, ...ra], [b, ...rb]) when pathEq(a, b) => loop(ra, rb)
       | _ => (bp, pp)
       }
     };

util_tests/UtilTests.re

@@ -1,4 +1,13 @@
 
+type test =
+  | Single(string, unit => option(string))
+  | Multiple(string, 'a => option(string), list('a)) : test;
+
+let tests = ref([]);
+let addTest = test => tests := [test, ...tests^];
+let single = (name, fn) => addTest(Single(name, fn));
+let multiple = (name, fn, items) => addTest(Multiple(name, fn, items));
+
 let duneFile = {|
 (library
    ; !!!! This dune file is generated from the package.json file. Do NOT modify by hand.
@@ -12,11 +21,76 @@ let duneFile = {|
    )
 |};
 
-try (Util.JbuildFile.parse(duneFile)) {
-  | Failure(message) => {
-    print_endline("Unable to parse dune file: " ++ message);
-    exit(10)
+single("DuneFile", () => {
+  switch (Util.JbuildFile.parse(duneFile)) {
+    | exception Failure(message) => {
+      Some("Unable to parse dune file: " ++ message)
+    }
+    | _ => None
+  };
+})
+
+let relpathFixtures = [
+  (("/a/b/c", "/a/b/d"), "../d"),
+  (("/a/b/c", "/a/b/d/e"), "../d/e"),
+  (("/a/b/c", "/d/e/f"), "../../../d/e/f"),
+  (("/a/b/c", "/a/b/c/d/e"), "./d/e"),
+
+  (("C:/a/b/c", "C:/a/b/d"), "../d"),
+  (("C:/a/b/c", "C:/a/b/d/e"), "../d/e"),
+  (("C:/a/b/c", "C:/d/e/f"), "../../../d/e/f"),
+  (("C:/a/b/c", "C:/a/b/c/d/e"), "./d/e"),
+];
+
+let caseInsensitiveFixtures = [
+  (("/a/B/c", "/a/b/C/d/e"), "./d/e"),
+
+  /* windows paths are case insensitive */
+  (("C:/a/b/c", "c:/a/B/d"), "../d"),
+  (("C:/a/b/c", "c:/a/B/d/e"), "../d/e"),
+  (("C:/a/b/c", "c:/D/e/f"), "../../../D/e/f"),
+  (("C:/a/b/c", "c:/a/b/C/d/e"), "./d/e"),
+];
+
+// Linux is case sensitive
+let relpathFixtures = Sys.os_type == "Linux" ? relpathFixtures : relpathFixtures @ caseInsensitiveFixtures;
+
+multiple("relpath", (((base, path), expected)) => {
+  let output = Util.Files.relpath(base, path);
+  if (output == expected) {
+    None
+  } else {
+    Some(Printf.sprintf("%s + %s => %s :: expected %s", base, path, output, expected))
+  }
+}, relpathFixtures);
+
+let (failures, total) = tests^ |> List.fold_left(((failures, total), test) => {
+  switch test {
+    | Single(name, fn) => 
+    let (res, message) = switch (fn()) {
+      | None => ((failures, total + 1), "✔️")
+      | Some(message) => ((failures + 1, total + 1), "❌   " ++ message)
+    };
+    print_endline(name ++ " :: " ++ message);
+    res
+    | Multiple(name, fn, items) =>
+      let (f2, t2) = items |> List.fold_left(((failures, total), item) => {
+        let (res, message) = switch (fn(item)) {
+          | None => ((failures, total + 1), "✔️")
+          | Some(message) => ((failures + 1, total + 1), "❌   " ++ message)
+        };
+        Printf.printf("%s (%2d) :: %s\n", name, total, message);
+        res
+      }, (0, 0));
+      (f2 + failures, t2 + total)
   }
-};
-print_endline("Success");
-exit(0)
+}, (0, 0));
+
+if (failures == 0) {
+  Printf.printf("✅ All tests passed! %d/%d\n", total, total);
+  exit(0)
+} else {
+  Printf.printf("❌ Failures: %d/%d\n", failures, total);
+  exit(0)
+
+}