Make inclusion error output independent of the source path

CHANGELOG.md

@@ -21,6 +21,7 @@
 #### :bug: Bug fix
 
 - Make rewatch compile independent modules after an unrelated failure and recompile blocked dependents when a changed interface survives a failed implementation, including across full watcher rebuilds. https://github.com/rescript-lang/rescript/pull/8667
+- Make module inclusion error messages independent of the length of the source file path. https://github.com/rescript-lang/rescript/pull/8691
 
 #### :memo: Documentation
 

compiler/ml/clflags.ml

@@ -26,7 +26,7 @@ and real_paths = ref true (* -short-paths *)
 
 and applicative_functors = ref true (* -no-app-funct *)
 
-and error_size = ref 500 (* -error-size *)
+and error_size = ref 400 (* -error-size, in heap words *)
 
 and transparent_modules = ref false (* -trans-mod *)
 let dump_source = ref false (* -dsource *)

compiler/ml/includemod.ml

@@ -634,16 +634,37 @@ let include_err ppf (cxt, env, err) =
   Printtyp.wrap_printing_env env (fun () ->
       fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) (include_symptom env) err)
 
-let buffer = ref Bytes.empty
+(* An error part is big when its heap representation exceeds
+   [!Clflags.error_size] words. Each distinct reachable block counts its header
+   and fields; a block without scannable fields (string, float, custom) or a
+   closure counts its header only. String contents are excluded so that the
+   decision is independent of source file names stored in locations. The walk
+   stops as soon as the limit is exceeded, which bounds the visited list. *)
 let is_big obj =
-  let size = !Clflags.error_size in
-  size > 0
-  &&
-  (if Bytes.length !buffer < size then buffer := Bytes.create size;
-   try
-     ignore (Marshal.to_buffer !buffer 0 size obj []);
-     false
-   with _ -> true)
+  let limit = !Clflags.error_size in
+  let size = ref 0 in
+  let visited = ref [] in
+  let exception Big in
+  let rec walk (o : Obj.t) =
+    if Obj.is_block o && not (List.memq o !visited) then (
+      visited := o :: !visited;
+      let tag = Obj.tag o in
+      let scan =
+        tag < Obj.no_scan_tag && tag <> Obj.closure_tag && tag <> Obj.infix_tag
+      in
+      size := !size + if scan then 1 + Obj.size o else 1;
+      if !size > limit then raise_notrace Big;
+      if scan then
+        for i = 0 to Obj.size o - 1 do
+          walk (Obj.field o i)
+        done)
+  in
+  if limit <= 0 then false
+  else
+    try
+      walk (Obj.repr obj);
+      false
+    with Big -> true
 
 let report_error ppf errs =
   if errs = [] then ()

tests/build_tests/super_errors/input.js

@@ -11,7 +11,8 @@ const { bsc } = setup(import.meta.dirname);
 
 const expectedDir = path.join(import.meta.dirname, "expected");
 
-const fixtures = readdirSync(path.join(import.meta.dirname, "fixtures"))
+const fixturesInTree = path.join(import.meta.dirname, "fixtures");
+const fixtures = readdirSync(fixturesInTree)
   .filter(fileName => path.extname(fileName) === ".res")
   .sort();
 
@@ -46,19 +47,20 @@ function postProcessErrorOutput(output) {
 }
 
 /**
+ * @param {string} fixturesDir
  * @param {string} fileName
  * @returns {Promise<{ fileName: string, failure: string | null }>}
  */
-async function runFixture(fileName) {
-  const fullFilePath = path.join(import.meta.dirname, "fixtures", fileName);
+async function runFixture(fixturesDir, fileName) {
+  const fullFilePath = path.join(fixturesDir, fileName);
   const { stderr } = await bsc([...prefix, "-color", "always", fullFilePath]);
   // careful of:
   // - warning test that actually succeeded in compiling (warning's still in stderr, so the code path is shared here)
   // - accidentally succeeding tests (not likely in this context),
   // actual, correctly erroring test case
   const actualErrorOutput = postProcessErrorOutput(stderr.toString());
   const expectedFilePath = path.join(expectedDir, `${fileName}.expected`);
-  if (updateTests) {
+  if (updateTests && fixturesDir === fixturesInTree) {
     await fs.writeFile(expectedFilePath, actualErrorOutput);
     return { fileName, failure: null };
   }
@@ -80,22 +82,61 @@ async function runFixture(fileName) {
   };
 }
 
+// Diagnostics must not depend on the length of the source path. Every
+// fixture also runs from a copy whose directory path is 180 characters long,
+// longer than any checkout path, ending in the same
+// tests/build_tests/super_errors/fixtures suffix so that
+// postProcessErrorOutput yields the same snapshot text. The directory length
+// is fixed rather than the padding, so the fixture paths stay below Windows'
+// 260-character MAX_PATH whatever the length of the temporary directory.
+const tempRoot = await fs.mkdtemp(path.join(os.tmpdir(), "super_errors-"));
+const fixturesSuffix = path.join(
+  "tests",
+  "build_tests",
+  "super_errors",
+  "fixtures",
+);
+const fixturesLongPath = path.join(
+  tempRoot,
+  "x".repeat(
+    Math.max(
+      1,
+      180 - tempRoot.length - fixturesSuffix.length - 2 * path.sep.length,
+    ),
+  ),
+  fixturesSuffix,
+);
+await fs.mkdir(fixturesLongPath, { recursive: true });
+for (const fileName of fixtures) {
+  await fs.copyFile(
+    path.join(fixturesInTree, fileName),
+    path.join(fixturesLongPath, fileName),
+  );
+}
+
+/** @type {Array<[string, string]>} */
+const runs = [];
+for (const fixturesDir of [fixturesInTree, fixturesLongPath]) {
+  for (const fileName of fixtures) runs.push([fixturesDir, fileName]);
+}
+
 // Run fixtures in parallel with a worker-pool. Each fixture spawns a bsc
 // process, so wall time is dominated by process startup; serialising the
 // loop made the suite scale linearly with fixture count.
 const concurrency = Math.max(1, os.availableParallelism());
 let cursor = 0;
-const results = new Array(fixtures.length);
+const results = new Array(runs.length);
 
 await Promise.all(
-  Array.from({ length: Math.min(concurrency, fixtures.length) }, async () => {
+  Array.from({ length: Math.min(concurrency, runs.length) }, async () => {
     while (true) {
       const i = cursor++;
-      if (i >= fixtures.length) return;
-      results[i] = await runFixture(fixtures[i]);
+      if (i >= runs.length) return;
+      results[i] = await runFixture(...runs[i]);
     }
   }),
 );
+await fs.rm(tempRoot, { recursive: true, force: true });
 
 let atLeastOneTaskFailed = false;
 for (const { failure } of results) {