|
| 1 | +(* SPDX-License-Identifier: MPL-2.0 *) |
| 2 | +(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell *) |
| 3 | + |
| 4 | +(** End-to-end tests for the tree-sitter walker (#57 Phase 2b). |
| 5 | +
|
| 6 | + These tests shell out to the [tree-sitter] CLI; they are |
| 7 | + automatically skipped when the CLI is not on PATH so a fresh |
| 8 | + clone can still run [dune runtest] without bootstrapping the |
| 9 | + grammar. CI installs tree-sitter and runs them as a gate. |
| 10 | +
|
| 11 | + To run locally: install tree-sitter (`cargo install |
| 12 | + tree-sitter-cli`), then `just install-grammar`, then `dune |
| 13 | + runtest tools/res-to-affine/`. *) |
| 14 | + |
| 15 | +open Res_to_affine |
| 16 | + |
| 17 | +let read_file path = |
| 18 | + let ic = open_in_bin path in |
| 19 | + let n = in_channel_length ic in |
| 20 | + let s = really_input_string ic n in |
| 21 | + close_in ic; |
| 22 | + s |
| 23 | + |
| 24 | +let tree_sitter_available () = |
| 25 | + Sys.command "command -v tree-sitter > /dev/null 2>&1" = 0 |
| 26 | + |
| 27 | +(* Find the repo root by walking up from the test's runtime cwd looking |
| 28 | + for `dune-project`. Dune sandboxes tests under |
| 29 | + `_build/default/.../test/`, so the natural "up three levels" arithmetic |
| 30 | + gives a build-tree path where the source-tree |
| 31 | + `tools/vendor/tree-sitter-rescript` does not exist. *) |
| 32 | +let rec find_repo_root dir = |
| 33 | + if Sys.file_exists (Filename.concat dir "dune-project") then Some dir |
| 34 | + else |
| 35 | + let parent = Filename.dirname dir in |
| 36 | + if parent = dir then None (* hit filesystem root *) |
| 37 | + else find_repo_root parent |
| 38 | + |
| 39 | +let repo_root () = |
| 40 | + match Sys.getenv_opt "DUNE_SOURCEROOT" with |
| 41 | + | Some s when s <> "" -> s |
| 42 | + | _ -> |
| 43 | + (match find_repo_root (Sys.getcwd ()) with |
| 44 | + | Some s -> s |
| 45 | + | None -> Sys.getcwd ()) |
| 46 | + |
| 47 | +let grammar_dir () = |
| 48 | + Filename.concat (repo_root ()) "tools/vendor/tree-sitter-rescript" |
| 49 | + |
| 50 | +let grammar_built () = |
| 51 | + Sys.file_exists (Filename.concat (grammar_dir ()) "src/parser.c") |
| 52 | + |
| 53 | +let skip_unless_ready () = |
| 54 | + if not (tree_sitter_available ()) then begin |
| 55 | + Printf.printf |
| 56 | + " [skip] tree-sitter CLI not on PATH; install via `cargo install \ |
| 57 | + tree-sitter-cli`@\n"; |
| 58 | + Alcotest.skip () |
| 59 | + end; |
| 60 | + if not (grammar_built ()) then begin |
| 61 | + Printf.printf |
| 62 | + " [skip] grammar not built; run `just install-grammar`@\n"; |
| 63 | + Alcotest.skip () |
| 64 | + end |
| 65 | + |
| 66 | +let fixture = "fixtures/sample.res" |
| 67 | + |
| 68 | +let test_walker_finds_side_effect_import () = |
| 69 | + skip_unless_ready (); |
| 70 | + let source = read_file fixture in |
| 71 | + let path = Filename.concat (Sys.getcwd ()) fixture in |
| 72 | + let findings = |
| 73 | + Walker.scan ~grammar_dir:(grammar_dir ()) ~path ~source |
| 74 | + in |
| 75 | + let has_kind k = |
| 76 | + List.exists (fun (f : Scanner.finding) -> f.kind = k) findings |
| 77 | + in |
| 78 | + Alcotest.(check bool) |
| 79 | + "walker reports side-effect-import on sample.res" |
| 80 | + true (has_kind Scanner.Side_effect_import) |
| 81 | + |
| 82 | +let test_walker_only_module_toplevel () = |
| 83 | + (* The walker's promised improvement over the regex scanner: it |
| 84 | + should NOT flag `let _ = chained.call()` inside a function body |
| 85 | + as a side-effect-import. We can't synthesise that case without |
| 86 | + running tree-sitter, so this test is gated and uses the existing |
| 87 | + fixture, which has the regex-scanner-matching shape at module |
| 88 | + top level — the walker should match it. The negative case lives |
| 89 | + in Phase 2c's expanded corpus. *) |
| 90 | + skip_unless_ready (); |
| 91 | + let source = read_file fixture in |
| 92 | + let path = Filename.concat (Sys.getcwd ()) fixture in |
| 93 | + let findings = |
| 94 | + Walker.scan ~grammar_dir:(grammar_dir ()) ~path ~source |
| 95 | + in |
| 96 | + let side_effect_lines = |
| 97 | + List.filter_map |
| 98 | + (fun (f : Scanner.finding) -> |
| 99 | + if f.kind = Scanner.Side_effect_import then Some f.line else None) |
| 100 | + findings |
| 101 | + in |
| 102 | + (* sample.res line 8: `let _ = Pixi.Sound.register` — the only |
| 103 | + top-level side-effect import. *) |
| 104 | + Alcotest.(check (list int)) |
| 105 | + "walker reports the line-8 import and only that one" |
| 106 | + [8] side_effect_lines |
| 107 | + |
| 108 | +(* ---- s-exp parser sanity (NOT gated; pure OCaml) --------------------------- |
| 109 | +
|
| 110 | + The walker subprocess is shelled out in the gated tests above. The |
| 111 | + s-exp parser itself is pure-OCaml and can be exercised directly, |
| 112 | + but it lives behind walker.ml's module boundary. We do not unit- |
| 113 | + test it here to avoid widening the .mli for test-only access; the |
| 114 | + gated end-to-end tests above exercise it through real |
| 115 | + tree-sitter output. *) |
| 116 | + |
| 117 | +let () = |
| 118 | + Alcotest.run "res-to-affine-walker" |
| 119 | + [ |
| 120 | + ( "walker", |
| 121 | + [ |
| 122 | + Alcotest.test_case "side-effect-import found on sample.res" |
| 123 | + `Quick test_walker_finds_side_effect_import; |
| 124 | + Alcotest.test_case "module-toplevel-only, correct line" |
| 125 | + `Quick test_walker_only_module_toplevel; |
| 126 | + ] ); |
| 127 | + ] |
0 commit comments