Fix GenType path resolution for Windows short paths and POSIX symlinks

changes/gentype-windows-paths.fix.md

@@ -0,0 +1 @@
+- Fix GenType path resolution for Windows short paths and POSIX symlinked project paths, and prevent traversal from hanging at a filesystem root. https://github.com/rescript-lang/rescript/pull/8639

compiler/gentype/module_resolver.ml

@@ -109,6 +109,12 @@ let create_lazy_resolver ~config ~extensions ~exclude_file =
 let apply ~resolver ~use_bs_dependencies module_name =
   module_name |> Lazy.force resolver.lazy_find ~use_bs_dependencies
 
+let rec path_to_list path =
+  let parent = Filename.dirname path in
+  (* On Windows, the basename of a drive root omits the drive prefix. *)
+  if Filename.basename path = path || parent = path then [path]
+  else (path |> Filename.basename) :: path_to_list parent
+
 (** Resolve a reference to ModuleName, and produce a path suitable for require.
    E.g. require "../foo/bar/ModuleName.ext" where ext is ".res" or ".js". *)
 let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative
@@ -132,13 +138,6 @@ let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative
   in
   if Sys.file_exists module_name_res_file then candidate
   else
-    let rec path_to_list path =
-      let is_root = path |> Filename.basename = path in
-      match is_root with
-      | true -> [path]
-      | false ->
-        (path |> Filename.basename) :: (path |> Filename.dirname |> path_to_list)
-    in
     match module_name |> apply ~resolver ~use_bs_dependencies with
     | None -> candidate
     | Some (resolved_module_dir, case, bs_dependencies) ->

rewatch/src/build.rs

@@ -134,6 +134,7 @@ pub fn get_compiler_args(rescript_file_path: &Path) -> Result<String> {
     };
     let compiler_args = compile::compiler_args(
         &project_context.current_config,
+        &current_package,
         &ast_path,
         relative_filename,
         is_interface,

rewatch/src/build/compile.rs

@@ -751,6 +751,9 @@ pub fn get_runtime_path_args(
 
 pub fn compiler_args(
     config: &config::Config,
+    // Match the parser's root spelling: canonical during builds, caller-supplied
+    // for compiler-args consumers such as editor incremental type checking.
+    project_root: &Path,
     ast_path: &Path,
     file_path: &Path,
     is_interface: bool,
@@ -833,7 +836,10 @@ pub fn compiler_args(
     };
 
     let package_name_arg = vec!["-bs-package-name".to_string(), config.name.to_owned()];
-    let project_root_args = config.get_project_root_args();
+    let project_root_args = vec![
+        "-bs-project-root".to_string(),
+        project_root.to_string_lossy().to_string(),
+    ];
 
     let implementation_args = if is_interface {
         debug!("Compiling interface file: {}", &module_name);
@@ -1022,6 +1028,7 @@ fn compile_file(
     let current_package_dirs: &[PathBuf] = package.gentype_dirs.as_deref().unwrap_or(&[]);
     let to_mjs_args = compiler_args(
         &package.config,
+        &package.path,
         ast_path,
         implementation_file_path,
         is_interface,

rewatch/src/config.rs

@@ -1009,20 +1009,6 @@ impl Config {
         args
     }
 
-    /// Directory containing the `rescript.json` this config was parsed from.
-    fn get_package_root(&self) -> &Path {
-        self.path
-            .parent()
-            .expect("rescript.json path should always have a parent directory")
-    }
-
-    pub fn get_project_root_args(&self) -> Vec<String> {
-        vec![
-            "-bs-project-root".to_string(),
-            self.get_package_root().to_string_lossy().to_string(),
-        ]
-    }
-
     pub fn get_warning_args(&self, is_local_dep: bool, warn_error_override: Option<String>) -> Vec<String> {
         // Ignore warning config for non local dependencies (node_module dependencies)
         if !is_local_dep {

rewatch/tests/gentype/01-gentype-project-root.sh

@@ -0,0 +1,8 @@
+#!/bin/bash
+set -euo pipefail
+cd "$(dirname "$0")"
+source "../utils.sh"
+
+bold "Test: GenType resolves modules through a non-canonical project path"
+node ./project-root.mjs
+success "GenType project-root checks completed"

rewatch/tests/gentype/project-root.mjs

@@ -0,0 +1,145 @@
+import assert from "node:assert/strict";
+import {spawnSync} from "node:child_process";
+import {existsSync, mkdtempSync, mkdirSync, readFileSync, realpathSync, rmSync, symlinkSync, writeFileSync} from "node:fs";
+import {tmpdir} from "node:os";
+import {join} from "node:path";
+
+const executable = process.env.REWATCH_EXECUTABLE;
+assert(executable, "REWATCH_EXECUTABLE must be set");
+
+const executablePath = executable.endsWith(".exe") ? executable : `${executable}.exe`;
+const commandShim = executable.endsWith(".cmd") ? executable : `${executable}.cmd`;
+const resolvedExecutable = existsSync(executablePath)
+  ? executablePath
+  : existsSync(commandShim)
+    ? commandShim
+    : executable;
+
+function runBuild(buildDirectory) {
+  if (process.platform !== "win32") {
+    return spawnSync(executable, ["build", buildDirectory], {
+      cwd: tmpdir(),
+      encoding: "utf8",
+      env: process.env,
+      timeout: 30_000,
+    });
+  }
+
+  return spawnSync(
+    process.env.ComSpec ?? "cmd.exe",
+    [
+      "/d",
+      "/c",
+      'cd /d "%REWATCH_TEST_PROJECT%" && "%REWATCH_TEST_EXECUTABLE%" build',
+    ],
+    {
+      encoding: "utf8",
+      env: {
+        ...process.env,
+        REWATCH_TEST_EXECUTABLE: resolvedExecutable,
+        REWATCH_TEST_PROJECT: buildDirectory,
+      },
+      timeout: 30_000,
+      windowsVerbatimArguments: true,
+    },
+  );
+}
+
+function getBuildDirectory(projectDir) {
+  if (process.platform !== "win32") {
+    const symlink = `${projectDir}-link`;
+    symlinkSync(projectDir, symlink, "dir");
+    return symlink;
+  }
+
+  const expandedPath = realpathSync.native(projectDir);
+  const result = spawnSync(
+    process.env.ComSpec ?? "cmd.exe",
+    ["/d", "/c", 'for %I in ("%REWATCH_TEST_PROJECT%") do @echo %~sI'],
+    {
+      encoding: "utf8",
+      env: {...process.env, REWATCH_TEST_PROJECT: expandedPath},
+      windowsVerbatimArguments: true,
+    },
+  );
+  assert.ifError(result.error);
+  assert.equal(result.status, 0, result.stderr);
+
+  const shortPath = result.stdout.trim();
+  assert(shortPath, "Windows did not return a short path for the temporary project");
+  if (shortPath.toLowerCase() === expandedPath.toLowerCase()) {
+    console.log("SKIP: Windows 8.3 short names are unavailable on this volume");
+    return null;
+  }
+  return shortPath;
+}
+
+function checkEditorCompilation(buildDirectory) {
+  const options = {encoding: "utf8", timeout: 30_000};
+  const result = spawnSync(
+    resolvedExecutable,
+    ["compiler-args", join(buildDirectory, "src-a", "A.res")],
+    {...options, shell: resolvedExecutable.endsWith(".cmd")},
+  );
+  assert.ifError(result.error);
+  assert.equal(result.status, 0, result.stderr);
+  const {compiler_args: args} = JSON.parse(result.stdout);
+  assert.equal(args[args.indexOf("-bs-project-root") + 1], buildDirectory);
+
+  // The editor compiles an absolute incremental source instead of the AST,
+  // and omits generated-JavaScript output while retaining the GenType flags.
+  args.splice(args.indexOf("-bs-package-output"), 2);
+  args.pop();
+  const incrementalDir = join(buildDirectory, "lib", "bs", "___incremental");
+  mkdirSync(incrementalDir);
+  const source = join(incrementalDir, "Editor.res");
+  writeFileSync(source, "@genType\nlet value = 42\n");
+  const compiled = spawnSync(process.env.RESCRIPT_BSC_EXE, [...args, source], {
+    ...options,
+    cwd: join(buildDirectory, "lib", "bs"),
+  });
+  assert.ifError(compiled.error);
+  assert.equal(compiled.status, 0, `${compiled.stdout}\n${compiled.stderr}`);
+  assert(existsSync(join(incrementalDir, "Editor.gen.tsx")));
+}
+
+const projectDir = mkdtempSync(join(tmpdir(), "rescript-gentype-root-"));
+
+try {
+  mkdirSync(join(projectDir, "src-a"));
+  mkdirSync(join(projectDir, "src-b", "nested"), {recursive: true});
+  writeFileSync(
+    join(projectDir, "rescript.json"),
+    `${JSON.stringify(
+      {
+        name: "gentype-project-root",
+        sources: ["src-a", {dir: "src-b", subdirs: true}],
+        gentypeconfig: {},
+      },
+      null,
+      2,
+    )}\n`,
+  );
+  writeFileSync(join(projectDir, "src-a", "A.res"), "@genType\ntype t = {value: int}\n");
+  writeFileSync(
+    join(projectDir, "src-b", "nested", "B.res"),
+    "@genType\nlet getValue = (record: A.t) => record.value\n",
+  );
+
+  const buildDirectory = getBuildDirectory(projectDir);
+  if (buildDirectory !== null) {
+    assert(existsSync(buildDirectory), `Build directory does not exist: ${buildDirectory}`);
+    const result = runBuild(buildDirectory);
+
+    assert.ifError(result.error);
+    assert.equal(result.status, 0, `${result.stdout}\n${result.stderr}`);
+    assert.match(
+      readFileSync(join(projectDir, "src-b", "nested", "B.gen.tsx"), "utf8"),
+      /from '\.\.\/\.\.\/src-a\/A\.gen'/,
+    );
+    checkEditorCompilation(buildDirectory);
+  }
+} finally {
+  rmSync(`${projectDir}-link`, {force: true});
+  rmSync(projectDir, {recursive: true, force: true});
+}

rewatch/tests/suite.sh

@@ -136,6 +136,9 @@ fi
 ./compile/15-no-new-files.sh &&
 ./compile/16-snapshots-unchanged.sh &&
 
+# GenType tests
+./gentype/01-gentype-project-root.sh &&
+
 # Watch tests
 ./watch/01-watch-recompile.sh &&
 ./watch/02-watch-warnings-persist.sh &&

scripts/test.js

@@ -65,7 +65,29 @@ if (formatTest) {
 
 if (ounitTest) {
   if (process.platform === "win32") {
-    console.log("Skipping OUnit tests on Windows");
+    // GenType's drive-root regression needs the native Windows Filename module.
+    const binary = path.join(
+      projectDir,
+      "_build/default/tests/ounit_tests/ounit_tests_main.exe",
+    );
+    const { stdout } = await execBin(binary, ["-list-test"], {
+      shell: false,
+      throwOnFail: true,
+    });
+    const tests = stdout
+      .split(/\r?\n/)
+      .filter(test => test.includes(":gentype:"));
+    if (tests.length === 0) {
+      throw new Error("No GenType unit tests found");
+    }
+    await execBin(
+      binary,
+      tests.flatMap(test => ["-only-test", test]),
+      {
+        stdio: "inherit",
+        shell: false,
+      },
+    );
   } else {
     await execBin(ounitTestBin, [], {
       stdio: "inherit",

tests/ounit_tests/ounit_gentype_tests.ml

@@ -3,6 +3,20 @@ open OUnit
 let suites =
   "gentype"
   >::: [
+         ( "split relative module paths" >:: fun _ ->
+           assert_equal ["."] (Module_resolver.path_to_list ".");
+           assert_equal ["src"] (Module_resolver.path_to_list "src");
+           assert_equal ["nested"; "src"]
+             (Module_resolver.path_to_list (Filename.concat "src" "nested")) );
+         ( "stop at Windows drive roots" >:: fun _ ->
+           skip_if (not Sys.win32) "Windows drive roots require Windows";
+           List.iter
+             (fun root ->
+               assert_equal [root] (Module_resolver.path_to_list root);
+               assert_equal ["nested"; "src"; root]
+                 (Module_resolver.path_to_list
+                    (Filename.concat root (Filename.concat "src" "nested"))))
+             ["C:\\"; "D:\\"] );
          ( "escape semantic import paths" >:: fun _ ->
            let emit path =
              path |> Import_path.from_string_unsafe |> Import_path.emit