diff --git a/compiler/README.md b/compiler/README.md new file mode 100644 index 0000000..a79a354 --- /dev/null +++ b/compiler/README.md @@ -0,0 +1,30 @@ +# compiler/ — the OCaml `woc` compiler + +Lexer → parser → typechecker → ownership pass → bytecode emitter for `.wo`. OCaml stdlib only (no Menhir, no ppx); dune is the build runner. Sibling of the C `wovm` bytecode VM (`runtime/`) — the two halves of the OOP track's spec (`docs/superpowers/specs/2026-08-01-oop-compiler-vm-design.md`) meet at plan 3 (`.wob` emission). + +**Stage: Task 1 scaffold.** `src/` is currently an empty library and `bin/main.ml` is a CLI stub that only wires the exit-code contract below — no lexing, parsing, or checking happens yet. Tasks 2–8 (`compiler/plan/2026-08-01-woc-compiler-front.md`) fill in diagnostics, lexer, parser, typechecker, and the ownership pass in that order. + +## Requirements + +OCaml 4.14.1, dune 3.14.0 — Ubuntu 24.04 apt packages (`sudo apt install ocaml dune`), the version floor. Confirm with `ocaml -version` / `dune --version`. No opam packages, no Menhir, no ppx — stdlib only. + +## Build, test + +```bash +cd compiler && dune build # -> _build/default/bin/woc +cd compiler && dune runtest # golden suite (empty until Task 3 adds test/dune) + +just woc-build # same, from the repo root +just woc-test # same, from the repo root +``` + +`woc` with no arguments (or the wrong number of arguments) prints usage to stderr and exits 2; given one path argument it exits 0 if the path exists, 2 if it doesn't. Exit-code contract, established now and enforced fully once diagnostics land in Task 2: **0** clean compile, **1** diagnostics reported, **2** usage/IO failure. + +## Layout + +- `src/` — one module per stage, added as each task lands: diag, token, lexer, ast, parser, types, owner, dump +- `bin/` — the `woc` executable (check / emit / build modes land in later tasks) +- `test/` — golden runner; `test/golden/` holds fixtures per stage (Task 3 onward) +- `plan/` — compiler-track docs: [`architecture.md`](plan/architecture.md) (pipeline, module contracts, reference-study map) + plans 2, 3, 8 + +Governing docs: spec `docs/superpowers/specs/2026-08-01-oop-compiler-vm-design.md`; plans 2, 3, 8 in `compiler/plan/`. Format contract: `docs/plan/oop-vm/00-wob-format.md`. diff --git a/compiler/bin/dune b/compiler/bin/dune new file mode 100644 index 0000000..971f36e --- /dev/null +++ b/compiler/bin/dune @@ -0,0 +1,17 @@ +(executable + (name main) + (libraries woc_lib)) + +; dune names the built executable after its main module (Main, from +; main.ml), which lands in the build directory as main.exe. Copy it to +; the plain "woc" name and fold that into this directory's default +; alias so a bare `dune build` produces the woc binary directly. +(rule + (target woc) + (deps main.exe) + (action + (copy main.exe woc))) + +(alias + (name default) + (deps woc)) diff --git a/compiler/bin/main.ml b/compiler/bin/main.ml new file mode 100644 index 0000000..8a17e9d --- /dev/null +++ b/compiler/bin/main.ml @@ -0,0 +1,110 @@ +(* woc — the writeonce OCaml compiler front end. + + Task 1 scaffolded the CLI's exit-code contract with no compiler + stage behind it. Task 2 added diagnostics (compiler/src/diag.ml). + Task 3 added the lexer (compiler/src/{token,lexer}.ml) behind + --dump-tokens. Task 4 adds the declaration parser + (compiler/src/{ast,parser}.ml) behind --dump-ast, printing a stable, + golden-diffed AST dump (compiler/src/dump.ml) to stdout. Tasks 5-7 + add statement/expression parsing, the typechecker, and the ownership + pass behind their own --dump-* flags; Task 8 adds directory + discovery and multi-file programs, at which point the bare + `woc ` form below starts actually compiling instead of just + checking existence. + + 0 = clean compile + 1 = diagnostics reported (reachable now: --dump-tokens on source + with an unknown character, or --dump-ast on source with a + broken declaration, reports WO-E0xx/WO-E1xx and exits 1) + 2 = usage or IO failure + + With no arguments, this prints usage to stderr and exits 2. Given a + single path argument (no flag), it exits 0 if the path exists and 2 + (with a stderr message) if it does not — this bare-path form + predates any real compilation and stays as-is until Task 8. *) + +let usage_msg = + "usage: woc \n\ + usage: woc --dump-tokens \n\ + usage: woc --dump-ast \n\ + \n\ + Compiles writeonce (.wo) source. is a single .wo file or a\n\ + directory to discover .wo files under (directory discovery lands in\n\ + a later task; compilation itself has not landed yet either).\n\ + \n\ + --dump-tokens prints one line per lexed token to stdout, in source\n\ + order (\"LINE:COL KIND\" or \"LINE:COL KIND(payload)\"), ending with\n\ + EOF; lexing diagnostics, if any, print to stderr.\n\ + \n\ + --dump-ast prints the declaration- and body-level AST as an indented\n\ + tree to stdout (class/type/interface/fn declarations, with real\n\ + statement/expression parsing inside method and free-fn bodies);\n\ + parsing diagnostics, if any, print to stderr.\n\ + \n\ + Exit codes: 0 clean, 1 diagnostics reported, 2 usage/IO failure.\n" + +let read_source path = + try + let ic = open_in_bin path in + let n = in_channel_length ic in + let s = really_input_string ic n in + close_in ic; + Ok s + with Sys_error msg -> Error msg + +let dump_tokens path = + if not (Sys.file_exists path) then begin + Printf.eprintf "woc: no such file or directory: %s\n" path; + exit 2 + end; + match read_source path with + | Error msg -> + Printf.eprintf "woc: %s\n" msg; + exit 2 + | Ok src -> + let collector = Woc_lib.Diag.Collector.create () in + let toks = Woc_lib.Lexer.tokenize collector ~file:path src in + print_string (Woc_lib.Dump.dump_tokens toks); + if Woc_lib.Diag.Collector.has_error collector then begin + let lookup f = if f = path then Some src else None in + prerr_string (Woc_lib.Diag.Collector.render_all collector lookup); + prerr_newline (); + exit 1 + end + else exit 0 + +let dump_ast path = + if not (Sys.file_exists path) then begin + Printf.eprintf "woc: no such file or directory: %s\n" path; + exit 2 + end; + match read_source path with + | Error msg -> + Printf.eprintf "woc: %s\n" msg; + exit 2 + | Ok src -> + let collector = Woc_lib.Diag.Collector.create () in + let toks = Woc_lib.Lexer.tokenize collector ~file:path src in + let prog = Woc_lib.Parser.parse collector ~file:path toks in + print_string (Woc_lib.Dump.dump_ast prog); + if Woc_lib.Diag.Collector.has_error collector then begin + let lookup f = if f = path then Some src else None in + prerr_string (Woc_lib.Diag.Collector.render_all collector lookup); + prerr_newline (); + exit 1 + end + else exit 0 + +let () = + match Sys.argv with + | [| _; "--dump-tokens"; path |] -> dump_tokens path + | [| _; "--dump-ast"; path |] -> dump_ast path + | [| _; path |] -> + if Sys.file_exists path then exit 0 + else begin + Printf.eprintf "woc: no such file or directory: %s\n" path; + exit 2 + end + | _ -> + prerr_string usage_msg; + exit 2 diff --git a/compiler/dune-project b/compiler/dune-project new file mode 100644 index 0000000..c199a48 --- /dev/null +++ b/compiler/dune-project @@ -0,0 +1 @@ +(lang dune 3.14) diff --git a/compiler/src/diag.ml b/compiler/src/diag.ml new file mode 100644 index 0000000..cc2efc2 --- /dev/null +++ b/compiler/src/diag.ml @@ -0,0 +1,205 @@ +(* diag.ml — the diagnostics module for woc. + + Every later stage (lexer, parser, typechecker, ownership pass) + reports through this one channel. A diagnostic is: + + - a stable code, e.g. "WO-E301" + - a severity: Error or Warning + - a primary site: file, 1-based line, 1-based column + - a human-readable message + - zero or more *related* sites (file/line/col + a short label), + used for two-site errors such as the ownership pass's + "moved here ... used here" + + Rendering follows the rustc/OCaml convention: a single header line + ("file:line:col: severity CODE: message"), the source line, and a + caret line with '^' under the reported column. Related sites render + the same way, indented beneath the primary diagnostic. Column + counting treats every character as exactly one column — including + tab — so the renderer never expands tabs: a caret's horizontal + offset in the rendered text is always (column - 1) characters, + matching how a lexer counts columns while scanning raw bytes. + + Rendering needs the actual source text to build an excerpt from, but + this module never touches the filesystem itself: callers supply a + `source_lookup` (file name -> file contents option). This keeps + diag.ml usable from unit tests (in-memory fixtures) and from the + real driver (reads files) alike, and keeps IO failures a driver + concern, not a diagnostics-rendering concern. + + The Collector accumulates diagnostics as stages produce them — + parser/typer/owner recovery can add several in one pass, not + necessarily in source order. For output it sorts by + (file, line, col), drops exact (code, file, line, col) duplicates + (first occurrence wins), and decides the process exit code from + that same deduped, sorted view: 1 if any diagnostic surviving + dedup is an error, 0 otherwise. exit_code always agrees with what + diagnostics/render_all would show — it never inspects the raw, + pre-dedup accumulation, so a duplicate entry that dedup drops can + never flip the exit code against what was actually reported. Exit + code 2 (usage/IO failure) is never decided here — that is + bin/main.ml's call, made before any compiler stage runs. + + Code ranges are reserved per stage now, so the Task-8 catalog + (docs/plan/oop-vm/01-error-catalog.md) is an enumeration of codes + already in use, not an archaeology dig: + + WO-E0xx lexing (Task 3) + WO-E1xx parsing (Task 4, 5) + WO-E2xx types (Task 6) + WO-E3xx ownership (Task 7) + + No codes are minted in this module — it only reserves the ranges. + The prefixes below are the single documented source later stages + build their concrete codes from (e.g. lexing_prefix ^ "12" -> + "WO-E012"). *) + +let lexing_prefix = "WO-E0" +let parsing_prefix = "WO-E1" +let types_prefix = "WO-E2" +let ownership_prefix = "WO-E3" + +type severity = + | Error + | Warning + +(* A single point in a source file. Both line and col are 1-based. *) +type site = { + file : string; + line : int; + col : int; +} + +(* A secondary location attached to a diagnostic, with a short label + describing its role (e.g. "moved here"). *) +type related = { + site : site; + label : string; +} + +type t = { + code : string; + severity : severity; + site : site; + message : string; + related : related list; +} + +(* Alias used inside the nested Collector module below so it can refer + to the diagnostic type without shadowing its own state type `t`. *) +type diagnostic = t + +let related_site ~file ~line ~col ~label : related = + { site = { file; line; col }; label } + +let make ~code ~severity ~file ~line ~col ~message ?(related = []) () : t = + { code; severity; site = { file; line; col }; message; related } + +let error ~code ~file ~line ~col ~message ?(related = []) () : t = + make ~code ~severity:Error ~file ~line ~col ~message ~related () + +let warning ~code ~file ~line ~col ~message ?(related = []) () : t = + make ~code ~severity:Warning ~file ~line ~col ~message ~related () + +let severity_word = function + | Error -> "error" + | Warning -> "warning" + +(* Given a file name, return its full source text, or None if + unavailable (unreadable, unknown, etc). diag.ml never reads the + filesystem itself — callers own IO. *) +type source_lookup = string -> string option + +let line_text (lookup : source_lookup) (site : site) : string option = + if site.line < 1 then None + else + match lookup site.file with + | None -> None + | Some contents -> + (* site.line is 1-based; String.split_on_char indices are 0-based. + List.nth_opt raises Invalid_argument (rather than returning + None) for a negative index, so the guard above is load-bearing: + without it, a diagnostic constructed with an out-of-range line + (a bug in some future stage) would crash the renderer instead + of falling back to a header-only line the way an unknown file + already does. *) + List.nth_opt (String.split_on_char '\n' contents) (site.line - 1) + +let caret_line (col : int) : string = + (* Every character — tabs included — counts as one column, so the + caret's offset is simply (col - 1) plain spaces. We do not expand + tabs or otherwise inspect the source line's characters here. *) + String.make (max 0 (col - 1)) ' ' ^ "^" + +(* Renders one site as [header] or [header; source-line; caret-line] + depending on whether an excerpt is available. *) +let render_block (lookup : source_lookup) (site : site) (label : string) : + string list = + let header = Printf.sprintf "%s:%d:%d: %s" site.file site.line site.col label in + match line_text lookup site with + | None -> [ header ] + | Some text -> [ header; text; caret_line site.col ] + +let render (lookup : source_lookup) (d : t) : string = + let primary_label = + Printf.sprintf "%s %s: %s" (severity_word d.severity) d.code d.message + in + let primary = render_block lookup d.site primary_label in + let indent line = " " ^ line in + let related_blocks = + List.concat_map + (fun (r : related) -> List.map indent (render_block lookup r.site r.label)) + d.related + in + String.concat "\n" (primary @ related_blocks) + +module Collector = struct + type t = { mutable items : diagnostic list (* reverse insertion order *) } + + let create () : t = { items = [] } + + let add (c : t) (d : diagnostic) : unit = c.items <- d :: c.items + + let site_key (d : diagnostic) = (d.site.file, d.site.line, d.site.col) + + (* Diagnostics in output order: sorted by (file, line, col) — stable, + so diagnostics tied on site keep their original insertion + (source/recovery) order — with exact (code, file, line, col) + duplicates dropped (first occurrence wins). *) + let diagnostics (c : t) : diagnostic list = + let in_insertion_order = List.rev c.items in + let sorted = + List.stable_sort + (fun a b -> compare (site_key a) (site_key b)) + in_insertion_order + in + let seen = Hashtbl.create 16 in + List.filter + (fun d -> + let key = (d.code, d.site.file, d.site.line, d.site.col) in + if Hashtbl.mem seen key then false + else ( + Hashtbl.add seen key (); + true)) + sorted + + (* Deliberately scans `diagnostics c` (the sorted, deduped view), + not raw `c.items`: dedup keeps only the first-inserted occurrence + per (code, file, line, col), so if a Warning and an Error ever + land at the exact same (code, site), the surviving displayed + diagnostic is whichever was added first — and exit_code must + agree with that same survivor, not with severities dedup already + discarded. Scanning c.items here would let exit_code see a + dropped Error that the rendered report no longer shows. *) + let has_error (c : t) : bool = + List.exists (fun d -> d.severity = Error) (diagnostics c) + + (* woc's exit-code contract is 0 clean / 1 diagnostics reported / 2 + usage-IO failure. This module only ever returns 0 or 1 — exit + code 2 is decided by the driver (bin/main.ml) before any compiler + stage runs, never here. *) + let exit_code (c : t) : int = if has_error c then 1 else 0 + + let render_all (c : t) (lookup : source_lookup) : string = + diagnostics c |> List.map (render lookup) |> String.concat "\n\n" +end diff --git a/compiler/src/lexer.ml b/compiler/src/lexer.ml new file mode 100644 index 0000000..8aaeb41 --- /dev/null +++ b/compiler/src/lexer.ml @@ -0,0 +1,335 @@ +(* lexer.ml — tokenizer for `.wo` source (milestone-1 OOP subset). + + Ported from crates/rt/src/lexer.rs; behavior kept identical wherever + it defines what the language literally is: + + - newline tokens are emitted, never filtered, and consecutive + newlines collapse to a single Newline token — exactly rt's + `out.last() == Some(Newline) => don't push another` rule; + - `--` starts a line comment that runs to (not including) the next + newline; + - single- or double-quoted strings support the same backslash + escapes as rt: n, t, backslash, or either quote character, each + backslash-prefixed; anything else verbatim; + - integer literals are plain runs of ASCII digits; + - identifiers may contain internal dashes, exactly like rt's + read_ident_chars (crates/rt/src/lexer.rs) — so `foo-bar` lexes as + one identifier, not `foo`, Dash, `bar`. This is a faithful port of + an rt quirk, not a milestone-1 design choice: Task 5's expression + parser must therefore require whitespace around a binary minus + that immediately follows an identifier (`a - b`, not `a-b`) to + avoid the ambiguity, exactly as rt's schema layer already does. + Flagged here for whoever picks up Task 5. + + Divergence from rt, deliberate: rt's `tokenize` returns + `anyhow::Result` and bails (stops the whole file) on the first bad + byte or malformed punctuation shape (a bare `!` not followed by + `=`, a `$` with no name, ...). This front end's diagnostics contract + is multi-error (compiler/src/diag.ml — every later stage accumulates + into one Collector rather than stopping at the first problem), so + every one of those cases becomes: report one WO-E001 unknown- + character diagnostic at the offending position, skip exactly that + one byte, and keep lexing. One bad byte must never stop the whole + file (Task 3 brief's Unknown character decision). *) + +let unknown_char_code = Diag.lexing_prefix ^ "01" (* WO-E001 *) + +(* rt's equivalent site (crates/rt/src/lexer.rs:106) bails outright: a + backslash as the very last byte of the file, with no character left + to escape, loses information silently otherwise (the intended escaped + character is simply gone, not skip-and-continue like the unknown- + character case). Ported as its own code rather than reusing WO-E001 + because the shape is different (a truncated escape, not a byte the + lexer doesn't recognize at all) and diag.ml's convention is one code + per distinct lexing situation. + + Deliberately NOT applied to a plain unterminated string: a string + that runs off the end of the file with no dangling backslash (say, + a quote-open let-binding with nothing after it and no closing quote) + — rt does not bail there either, its scanning loop just stops when + peek returns None and emits whatever was collected as the Str token. + Reporting nothing in that case is intentional rt parity, not an + oversight; pinned by the plain-unterminated-string-reports-nothing + assertion in compiler/test/runner.ml. *) +let unterminated_escape_code = Diag.lexing_prefix ^ "02" (* WO-E002 *) + +type lexer = { + src : string; + len : int; + mutable pos : int; + mutable line : int; + mutable col : int; +} + +let make src = { src; len = String.length src; pos = 0; line = 1; col = 1 } +let peek lx = if lx.pos < lx.len then Some lx.src.[lx.pos] else None + +let peek_at lx n = + let i = lx.pos + n in + if i < lx.len then Some lx.src.[i] else None + +let advance lx = + match peek lx with + | None -> None + | Some c -> + lx.pos <- lx.pos + 1; + if c = '\n' then begin + lx.line <- lx.line + 1; + lx.col <- 1 + end + else lx.col <- lx.col + 1; + Some c + +let is_digit c = c >= '0' && c <= '9' +let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') +let is_ident_start c = is_alpha c || c = '_' +let is_ident_cont c = is_alpha c || is_digit c || c = '_' || c = '-' + +(* Consumes a run of identifier characters starting at the lexer's + current position (caller has already confirmed is_ident_start on + the character at that position) and returns the collected text. + Mirrors rt's read_ident_chars, dash-continuation included (see + module doc). *) +let read_ident_chars lx = + let start = lx.pos in + let continue_ = ref true in + while !continue_ do + match peek lx with + | Some c when is_ident_cont c -> ignore (advance lx) + | _ -> continue_ := false + done; + String.sub lx.src start (lx.pos - start) + +(* The milestone-1 keyword set, exact per the Task 3 brief: type class + interface fn let mut take return if else while for in true false, + plus uppercase-only INSERT/SELECT. Deliberately absent: self, me, + subscribe, receive, and lowercase insert/select — those fall + through to the `_ -> None` case below and lex as plain Ident, + matching rt and the CLAUDE.md gotcha this task exists to preserve. *) +let keyword_kind = function + | "type" -> Some Token.KwType + | "class" -> Some Token.KwClass + | "interface" -> Some Token.KwInterface + | "fn" -> Some Token.KwFn + | "let" -> Some Token.KwLet + | "mut" -> Some Token.KwMut + | "take" -> Some Token.KwTake + | "return" -> Some Token.KwReturn + | "if" -> Some Token.KwIf + | "else" -> Some Token.KwElse + | "while" -> Some Token.KwWhile + | "for" -> Some Token.KwFor + | "in" -> Some Token.KwIn + | "true" -> Some Token.KwTrue + | "false" -> Some Token.KwFalse + | "INSERT" -> Some Token.KwInsert + | "SELECT" -> Some Token.KwSelect + | _ -> None + +let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : + Token.t list = + let lx = make src in + let out = ref [] in + let emit kind line col = out := { Token.kind; line; col } :: !out in + let last_is_newline () = + match !out with + | { Token.kind = Token.Newline; _ } :: _ -> true + | _ -> false + in + let report_unknown line col c = + Diag.Collector.add collector + (Diag.error ~code:unknown_char_code ~file ~line ~col + ~message:(Printf.sprintf "unknown character '%c'" c) ()) + in + let report_unterminated_escape line col = + Diag.Collector.add collector + (Diag.error ~code:unterminated_escape_code ~file ~line ~col + ~message:"unterminated string escape" ()) + in + let running = ref true in + while !running do + match peek lx with + | None -> running := false + | Some c -> ( + let line = lx.line and col = lx.col in + if c = '-' && peek_at lx 1 = Some '-' then begin + (* line comment: -- ... EOL (EOL itself is left for the next + iteration to turn into its own Newline token). *) + let scanning = ref true in + while !scanning do + match peek lx with + | Some '\n' | None -> scanning := false + | Some _ -> ignore (advance lx) + done + end + else if c = '\n' then begin + ignore (advance lx); + if not (last_is_newline ()) then emit Token.Newline line col + end + else if c = ' ' || c = '\t' || c = '\r' then ignore (advance lx) + else if c = '"' || c = '\'' then begin + let quote = c in + ignore (advance lx); + let buf = Buffer.create 16 in + let scanning = ref true in + while !scanning do + match peek lx with + | None -> + (* Plain unterminated string (ran off the end of the file + with no closing quote and no dangling backslash): rt does + not bail here either, it just stops and emits whatever was + collected. No diagnostic, deliberately — see + unterminated_escape_code's doc comment above. *) + scanning := false + | Some c when c = quote -> + ignore (advance lx); + scanning := false + | Some '\\' -> ( + (* Captured before advancing: this is the backslash's own + position, so a dangling-escape diagnostic points at the + `\` itself rather than wherever the scan happens to stop. *) + let esc_line = lx.line and esc_col = lx.col in + ignore (advance lx); + match advance lx with + | Some 'n' -> Buffer.add_char buf '\n' + | Some 't' -> Buffer.add_char buf '\t' + | Some '\\' -> Buffer.add_char buf '\\' + | Some '"' -> Buffer.add_char buf '"' + | Some '\'' -> Buffer.add_char buf '\'' + | Some other -> Buffer.add_char buf other + | None -> + report_unterminated_escape esc_line esc_col; + scanning := false) + | Some other -> + ignore (advance lx); + Buffer.add_char buf other + done; + emit (Token.Str (Buffer.contents buf)) line col + end + else if is_digit c then begin + let n = ref 0 in + let scanning = ref true in + while !scanning do + match peek lx with + | Some d when is_digit d -> + n := (!n * 10) + (Char.code d - Char.code '0'); + ignore (advance lx) + | _ -> scanning := false + done; + emit (Token.Int !n) line col + end + else if is_ident_start c then begin + let name = read_ident_chars lx in + let kind = + match keyword_kind name with Some k -> k | None -> Token.Ident name + in + emit kind line col + end + else + match c with + | '{' -> + ignore (advance lx); + emit Token.LBrace line col + | '}' -> + ignore (advance lx); + emit Token.RBrace line col + | '(' -> + ignore (advance lx); + emit Token.LParen line col + | ')' -> + ignore (advance lx); + emit Token.RParen line col + | '[' -> + ignore (advance lx); + emit Token.LBracket line col + | ']' -> + ignore (advance lx); + emit Token.RBracket line col + | ',' -> + ignore (advance lx); + emit Token.Comma line col + | ';' -> + ignore (advance lx); + emit Token.Semicolon line col + | ':' -> + ignore (advance lx); + emit Token.Colon line col + | '.' -> ( + ignore (advance lx); + match peek lx with + | Some '.' -> + ignore (advance lx); + emit Token.DotDot line col + | _ -> emit Token.Dot line col) + | '?' -> + ignore (advance lx); + emit Token.Question line col + | '@' -> + ignore (advance lx); + emit Token.At line col + | '|' -> + ignore (advance lx); + emit Token.Pipe line col + | '-' -> ( + ignore (advance lx); + match peek lx with + | Some '>' -> + ignore (advance lx); + emit Token.Arrow line col + | Some '=' -> + ignore (advance lx); + emit Token.MinusEq line col + | _ -> emit Token.Dash line col) + | '+' -> ( + ignore (advance lx); + match peek lx with + | Some '=' -> + ignore (advance lx); + emit Token.PlusEq line col + | _ -> emit Token.Plus line col) + | '*' -> + ignore (advance lx); + emit Token.Star line col + | '/' -> + ignore (advance lx); + emit Token.Slash line col + | '%' -> + ignore (advance lx); + emit Token.Percent line col + | '=' -> ( + ignore (advance lx); + match peek lx with + | Some '=' -> + ignore (advance lx); + emit Token.EqEq line col + | Some '>' -> + ignore (advance lx); + emit Token.FatArrow line col + | _ -> emit Token.Eq line col) + | '!' -> ( + ignore (advance lx); + match peek lx with + | Some '=' -> + ignore (advance lx); + emit Token.NotEq line col + | _ -> report_unknown line col '!') + | '<' -> ( + ignore (advance lx); + match peek lx with + | Some '=' -> + ignore (advance lx); + emit Token.LtEq line col + | _ -> emit Token.Lt line col) + | '>' -> ( + ignore (advance lx); + match peek lx with + | Some '=' -> + ignore (advance lx); + emit Token.GtEq line col + | _ -> emit Token.Gt line col) + | other -> + ignore (advance lx); + report_unknown line col other) + done; + emit Token.Eof lx.line lx.col; + List.rev !out diff --git a/compiler/src/token.ml b/compiler/src/token.ml new file mode 100644 index 0000000..da705b0 --- /dev/null +++ b/compiler/src/token.ml @@ -0,0 +1,85 @@ +(* token.ml — token kinds for the woc lexer. + + Ported from the Rust runtime's lexer/token pair + (crates/rt/src/token.rs, crates/rt/src/lexer.rs), trimmed to the + milestone-1 OOP subset this compiler front targets (Task 3 of + compiler/plan/2026-08-01-woc-compiler-front.md). Kept from rt: + position-tracked tokens, the same literal forms (Ident/Int/Str), + newline-as-a-real-token, and a punctuation/operator set mirroring + rt's generic categories (braces, parens, brackets, comma, colon, + dot, arrow, assignment, arithmetic, comparison). + + Deliberately dropped relative to rt's token.rs: the schema/query + layer keyword zoo (ref, multi, via, policy, txn, BEGIN/COMMIT/...), + the `$name` parameter token, and the `#name` / `##name` block-marker + tokens — none of those belong to the milestone-1 OOP language this + front end parses (interface/class/fn declarations and bodies), only + to rt's schema DSL. INSERT/SELECT are kept as uppercase-only keyword + stubs because Task 5 parses them into an opaque DbStub node; + lowercase `insert`/`select` fall through to Ident, exactly like rt + (CLAUDE.md gotcha — this is the whole reason Task 3 exists as a + from-scratch lexer rather than a copy of rt's). *) + +type kind = + (* literals *) + | Ident of string + | Int of int + | Str of string + (* milestone-1 keywords *) + | KwType + | KwClass + | KwInterface + | KwFn + | KwLet + | KwMut + | KwTake + | KwReturn + | KwIf + | KwElse + | KwWhile + | KwFor + | KwIn + | KwTrue + | KwFalse + (* uppercase-only SQL-layer stubs (Task 5 parses these into a DbStub + span); lowercase "insert"/"select" are plain Ident, never these. *) + | KwInsert + | KwSelect + (* punctuation / operators, mirroring rt's generic set *) + | LBrace + | RBrace + | LParen + | RParen + | LBracket + | RBracket + | Comma + | Semicolon + | Colon + | Dot + | DotDot (* .. *) + | Question + | At + | Pipe + | Arrow (* -> *) + | FatArrow (* => *) + | Dash + | Plus + | Star + | Slash + | Percent + | Eq + | EqEq + | NotEq + | Lt + | LtEq + | Gt + | GtEq + | PlusEq + | MinusEq + (* meta *) + | Newline + | Eof + +(* line and col are both 1-based, matching rt's Token and diag.ml's + site convention. *) +type t = { kind : kind; line : int; col : int } diff --git a/compiler/test/dune b/compiler/test/dune new file mode 100644 index 0000000..2a2ef11 --- /dev/null +++ b/compiler/test/dune @@ -0,0 +1,31 @@ +; Task 2 seam: a plain assert-and-print test executable wired into +; `dune runtest`, just enough to TDD compiler/src/diag.ml. Task 3 adds +; the golden-file runner (runner.ml + test/golden/ fixtures) alongside +; this file — keep this stanza minimal so that addition is additive, +; not a rewrite. +(test + (name test_diag) + (modules test_diag) + (libraries woc_lib)) + +; Task 3: golden-file runner. (deps (source_tree golden)) does two +; jobs at once: it keeps the build-directory copy of golden/ that this +; test reads from fresh on every run, and it is *why* dune notices a +; fixture edit at all -- without a declared dependency on that +; directory, dune has nothing to digest to decide this test's cached +; PASS is stale, and a changed .wo/.expected file would go unnoticed. +; WOC_BLESS=1 rewrites the real compiler/test/golden files on disk +; directly (see runner.ml's module doc for why a bare relative write +; from inside a dune test would not do that). The ../bin/woc dep is for +; the CLI smoke section: it forces the woc binary to be built before +; this test runs, and (because dune places a directory dependency's +; target at the same relative path inside the sandbox) guarantees +; "../bin/woc" resolves from this test's cwd exactly the way runner.ml +; assumes. +(test + (name runner) + (modules runner) + (libraries woc_lib) + (deps + (source_tree golden) + ../bin/woc)) diff --git a/compiler/test/golden/ast/field-named-sync-keyword.expected b/compiler/test/golden/ast/field-named-sync-keyword.expected new file mode 100644 index 0000000..e8ca4a4 --- /dev/null +++ b/compiler/test/golden/ast/field-named-sync-keyword.expected @@ -0,0 +1,6 @@ +1:1 CLASS Toggle + 2:3 FIELD id: Id + 3:3 FIELD on: Bool + 4:3 FIELD service: Text + 5:3 FIELD policy: Text + 6:3 FIELD name: Text diff --git a/compiler/test/golden/ast/field-named-sync-keyword.wo b/compiler/test/golden/ast/field-named-sync-keyword.wo new file mode 100644 index 0000000..2b5d817 --- /dev/null +++ b/compiler/test/golden/ast/field-named-sync-keyword.wo @@ -0,0 +1,14 @@ +class Toggle { + id: Id + on: Bool + service: Text + policy: Text + name: Text + + policy read anyone + + on update when old.on == false and new.on == true + do set self.name = { note: "toggled", at: now() } + + service rest "/api/toggles" expose list, get +} diff --git a/compiler/test/golden/ast/pricing-demo.expected b/compiler/test/golden/ast/pricing-demo.expected new file mode 100644 index 0000000..d47c07f --- /dev/null +++ b/compiler/test/golden/ast/pricing-demo.expected @@ -0,0 +1,24 @@ +1:1 INTERFACE Priced + 2:3 METHOD current_price() -> Money +6:1 CLASS Product @table(name="products", index=[sku]) + 7:3 FIELD id: Id + 8:3 FIELD sku: SKU @unique + 9:3 FIELD name: Text + 10:3 FIELD prices: multi Price + 11:3 FIELD owner: ref Customer + 13:3 METHOD current_price() -> Money + 14:5 RETURN latest(self.prices).amount + 17:3 METHOD rename(name: Text) + 18:5 ASSIGN self.name = name + 21:3 METHOD set_price(mut amount: Money) + 22:5 ASSIGN self.prices = amount + 25:3 METHOD adopt(take other: Product) -> Product + 26:5 RETURN other +31:1 CLASS PriceCache @gc + 32:3 FIELD entries: map +35:1 TYPE Note + 36:3 FIELD id: Id + 37:3 FIELD body: Text + 38:3 FIELD created: Timestamp = now() +41:1 METHOD discount(mut amount: Money, take pct: Int) -> Money + 42:3 RETURN amount diff --git a/compiler/test/golden/ast/pricing-demo.wo b/compiler/test/golden/ast/pricing-demo.wo new file mode 100644 index 0000000..b4d0501 --- /dev/null +++ b/compiler/test/golden/ast/pricing-demo.wo @@ -0,0 +1,43 @@ +interface Priced { + fn current_price() -> Money +} + +@table(name: "products", index: [sku]) +class Product { + id: Id + sku: SKU @unique + name: Text + prices: multi Price + owner: ref Customer + + fn current_price() -> Money { + return latest(self.prices).amount; + } + + fn rename(name: Text) { + self.name = name; + } + + fn set_price(mut amount: Money) { + self.prices = amount; + } + + fn adopt(take other: Product) -> Product { + return other; + } +} + +@gc +class PriceCache { + entries: map +} + +type Note { + id: Id + body: Text + created: Timestamp = now() +} + +fn discount(mut amount: Money, take pct: Int) -> Money { + return amount; +} diff --git a/compiler/test/golden/ast/skip-on-block.expected b/compiler/test/golden/ast/skip-on-block.expected new file mode 100644 index 0000000..2f992fc --- /dev/null +++ b/compiler/test/golden/ast/skip-on-block.expected @@ -0,0 +1,4 @@ +1:1 CLASS Article + 2:3 FIELD id: Id + 3:3 FIELD title: Text + 13:3 FIELD published: Bool = KW_FALSE diff --git a/compiler/test/golden/ast/skip-on-block.wo b/compiler/test/golden/ast/skip-on-block.wo new file mode 100644 index 0000000..d066508 --- /dev/null +++ b/compiler/test/golden/ast/skip-on-block.wo @@ -0,0 +1,14 @@ +class Article { + id: Id + title: Text + + policy read anyone + policy write for role Admin + + service rest "/api/articles" expose list, get + + on update when old.published == false and new.published == true + do set self.published_at = { article_id: self.id, at: now() } + + published: Bool = false +} diff --git a/compiler/test/golden/ast/two-error-recovery.expected b/compiler/test/golden/ast/two-error-recovery.expected new file mode 100644 index 0000000..0c370dd --- /dev/null +++ b/compiler/test/golden/ast/two-error-recovery.expected @@ -0,0 +1,2 @@ +6:1 CLASS Good + 7:3 FIELD id: Id diff --git a/compiler/test/golden/ast/two-error-recovery.wo b/compiler/test/golden/ast/two-error-recovery.wo new file mode 100644 index 0000000..0339175 --- /dev/null +++ b/compiler/test/golden/ast/two-error-recovery.wo @@ -0,0 +1,12 @@ +class Broken1 { + id: Id + bad_field Text +} + +class Good { + id: Id +} + +interface Broken2 { + fn oops(x Text) -> Money +} diff --git a/compiler/test/golden/tokens/dangling-escape.expected b/compiler/test/golden/tokens/dangling-escape.expected new file mode 100644 index 0000000..aee7bb4 --- /dev/null +++ b/compiler/test/golden/tokens/dangling-escape.expected @@ -0,0 +1,5 @@ +1:1 KW_LET +1:5 IDENT(bad) +1:9 EQ +1:11 STR(abc) +1:16 EOF diff --git a/compiler/test/golden/tokens/dangling-escape.wo b/compiler/test/golden/tokens/dangling-escape.wo new file mode 100644 index 0000000..a07c5ff --- /dev/null +++ b/compiler/test/golden/tokens/dangling-escape.wo @@ -0,0 +1 @@ +let bad = "abc\ \ No newline at end of file diff --git a/compiler/test/golden/tokens/dash-continuation.expected b/compiler/test/golden/tokens/dash-continuation.expected new file mode 100644 index 0000000..1d8a108 --- /dev/null +++ b/compiler/test/golden/tokens/dash-continuation.expected @@ -0,0 +1,7 @@ +1:1 IDENT(a-b) +1:4 NEWLINE +2:1 IDENT(a) +2:3 DASH +2:5 IDENT(b) +2:6 NEWLINE +3:1 EOF diff --git a/compiler/test/golden/tokens/dash-continuation.wo b/compiler/test/golden/tokens/dash-continuation.wo new file mode 100644 index 0000000..ec7aed6 --- /dev/null +++ b/compiler/test/golden/tokens/dash-continuation.wo @@ -0,0 +1,2 @@ +a-b +a - b diff --git a/compiler/test/golden/tokens/gotcha.expected b/compiler/test/golden/tokens/gotcha.expected new file mode 100644 index 0000000..76768dc --- /dev/null +++ b/compiler/test/golden/tokens/gotcha.expected @@ -0,0 +1,28 @@ +1:58 NEWLINE +2:1 IDENT(self) +2:6 IDENT(me) +2:9 IDENT(subscribe) +2:19 IDENT(receive) +2:27 IDENT(insert) +2:34 IDENT(select) +2:40 NEWLINE +3:1 KW_TYPE +3:6 KW_CLASS +3:12 KW_INTERFACE +3:22 KW_FN +3:25 KW_LET +3:29 KW_MUT +3:33 KW_TAKE +3:38 KW_RETURN +3:45 KW_IF +3:48 KW_ELSE +3:53 KW_WHILE +3:59 KW_FOR +3:63 KW_IN +3:66 KW_TRUE +3:71 KW_FALSE +3:76 NEWLINE +4:1 KW_INSERT +4:8 KW_SELECT +4:14 NEWLINE +5:1 EOF diff --git a/compiler/test/golden/tokens/gotcha.wo b/compiler/test/golden/tokens/gotcha.wo new file mode 100644 index 0000000..fdfa6fc --- /dev/null +++ b/compiler/test/golden/tokens/gotcha.wo @@ -0,0 +1,4 @@ +-- gotcha fixture: keyword vs plain-identifier boundaries +self me subscribe receive insert select +type class interface fn let mut take return if else while for in true false +INSERT SELECT diff --git a/compiler/test/golden/tokens/representative.expected b/compiler/test/golden/tokens/representative.expected new file mode 100644 index 0000000..d2048fc --- /dev/null +++ b/compiler/test/golden/tokens/representative.expected @@ -0,0 +1,169 @@ +1:88 NEWLINE +2:1 AT +2:2 IDENT(table) +2:7 LPAREN +2:8 IDENT(name) +2:12 COLON +2:14 STR(products) +2:24 COMMA +2:26 IDENT(index) +2:31 COLON +2:33 LBRACKET +2:34 IDENT(name) +2:38 RBRACKET +2:39 RPAREN +2:40 NEWLINE +3:1 KW_CLASS +3:7 IDENT(Product) +3:15 LBRACE +3:16 NEWLINE +4:3 KW_LET +4:7 IDENT(name) +4:11 COLON +4:13 IDENT(Text) +4:18 EQ +4:20 STR(widget) +4:28 NEWLINE +5:3 KW_LET +5:7 IDENT(price) +5:12 COLON +5:14 IDENT(Int) +5:18 EQ +5:20 INT(42) +5:22 NEWLINE +6:3 KW_LET +6:7 IDENT(tags) +6:11 COLON +6:13 LBRACKET +6:14 IDENT(Text) +6:18 RBRACKET +6:20 EQ +6:22 LBRACKET +6:23 RBRACKET +6:24 NEWLINE +7:3 KW_LET +7:7 IDENT(in_stock) +7:15 COLON +7:17 IDENT(Bool) +7:22 EQ +7:24 KW_TRUE +7:28 NEWLINE +9:3 KW_FN +9:6 IDENT(discounted) +9:16 LPAREN +9:17 IDENT(pct) +9:20 COLON +9:22 IDENT(Int) +9:25 RPAREN +9:27 ARROW +9:30 IDENT(Int) +9:34 LBRACE +9:35 NEWLINE +10:5 KW_LET +10:9 IDENT(cut) +10:13 EQ +10:15 IDENT(self) +10:19 DOT +10:20 IDENT(price) +10:26 STAR +10:28 IDENT(pct) +10:32 SLASH +10:34 INT(100) +10:37 NEWLINE +11:5 KW_IF +11:8 IDENT(cut) +11:12 GTEQ +11:15 IDENT(self) +11:19 DOT +11:20 IDENT(price) +11:26 LBRACE +11:27 NEWLINE +12:7 KW_RETURN +12:14 INT(0) +12:15 NEWLINE +13:5 RBRACE +13:7 KW_ELSE +13:12 LBRACE +13:13 NEWLINE +14:7 KW_RETURN +14:14 IDENT(self) +14:18 DOT +14:19 IDENT(price) +14:25 DASH +14:27 IDENT(cut) +14:30 NEWLINE +15:5 RBRACE +15:6 NEWLINE +16:3 RBRACE +16:4 NEWLINE +18:3 KW_FN +18:6 IDENT(total) +18:11 LPAREN +18:12 IDENT(counts) +18:18 COLON +18:20 LBRACKET +18:21 IDENT(Int) +18:24 RBRACKET +18:25 RPAREN +18:27 ARROW +18:30 IDENT(Int) +18:34 LBRACE +18:35 NEWLINE +19:5 KW_LET +19:9 IDENT(sum) +19:13 EQ +19:15 INT(0) +19:16 NEWLINE +20:5 KW_FOR +20:9 IDENT(n) +20:11 KW_IN +20:14 IDENT(counts) +20:21 LBRACE +20:22 NEWLINE +21:7 IDENT(sum) +21:11 EQ +21:13 IDENT(sum) +21:17 PLUS +21:19 IDENT(n) +21:20 NEWLINE +22:5 RBRACE +22:6 NEWLINE +23:5 KW_RETURN +23:12 IDENT(sum) +23:15 NEWLINE +24:3 RBRACE +24:4 NEWLINE +26:3 KW_FN +26:6 IDENT(clearance) +26:15 LPAREN +26:16 RPAREN +26:18 ARROW +26:21 IDENT(Bool) +26:26 LBRACE +26:27 NEWLINE +27:5 KW_LET +27:9 IDENT(ok) +27:12 EQ +27:14 IDENT(self) +27:18 DOT +27:19 IDENT(price) +27:25 LTEQ +27:28 INT(50) +27:30 NEWLINE +28:5 KW_WHILE +28:11 IDENT(ok) +28:14 LBRACE +28:15 NEWLINE +29:7 KW_RETURN +29:14 KW_FALSE +29:19 NEWLINE +30:5 RBRACE +30:6 NEWLINE +31:5 KW_RETURN +31:12 IDENT(ok) +31:14 NEWLINE +32:3 RBRACE +32:4 NEWLINE +33:1 RBRACE +33:2 NEWLINE +34:1 EOF diff --git a/compiler/test/golden/tokens/representative.wo b/compiler/test/golden/tokens/representative.wo new file mode 100644 index 0000000..da54a95 --- /dev/null +++ b/compiler/test/golden/tokens/representative.wo @@ -0,0 +1,33 @@ +-- representative token fixture: comments, newlines, literals, annotations, punctuation +@table(name: "products", index: [name]) +class Product { + let name: Text = "widget" + let price: Int = 42 + let tags: [Text] = [] + let in_stock: Bool = true + + fn discounted(pct: Int) -> Int { + let cut = self.price * pct / 100 + if cut >= self.price { + return 0 + } else { + return self.price - cut + } + } + + fn total(counts: [Int]) -> Int { + let sum = 0 + for n in counts { + sum = sum + n + } + return sum + } + + fn clearance() -> Bool { + let ok = self.price <= 50 + while ok { + return false + } + return ok + } +} diff --git a/compiler/test/golden/tokens/unknown-char.expected b/compiler/test/golden/tokens/unknown-char.expected new file mode 100644 index 0000000..9f5ed3f --- /dev/null +++ b/compiler/test/golden/tokens/unknown-char.expected @@ -0,0 +1,7 @@ +1:1 KW_LET +1:5 IDENT(x) +1:7 EQ +1:9 INT(1) +1:13 INT(2) +1:14 NEWLINE +2:1 EOF diff --git a/compiler/test/runner.ml b/compiler/test/runner.ml new file mode 100644 index 0000000..3e6eee0 --- /dev/null +++ b/compiler/test/runner.ml @@ -0,0 +1,876 @@ +(* runner.ml — golden-file test runner (Task 3 onward). + + Contract (compiler/plan/2026-08-01-woc-compiler-front.md Task 3): + walks compiler/test/golden// directories; for every + .wo file in a stage directory, runs the pipeline stage that + directory's dump flag names and diffs the produced text against + .expected. A mismatch prints a line-based diff; the run exits + nonzero if anything mismatched. WOC_BLESS=1 rewrites .expected + to the freshly produced text instead of comparing — used once, by + hand, to seed or intentionally update a fixture; every commit ships + with the runner GREEN against whatever it last wrote. + + Wired into `dune runtest` alongside test_diag.ml (see test/dune). + + -- Why this file resolves two different "golden root" paths -- + + `dune runtest` runs this executable with its current directory set + to the *build* copy of test/ (e.g. ".../compiler/_build/default/test"), + not the real source directory — verified empirically: a file written + via a bare relative path while running under `dune runtest` lands + under _build/default and is silently discarded (or stale-overwritten) + on the next build. Reading fixtures from the plain relative "golden" + path is fine — test/dune declares `(deps (source_tree golden))`, + which both (a) keeps that build-directory copy fresh from the real + source on every run, since dune must digest that dependency to + decide whether to re-run this test's action at all, and (b) is + itself the reason editing a fixture actually invalidates a + previously-cached PASS. But WOC_BLESS=1 rewriting *that* copy would + vanish — the whole point of bless mode is to update the fixture git + tracks. So bless-mode writes instead go through [source_golden_dir], + which walks back out of "_build/default" to the real + compiler/test/golden on disk. *) + +module Diag = Woc_lib.Diag +module Token = Woc_lib.Token +module Lexer = Woc_lib.Lexer +module Ast = Woc_lib.Ast +module Parser = Woc_lib.Parser +module Dump = Woc_lib.Dump + +let read_file path = + let ic = open_in_bin path in + let n = in_channel_length ic in + let s = really_input_string ic n in + close_in ic; + s + +let write_file path contents = + let oc = open_out_bin path in + output_string oc contents; + close_out oc + +(* Manual substring search: no Str/Re library (this project is + stdlib-only), and this is the only place a substring search is + needed. Fine for the short, one-shot haystack (a cwd path) this is + used on. *) +let find_substring ~needle haystack = + let hlen = String.length haystack and nlen = String.length needle in + let rec go i = + if i + nlen > hlen then None + else if String.sub haystack i nlen = needle then Some i + else go (i + 1) + in + go 0 + +(* The real, on-disk compiler/test/golden — see module doc above. Falls + back to a short list of plausible relative paths for a manual + (non-dune) invocation, where cwd is wherever the caller's shell + already is. *) +let source_golden_dir () = + match Sys.getenv_opt "WOC_GOLDEN_DIR" with + | Some dir -> dir + | None -> ( + let cwd = Sys.getcwd () in + let marker = "_build/default/" in + match find_substring ~needle:marker cwd with + | Some idx -> String.sub cwd 0 idx ^ "test/golden" + | None -> ( + let candidates = [ "golden"; "test/golden"; "compiler/test/golden" ] in + match List.find_opt Sys.file_exists candidates with + | Some dir -> dir + | None -> + failwith + "runner: cannot locate compiler/test/golden (set WOC_GOLDEN_DIR)")) + +let bless = Sys.getenv_opt "WOC_BLESS" = Some "1" +let checks = ref 0 +let failures = ref 0 + +let check name cond = + incr checks; + if not cond then begin + incr failures; + Printf.printf "FAIL: %s\n" name + end + +let check_eq name ~expected ~actual to_string = + incr checks; + if expected <> actual then begin + incr failures; + Printf.printf "FAIL: %s\n expected: %s\n actual: %s\n" name + (to_string expected) (to_string actual) + end + +(* ---- direct lexer assertions (not golden-diffed) ------------------- + + golden/tokens/gotcha.wo and unknown-char.wo already pin the token + *stream* for these cases, but a token dump alone can't distinguish + "no diagnostic was raised" from "one was raised and silently + dropped" — both look identical in the dump (the bad character is + just absent either way). These assertions pin the diagnostic side + of the WO-E001 contract directly against the Collector. *) + +let () = + let collector = Diag.Collector.create () in + let toks = + Lexer.tokenize collector ~file:"gotcha.wo" + "self me subscribe receive insert select" + in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check + "gotcha: self/me/subscribe/receive/insert/select all lex as Ident" + (kinds + = [ + Token.Ident "self"; + Token.Ident "me"; + Token.Ident "subscribe"; + Token.Ident "receive"; + Token.Ident "insert"; + Token.Ident "select"; + Token.Eof; + ]) + +let () = + let collector = Diag.Collector.create () in + let toks = + Lexer.tokenize collector ~file:"gotcha.wo" "INSERT SELECT type class" + in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check "gotcha: uppercase INSERT/SELECT and type/class lex as keywords" + (kinds = [ Token.KwInsert; Token.KwSelect; Token.KwType; Token.KwClass; Token.Eof ]) + +let () = + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:"bad.wo" "let x = 1 ~ 2" in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check "unknown char: skipped, never appears as a token" + (kinds + = [ Token.KwLet; Token.Ident "x"; Token.Eq; Token.Int 1; Token.Int 2; Token.Eof ]); + let diags = Diag.Collector.diagnostics collector in + check_eq "unknown char: exactly one diagnostic reported" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "unknown char: WO-E001 at the '~' position (line 1, col 11)" + (d.code = "WO-E001" && d.site.line = 1 && d.site.col = 11) + | _ -> check "unknown char: diagnostic shape" false + +let () = + (* golden/tokens/dangling-escape.wo opens a string and ends the file + on a lone backslash, with no character left to escape it. Read + from disk rather than duplicated as a literal so this assertion + and the golden dump can never silently drift apart from the + actual fixture bytes (the file has no trailing newline on purpose + -- its very last byte must be the backslash). *) + let path = "golden/tokens/dangling-escape.wo" in + let src = read_file path in + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:path src in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check + "dangling escape: string closes with whatever was collected before \ + the backslash" + (kinds + = [ Token.KwLet; Token.Ident "bad"; Token.Eq; Token.Str "abc"; Token.Eof ]); + let diags = Diag.Collector.diagnostics collector in + check_eq "dangling escape: exactly one diagnostic reported" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "dangling escape: WO-E002 at the backslash's position (line 1, col 15)" + (d.code = "WO-E002" && d.site.line = 1 && d.site.col = 15) + | _ -> check "dangling escape: diagnostic shape" false + +let () = + (* Deliberate asymmetry with the case above (see + unterminated_escape_code's doc comment in lexer.ml): a plain + unterminated string -- no dangling backslash, it simply runs off + the end of the source with no closing quote at all -- is rt-parity + silent. Pinned inline (no fixture file needed for this half) so + nothing starts reporting a diagnostic here without this test + noticing. *) + let collector = Diag.Collector.create () in + let toks = + Lexer.tokenize collector ~file:"plain.wo" "let plain = \"never closed" + in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check + "plain unterminated string: closes with all collected content, no \ + diagnostic" + (kinds + = [ + Token.KwLet; + Token.Ident "plain"; + Token.Eq; + Token.Str "never closed"; + Token.Eof; + ]); + check_eq "plain unterminated string: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int + +let () = + (* Faithful rt port (crates/rt/src/lexer.rs read_ident_chars): an + identifier's continuation characters include '-', so `a-b` lexes + as one Ident, not Ident/Dash/Ident. Pinned here so nothing "fixes" + this away before Task 5 decides how its expression grammar wants + binary minus to interact with it (see lexer.ml's module doc for + the forward-looking concern this raises). golden/tokens/ + dash-continuation.wo pins the same two shapes as a dump diff. *) + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:"dash.wo" "a-b" in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check "dash-continuation: a-b (no spaces) lexes as one Ident" + (kinds = [ Token.Ident "a-b"; Token.Eof ]) + +let () = + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:"dash.wo" "a - b" in + let kinds = List.map (fun (t : Token.t) -> t.kind) toks in + check "dash-continuation: a - b (spaced) lexes as Ident, Dash, Ident" + (kinds = [ Token.Ident "a"; Token.Dash; Token.Ident "b"; Token.Eof ]) + +(* ---- direct parser/AST assertions (Task 4, not golden-diffed) ------------ + + golden/ast/*.wo fixtures already pin the AST *shape* via --dump-ast, + but a dump alone can't distinguish "no diagnostic was raised" from + "one was raised and silently dropped" (dump.ml's spec: node ids are + deliberately never printed), and it can't see the AST's `id`/`conv`/ + `default` fields directly. These assertions pin the parts of the + Task 4 contract a text dump structurally cannot show. *) + +let parse_str ~file src = + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file src in + let prog = Parser.parse collector ~file toks in + (prog, collector) + +let () = + (* golden/ast/two-error-recovery.wo: `class Broken1` has a malformed + field (`bad_field Text`, missing ':'), `class Good` in between is + well-formed, `interface Broken2` has a malformed signature + (`x Text` instead of `x: Text`). The dump golden already shows only + `Good` survives; this assertion is the load-bearing half: exactly + two diagnostics (not a cascade from either broken declaration), + both WO-E101 syntax errors, each at the actual offending token. *) + let path = "golden/ast/two-error-recovery.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + check "recovery: exactly one surviving declaration (`Good`)" + (match prog.Ast.decls with + | [ Ast.Class c ] -> c.name = "Good" + | _ -> false); + let diags = Diag.Collector.diagnostics collector in + check_eq "recovery: exactly two diagnostics reported (one per broken decl)" + ~expected:2 ~actual:(List.length diags) string_of_int; + match diags with + | [ d1; d2 ] -> + check "recovery: first diagnostic is WO-E101 at `bad_field` (line 3, col 3)" + (d1.code = "WO-E101" && d1.site.line = 3 && d1.site.col = 3); + check "recovery: second diagnostic is WO-E101 at the bad param type (line 11, col 13)" + (d2.code = "WO-E101" && d2.site.line = 11 && d2.site.col = 13) + | _ -> check "recovery: diagnostic shape" false + +let () = + (* golden/ast/body-recovery.wo (Task 5): `fn oops` has two malformed + statement bodies (`let bad1 = ;` — missing expression before the + terminator — and `return bad2 +` — missing the `+`'s right-hand + operand), each surrounded by well-formed `let` statements. The + dump golden already shows only `ok1`/`ok2` surviving; this is the + load-bearing half proving that's *recovery* (one diagnostic per + broken statement, syncing at the next newline/semicolon per the + brief) and not a silent drop or a cascade. *) + let path = "golden/ast/body-recovery.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + check "body-recovery: exactly one surviving fn (`oops`)" + (match prog.Ast.decls with + | [ Ast.Fn m ] -> m.name = "oops" + | _ -> false); + let diags = Diag.Collector.diagnostics collector in + check_eq "body-recovery: exactly two diagnostics reported (one per broken statement)" + ~expected:2 ~actual:(List.length diags) string_of_int; + (match prog.Ast.decls with + | [ Ast.Fn m ] -> + check "body-recovery: both `let` statements survive, in order" + (List.map + (fun (s : Ast.stmt) -> + match s.Ast.s_kind with Ast.Let { name; _ } -> name | _ -> "?") + m.body + = [ "ok1"; "ok2" ]) + | _ -> check "body-recovery: exactly one surviving fn" false); + match diags with + | [ d1; d2 ] -> + check "body-recovery: first diagnostic is WO-E101 at the missing `let` value (line 3, col 14)" + (d1.code = "WO-E101" && d1.site.line = 3 && d1.site.col = 14); + check "body-recovery: second diagnostic is WO-E101 after the dangling `+` (line 5, col 16)" + (d2.code = "WO-E101" && d2.site.line = 5 && d2.site.col = 16) + | _ -> check "body-recovery: diagnostic shape" false + +let () = + (* golden/ast/skip-on-block.wo: a policy/service/on-block-laden class + body. The dump golden shows exactly 3 fields and 0 methods survive + (the load-bearing brace-depth counter finding the object literal's + own close, not the type's); this assertion pins the other half — + zero diagnostics (the skip is a deliberate, silent no-op, not a + recovered error) and re-confirms shape at the AST level directly. *) + let path = "golden/ast/skip-on-block.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + check_eq "skip-on-block: reports nothing (silent skip, not recovery)" + ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + (match prog.Ast.decls with + | [ Ast.Class c ] -> + check "skip-on-block: field names/order survive policy/service/on" + (List.map (fun (f : Ast.field) -> f.name) c.fields = [ "id"; "title"; "published" ]); + check "skip-on-block: no methods (none were declared)" (c.methods = []) + | _ -> check "skip-on-block: exactly one class declaration" false) + +let () = + (* Coordinator-review finding: `on`/`service`/`policy` are plain Idents + (Task 3 deliberately keeps them usable as identifiers), so a FIELD + literally named one of them (`on: Bool`) must not be swallowed by + the skip-on-block interpretation just because its name matches — + only its *shape* (no Colon right after) means "this is a + service/policy/on block". golden/ast/field-named-sync-keyword.wo + puts fields named on/service/policy in the SAME class body as real + `policy ...`, `on ... do ...`, and `service rest ...` blocks, so + this one fixture proves both halves at once: the fields all survive + (this assertion), and the genuine blocks still correctly disappear + (the golden dump for this fixture shows only 5 fields, 0 methods, + nothing leaking from the skipped blocks) — while + golden/ast/skip-on-block.wo above continues to prove the reverse + case (genuine blocks, no fields sharing their names) stays green. *) + let path = "golden/ast/field-named-sync-keyword.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + check_eq "field-named-sync-keyword: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Class c ] -> + check + "field-named-sync-keyword: fields named on/service/policy all survive, in order" + (List.map (fun (f : Ast.field) -> f.name) c.fields + = [ "id"; "on"; "service"; "policy"; "name" ]); + check "field-named-sync-keyword: no methods (none were declared)" (c.methods = []) + | _ -> check "field-named-sync-keyword: exactly one class declaration" false + +let () = + (* Param conventions (Task 4 brief: bare = borrow, `mut`, `take`) — + pinned directly against Ast.param.conv, not just the dump's text + rendering of it. *) + let prog, _ = + parse_str ~file:"conv.wo" "fn f(a: Int, mut b: Int, take c: Int) -> Int {\n return a;\n}\n" + in + match prog.Ast.decls with + | [ Ast.Fn m ] -> + check "param conventions: bare/mut/take parsed in order" + (List.map (fun (p : Ast.param) -> p.conv) m.params = [ Ast.Borrow; Ast.Mut; Ast.Take ]) + | _ -> check "param conventions: exactly one free fn" false + +let () = + (* `= now()` is DefaultNow; anything else is DefaultOpaque carrying + the raw token span (Task 4 brief, ported from rt's DefaultExpr::Now + vs ::Opaque). Pinned at the AST level, not just via dump text. *) + let prog, _ = + parse_str ~file:"defaults.wo" + "type T {\n created: Timestamp = now()\n active: Bool = true\n}\n" + in + match prog.Ast.decls with + | [ Ast.Class c ] -> ( + match c.fields with + | [ f1; f2 ] -> + check "default now(): recognized as DefaultNow" (f1.default = Some Ast.DefaultNow); + check "default true: opaque token span, not DefaultNow" + (match f2.default with + | Some (Ast.DefaultOpaque [ { Token.kind = Token.KwTrue; _ } ]) -> true + | _ -> false) + | _ -> check "defaults: exactly two fields" false) + | _ -> check "defaults: exactly one type declaration" false + +let () = + (* @table's known keys (name/index) round-trip; an unknown key is a + parse error under its own code (WO-E102), distinct from the + generic WO-E101 syntax-error code — mirrors Task 3's WO-E001/002 + split (one code per distinct situation, not one catch-all). *) + let prog, collector = + parse_str ~file:"table.wo" + "@table(name: \"prices\", index: [sku, at])\nclass Price {\n id: Id\n}\n" + in + check_eq "@table: no diagnostics on a well-formed configuration" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + (match prog.Ast.decls with + | [ Ast.Class c ] -> + check "@table: name and index captured" + (match c.table with + | Some { Ast.table_name = Some "prices"; indexes = [ [ "sku"; "at" ] ] } -> true + | _ -> false) + | _ -> check "@table: exactly one class" false); + let _, bad_collector = parse_str ~file:"bad-table.wo" "@table(shard_key: sku)\ntype T {\n id: Id\n}\n" in + let bad_diags = Diag.Collector.diagnostics bad_collector in + check_eq "@table: unknown key reports exactly one diagnostic" ~expected:1 + ~actual:(List.length bad_diags) string_of_int; + match bad_diags with + | [ d ] -> check "@table: unknown key is WO-E102, not the generic WO-E101" (d.code = "WO-E102") + | _ -> check "@table: unknown-key diagnostic shape" false + +let () = + (* Node ids: unique across a parse and, for every container relative + to its own children, strictly smaller (Task 4 decision: a + container's id is minted once its head is confirmed and before its + body is parsed, uniformly for class/interface/method/fn — see + parser.ml's parse_sig_head comment). Collected by hand here rather + than depending on any future Ast-walking helper, since Task 4 + doesn't ship one. *) + let prog, _ = parse_str ~file:"ids.wo" (read_file "golden/ast/pricing-demo.wo") in + let ids = ref [] in + let add id = ids := id :: !ids in + let visit_param (p : Ast.param) = add p.id in + let visit_field (f : Ast.field) = add f.id in + let visit_method (m : Ast.method_decl) = + check + (Printf.sprintf "node ids: method `%s` id < all its param ids" m.name) + (List.for_all (fun (p : Ast.param) -> m.id < p.id) m.params); + add m.id; + List.iter visit_param m.params + in + let visit_sig (s : Ast.method_sig) = + check + (Printf.sprintf "node ids: interface method `%s` id < all its param ids" s.name) + (List.for_all (fun (p : Ast.param) -> s.id < p.id) s.params); + add s.id; + List.iter visit_param s.params + in + List.iter + (fun (d : Ast.decl) -> + match d with + | Ast.Class c -> + check + (Printf.sprintf "node ids: class/type `%s` id < all its field/method ids" c.name) + (List.for_all (fun (f : Ast.field) -> c.id < f.id) c.fields + && List.for_all (fun (m : Ast.method_decl) -> c.id < m.id) c.methods); + add c.id; + List.iter visit_field c.fields; + List.iter visit_method c.methods + | Ast.Interface i -> + check + (Printf.sprintf "node ids: interface `%s` id < all its method ids" i.name) + (List.for_all (fun (s : Ast.method_sig) -> i.id < s.id) i.methods); + add i.id; + List.iter visit_sig i.methods + | Ast.Fn m -> visit_method m) + prog.Ast.decls; + let sorted = List.sort compare !ids in + let deduped = List.sort_uniq compare !ids in + check "node ids: every id in the tree is unique" (List.length sorted = List.length deduped) + +(* ---- statement/expression parser (Task 5, not golden-diffed) ------------ + + golden/ast/{body-statements,ctor-literal,db-stub,body-recovery}.wo + already pin the dump-text shape; these assertions pin the parts a + text dump structurally cannot show — the precedence ladder's actual + tree shape, and the insert/select asymmetry (statement-only vs. + statement-and-expression), same rationale as Task 4's own direct + assertions above. *) + +let () = + (* Precedence ladder (parser.ml's parse_expr chain): comparison is + loosest, then concat, then additive, then multiplicative, then + unary — so `1 + 2 * 3 == 4 .. "x"` must parse as + `Eq(Add(1, Mul(2,3)), Concat(4, "x"))`, not e.g. `Mul` grabbing + `2 * (3 == 4)` or concat binding tighter than `+`. *) + let prog, _ = parse_str ~file:"prec.wo" "fn f() {\n return 1 + 2 * 3 == 4 .. \"x\"\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some e); _ } ] -> ( + match e.Ast.kind with + | Ast.Binary + ( Ast.Eq, + { Ast.kind = Ast.Binary (Ast.Add, { Ast.kind = Ast.IntLit 1; _ }, add_rhs); _ }, + { Ast.kind = Ast.Binary (Ast.Concat, { Ast.kind = Ast.IntLit 4; _ }, concat_rhs); _ } + ) -> + check "precedence: `2 * 3` is the addition's right operand, not split by `==`" + (match add_rhs.Ast.kind with + | Ast.Binary (Ast.Mul, { Ast.kind = Ast.IntLit 2; _ }, { Ast.kind = Ast.IntLit 3; _ }) -> + true + | _ -> false); + check "precedence: concat's right operand is the string literal" + (match concat_rhs.Ast.kind with Ast.StrLit "x" -> true | _ -> false) + | _ -> check "precedence: top-level operator is `==` over an `Add` and a `Concat`" false) + | _ -> check "precedence: exactly one `return` statement" false) + | _ -> check "precedence: exactly one free fn" false + +let () = + (* Constructor literal: `ClassName { field: expr, ... }`, recognized + by the identifier-then-brace shape in expression position (Task 5 + brief). Pinned directly against Ast.Ctor, not just dump text. *) + let prog, _ = parse_str ~file:"ctor.wo" "fn f() {\n let w = Widget { a: 1, b: 2 }\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Let { value = { Ast.kind = Ast.Ctor (name, fields); _ }; _ }; _ } ] -> + check "ctor literal: class name captured" (name = "Widget"); + check "ctor literal: field names/order captured" + (List.map fst fields = [ "a"; "b" ]) + | _ -> check "ctor literal: exactly one `let` binding a Ctor" false) + | _ -> check "ctor literal: exactly one free fn" false + +let () = + (* The brief's stated asymmetry: `insert` is a statement-only trigger + (parser.ml's is_insert_trigger, checked only in parse_stmt) — a + bare `insert` reached from parse_primary is just an ordinary + identifier reference, exactly like self/me/on/service/policy's own + "recognized positionally, not a reserved word" rule (this task's + own keyword-discipline note). `select` (is_select_trigger) is + checked unconditionally *inside* parse_primary, so the same + position always builds a DbStub instead. Neither is an error on + its own — the difference shows up in which Ast.expr_kind comes + back. *) + let prog, collector = + parse_str ~file:"insert-vs-select.wo" "fn f() {\n let a = insert\n let b = select\n}\n" + in + check_eq "insert vs. select as bare expressions: no diagnostics" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ + { Ast.s_kind = Ast.Let { name = "a"; value = a_val; _ }; _ }; + { Ast.s_kind = Ast.Let { name = "b"; value = b_val; _ }; _ }; + ] -> + check "bare `insert` in expression position is a plain Ident" + (match a_val.Ast.kind with Ast.Ident "insert" -> true | _ -> false); + check "bare `select` in expression position always becomes a DbStub" + (match b_val.Ast.kind with Ast.DbStub _ -> true | _ -> false) + | _ -> check "insert vs. select: exactly two `let` statements" false) + | _ -> check "insert vs. select: exactly one free fn" false + +let () = + (* The no_brace guard (parser.ml's state.no_brace / looks_like_ctor): + a bare identifier condition immediately followed by `{` is the + if-statement's own block, never a constructor literal — pinned + directly against the AST shape (Ast.Ident, not Ast.Ctor), + complementing golden/ast/ctor-literal.wo's dump-level coverage. *) + let prog, collector = parse_str ~file:"no-brace.wo" "fn f(active: Bool) {\n if active {\n return\n }\n}\n" in + check_eq "no_brace guard: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.If { cond; _ }; _ } ] -> + check "no_brace guard: if-condition is the bare ident, not a Ctor" + (match cond.Ast.kind with Ast.Ident "active" -> true | _ -> false) + | _ -> check "no_brace guard: exactly one `if` statement" false) + | _ -> check "no_brace guard: exactly one free fn" false + +(* ---- fix round 1 regressions (post-review CRITICAL 1/2/3) --------------- + + golden/ast/{condition-recovery,db-stub-nested}.wo and the extra + if-conditions added to golden/ast/ctor-literal.wo already pin the + dump-text shape; these assertions pin the parts a dump alone can't + show — diagnostic counts, and (for CRITICAL 1) the concrete AST node + kind that proves state.no_brace was actually restored rather than + merely "looking right" in rendered text. *) + +let () = + (* CRITICAL 1: state.no_brace's save/restore was not exception-safe — + a failed if/while/for condition left it stuck at `true`, so every + constructor literal for the rest of the file silently stopped + parsing as one (it fell back to a bare Ident, desyncing the parse + of whatever followed). golden/ast/condition-recovery.wo's `if 1 + + {` fails inside its own condition; the fix (parser.ml's + with_no_brace, using Fun.protect) must restore no_brace before the + Parse_error reaches parse_block's recovery, so the very next + statement's constructor literal still parses as one. *) + let path = "golden/ast/condition-recovery.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + let diags = Diag.Collector.diagnostics collector in + check_eq "condition-recovery: exactly one diagnostic (the broken condition, not a cascade)" + ~expected:1 ~actual:(List.length diags) string_of_int; + (match diags with + | [ d ] -> check "condition-recovery: WO-E101" (d.code = "WO-E101") + | _ -> check "condition-recovery: diagnostic shape" false); + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Let { name = "w"; value; _ }; _ } ] -> + check "condition-recovery: no_brace was restored — `Widget {...}` after the \ + broken condition is still a real Ctor, not a bare Ident" + (match value.Ast.kind with Ast.Ctor ("Widget", [ ("a", _) ]) -> true | _ -> false) + | _ -> check "condition-recovery: exactly one surviving `let w = ...`" false) + | _ -> check "condition-recovery: exactly one surviving fn" false + +let () = + (* CRITICAL 2: collect_dbstub_tokens only had a depth-0 stop guard on + RBrace, so a `select`/`insert` nested inside an enclosing call or + index expression had no way to stop at that call/index's own `)`/ + `]` — it swallowed everything to Eof. golden/ast/db-stub-nested.wo + nests `select` inside both a call argument and an index + expression, followed by an unrelated `let done_marker = 1`; if the + scan ran away, done_marker would never be parsed (or the file + would end on a misleading "expected ')'/'], got EOF" diagnostic + instead of the three clean statements below). *) + let path = "golden/ast/db-stub-nested.wo" in + let src = read_file path in + let prog, collector = parse_str ~file:path src in + check_eq "db-stub-nested: reports nothing (both selects terminate at their own delimiter)" + ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ + { Ast.s_kind = Ast.Let { name = "wrapped"; value = wrapped_val; _ }; _ }; + { Ast.s_kind = Ast.Let { name = "arr"; value = arr_val; _ }; _ }; + { Ast.s_kind = Ast.Let { name = "done_marker"; value = done_val; _ }; _ }; + ] -> + check "db-stub-nested: `select` inside a call argument is a DbStub, and the \ + call's own `)` still closed the call" + (match wrapped_val.Ast.kind with + | Ast.Call ({ Ast.kind = Ast.Ident "wrap"; _ }, [ { Ast.kind = Ast.DbStub _; _ } ]) -> + true + | _ -> false); + check "db-stub-nested: `select` inside an index expression is a DbStub, and the \ + index's own `]` still closed it" + (match arr_val.Ast.kind with + | Ast.Index ({ Ast.kind = Ast.Ident "data"; _ }, { Ast.kind = Ast.DbStub _; _ }) -> true + | _ -> false); + check "db-stub-nested: parsing continued past both closing delimiters — \ + `done_marker` is a normal IntLit, not swallowed or corrupted" + (match done_val.Ast.kind with Ast.IntLit 1 -> true | _ -> false) + | _ -> check "db-stub-nested: exactly three surviving `let` statements" false) + | _ -> check "db-stub-nested: exactly one surviving fn" false + +let () = + (* CRITICAL 3: no_brace was only ever reset to `false` in + parse_primary's own LParen branch — never in parse_call_args or + parse_postfix's LBracket branch — so a constructor literal used as + a call argument or index expression *inside* an if/while/for + condition was never recognized as one (it hit looks_like_ctor's + `not st.no_brace` guard, which was still `true`), corrupting the + rest of the condition's parse. golden/ast/ctor-literal.wo already + pins the dump-text shape for both; these assertions pin the + concrete Ctor nodes directly. *) + let prog, collector = + parse_str ~file:"ctor-in-call-and-index.wo" + "fn f(mut active: Bool) {\n\ + \ if make(Widget { x: 1 }) {\n\ + \ return\n\ + \ }\n\ + \ if items[Widget { x: 1 }] {\n\ + \ return\n\ + \ }\n\ + }\n" + in + check_eq "ctor in call/index inside a condition: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.If { cond = call_cond; _ }; _ }; { Ast.s_kind = Ast.If { cond = idx_cond; _ }; _ } ] + -> + check "ctor as a call argument inside a condition is a real Ctor node" + (match call_cond.Ast.kind with + | Ast.Call (_, [ { Ast.kind = Ast.Ctor ("Widget", _); _ } ]) -> true + | _ -> false); + check "ctor as an index expression inside a condition is a real Ctor node" + (match idx_cond.Ast.kind with + | Ast.Index (_, { Ast.kind = Ast.Ctor ("Widget", _); _ }) -> true + | _ -> false) + | _ -> check "ctor in call/index inside a condition: exactly two `if` statements" false) + | _ -> check "ctor in call/index inside a condition: exactly one free fn" false + +(* ---- CLI smoke ------------------------------------------------------- + + Everything above calls Lexer.tokenize/Dump.dump_tokens in-process -- + real coverage of the lexer, zero coverage of bin/main.ml's own + plumbing (argv parsing, which stream a diagnostic lands on, the + 0/1/2 exit contract). This section runs the actual built woc binary + as a subprocess. Sys.command (stdlib) shells out via /bin/sh; it + only returns an exit code, so stdout/stderr are captured via + redirection to temp files rather than a pipe API -- deliberately + avoids pulling in the unix library for this one need. *) + +let woc_binary () = + match Sys.getenv_opt "WOC_BIN" with + | Some path -> path + | None -> ( + (* Under `dune runtest`, cwd is ".../_build/default/test" and the + built binary sits at the sibling ".../_build/default/bin/woc" -- + test/dune depends on ../bin/woc precisely so that's guaranteed + built before this test runs, making "../bin/woc" (relative to + cwd) the right path. Manual invocation falls back through a + couple of other plausible locations. *) + let candidates = [ "../bin/woc"; "_build/default/bin/woc"; "bin/woc" ] in + match List.find_opt Sys.file_exists candidates with + | Some path -> path + | None -> + failwith "runner: cannot locate the built woc binary (set WOC_BIN)") + +(* Runs the woc binary with [args]; returns (exit_code, stdout, stderr). *) +let run_cli (args : string list) : int * string * string = + let bin = woc_binary () in + let out_file = Filename.temp_file "woc_stdout" ".txt" in + let err_file = Filename.temp_file "woc_stderr" ".txt" in + let cmd = + String.concat " " (List.map Filename.quote (bin :: args)) + ^ " >" ^ Filename.quote out_file ^ " 2>" ^ Filename.quote err_file + in + let exit_code = Sys.command cmd in + let stdout = read_file out_file in + let stderr = read_file err_file in + (try Sys.remove out_file with Sys_error _ -> ()); + (try Sys.remove err_file with Sys_error _ -> ()); + (exit_code, stdout, stderr) + +let () = + let path = "golden/tokens/gotcha.wo" in + let exit_code, stdout, stderr = run_cli [ "--dump-tokens"; path ] in + check "cli smoke: --dump-tokens on a clean file exits 0" (exit_code = 0); + check "cli smoke: clean-file run writes nothing to stderr" (stderr = ""); + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:path (read_file path) in + check "cli smoke: stdout matches the in-process token dump exactly" + (stdout = Dump.dump_tokens toks) + +let () = + let path = "golden/tokens/unknown-char.wo" in + let exit_code, stdout, stderr = run_cli [ "--dump-tokens"; path ] in + check "cli smoke: a diagnostic-producing file exits 1, not 0" (exit_code = 1); + check "cli smoke: the WO-E001 diagnostic goes to stderr" (stderr <> ""); + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file:path (read_file path) in + check "cli smoke: stdout still carries the full token dump on exit 1" + (stdout = Dump.dump_tokens toks) + +let () = + let exit_code, _stdout, stderr = run_cli [ "does-not-exist.wo" ] in + check "cli smoke: missing file (bare-path form) exits 2" (exit_code = 2); + check "cli smoke: missing-file message goes to stderr" (stderr <> "") + +let () = + let path = "golden/ast/pricing-demo.wo" in + let exit_code, stdout, stderr = run_cli [ "--dump-ast"; path ] in + check "cli smoke: --dump-ast on a clean file exits 0" (exit_code = 0); + check "cli smoke: clean-file --dump-ast writes nothing to stderr" (stderr = ""); + let prog, _ = parse_str ~file:path (read_file path) in + check "cli smoke: --dump-ast stdout matches the in-process AST dump exactly" + (stdout = Dump.dump_ast prog) + +let () = + let path = "golden/ast/two-error-recovery.wo" in + let exit_code, stdout, stderr = run_cli [ "--dump-ast"; path ] in + check "cli smoke: a decl-recovery file exits 1, not 0" (exit_code = 1); + check "cli smoke: recovered parse diagnostics go to stderr" (stderr <> ""); + let prog, _ = parse_str ~file:path (read_file path) in + check "cli smoke: --dump-ast stdout still carries the surviving decls on exit 1" + (stdout = Dump.dump_ast prog) + +(* ---- golden-directory walk ------------------------------------------ *) + +(* Each stage directory under golden/ names one `woc --dump-*` flag. + "tokens" (Task 3) and "ast" (Task 4) exist today; later tasks add + "types", "owner" alongside their own dump function in dump.ml. *) +let run_stage ~stage ~file ~src : string = + match stage with + | "tokens" -> + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file src in + Dump.dump_tokens toks + | "ast" -> + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file src in + let prog = Parser.parse collector ~file toks in + Dump.dump_ast prog + | other -> + failwith (Printf.sprintf "runner: unknown golden stage directory %S" other) + +(* Line-based diff, unified-diff-flavored (common leading lines shown + as context, then removed/added) but not a full LCS — goldens are + sized for a human to read at a glance, not for minimal-diff output. *) +let print_diff ~expected ~actual = + let exp_lines = Array.of_list (String.split_on_char '\n' expected) in + let act_lines = Array.of_list (String.split_on_char '\n' actual) in + let n = min (Array.length exp_lines) (Array.length act_lines) in + let rec prefix_len i = + if i < n && exp_lines.(i) = act_lines.(i) then prefix_len (i + 1) else i + in + let start = prefix_len 0 in + Printf.printf " --- expected\n +++ actual\n"; + for i = 0 to start - 1 do + Printf.printf " %s\n" exp_lines.(i) + done; + for i = start to Array.length exp_lines - 1 do + Printf.printf " - %s\n" exp_lines.(i) + done; + for i = start to Array.length act_lines - 1 do + Printf.printf " + %s\n" act_lines.(i) + done + +let is_visible name = String.length name > 0 && name.[0] <> '.' + +let run_golden_dir () = + let root = "golden" in + if not (Sys.file_exists root && Sys.is_directory root) then + failwith (Printf.sprintf "runner: golden directory not found at %S" root) + else begin + let src_root = if bless then Some (source_golden_dir ()) else None in + let stages = + Sys.readdir root |> Array.to_list |> List.filter is_visible + |> List.filter (fun name -> Sys.is_directory (Filename.concat root name)) + |> List.sort compare + in + List.iter + (fun stage -> + let dir = Filename.concat root stage in + let entries = Sys.readdir dir |> Array.to_list |> List.sort compare in + let wo_files = List.filter (fun n -> Filename.check_suffix n ".wo") entries in + List.iter + (fun wo_name -> + incr checks; + let name = Filename.chop_suffix wo_name ".wo" in + let wo_path = Filename.concat dir wo_name in + let expected_path = Filename.concat dir (name ^ ".expected") in + let src = read_file wo_path in + let file_label = stage ^ "/" ^ wo_name in + let actual = run_stage ~stage ~file:file_label ~src in + if bless then begin + let src_expected_path = + Filename.concat + (Filename.concat (Option.get src_root) stage) + (name ^ ".expected") + in + write_file src_expected_path actual; + Printf.printf "BLESSED: %s\n" src_expected_path + end + else begin + let expected = + if Sys.file_exists expected_path then read_file expected_path + else "" + in + if expected <> actual then begin + incr failures; + Printf.printf "FAIL: %s\n" (Filename.concat stage wo_name); + print_diff ~expected ~actual + end + end) + wo_files) + stages + end + +let () = run_golden_dir () + +let () = + Printf.printf "runner: %d checks, %d failures\n" !checks !failures; + if !failures > 0 then exit 1 else exit 0 diff --git a/compiler/test/test_diag.ml b/compiler/test/test_diag.ml new file mode 100644 index 0000000..d204062 --- /dev/null +++ b/compiler/test/test_diag.ml @@ -0,0 +1,212 @@ +(* test_diag.ml — minimal unit-test seam for compiler/src/diag.ml. + + This is NOT the golden-file runner (Task 3 adds that as + compiler/test/runner.ml, alongside this file). Plain assertions, + printed failures, nonzero exit on any failure — just enough to + drive diag.ml with TDD before the golden framework exists. *) + +let checks = ref 0 +let failures = ref 0 + +let check name cond = + incr checks; + if not cond then begin + incr failures; + Printf.printf "FAIL: %s\n" name + end + +let check_eq name ~expected ~actual to_string = + incr checks; + if expected <> actual then begin + incr failures; + Printf.printf "FAIL: %s\n expected: %s\n actual: %s\n" name + (to_string expected) (to_string actual) + end + +module D = Woc_lib.Diag + +(* ---- fixture source text ------------------------------------------ *) + +let pricing_wo = + String.concat "\n" + [ "type Widget {" + ; " field name: Text" + ; "}" + ; "" + ; "fn use_widget() {" + ; " let p = Widget { name: \"a\" }" + ; " -- noop" + ; " -- noop" + ; " -- noop" + ; " let q = p" + ; " -- noop" + ; " -- noop" + ; " -- noop" + ; " take p" + ] + +let lookup file = if file = "pricing.wo" then Some pricing_wo else None + +(* ---- rendering shape: code, position, caret excerpt, related site - *) + +let () = + let related = + [ D.related_site ~file:"pricing.wo" ~line:6 ~col:7 ~label:"moved here" ] + in + let d = + D.error ~code:"WO-E301" ~file:"pricing.wo" ~line:14 ~col:8 + ~message:"value 'p' used after move" ~related () + in + let rendered = D.render lookup d in + let lines = String.split_on_char '\n' rendered in + let expected = + [ "pricing.wo:14:8: error WO-E301: value 'p' used after move" + ; " take p" + ; String.make 7 ' ' ^ "^" + ; " pricing.wo:6:7: moved here" + ; " let p = Widget { name: \"a\" }" + ; " " ^ String.make 6 ' ' ^ "^" + ] + in + check_eq "render: full diagnostic shape (header/excerpt/caret + related)" + ~expected ~actual:lines (String.concat "\n") + +let () = + (* Warning severity, no related sites: header word changes, no + trailing related blocks appended. *) + let d = + D.warning ~code:"WO-E999" ~file:"pricing.wo" ~line:1 ~col:1 + ~message:"placeholder" () + in + let rendered = D.render lookup d in + check "render: warning word + no related blocks" + (rendered = "pricing.wo:1:1: warning WO-E999: placeholder\ntype Widget {\n^") + +let () = + (* Source unavailable: falls back to the header line only, no crash. *) + let d = + D.error ~code:"WO-E001" ~file:"missing.wo" ~line:3 ~col:2 + ~message:"no source available" () + in + let rendered = D.render lookup d in + check "render: missing source falls back to header-only line" + (rendered = "missing.wo:3:2: error WO-E001: no source available") + +let () = + (* Tabs count as one column: a leading tab is not expanded, so the + caret offset is exactly (col - 1) characters regardless of what + the preceding characters are. *) + let tabby_lookup file = if file = "t.wo" then Some "\tlet p = 1" else None in + let d = D.error ~code:"WO-E001" ~file:"t.wo" ~line:1 ~col:6 ~message:"x" () in + let rendered = D.render tabby_lookup d in + match String.split_on_char '\n' rendered with + | [ _header; _source; caret ] -> + check "render: tab counts as one column" (caret = String.make 5 ' ' ^ "^") + | _ -> check "render: tab counts as one column (unexpected shape)" false + +let () = + (* A defensive edge case, not a real compiler output: line 0 (or + negative) is out of the 1-based contract. Rendering must fall + back to a header-only line, matching the missing-file case, + rather than raising (List.nth_opt raises Invalid_argument on a + negative index if this guard is ever removed). *) + let d = + D.error ~code:"WO-E001" ~file:"pricing.wo" ~line:0 ~col:1 + ~message:"out-of-range line stays non-fatal" () + in + let rendered = D.render lookup d in + check "render: line < 1 falls back to header-only, does not raise" + (rendered = "pricing.wo:0:1: error WO-E001: out-of-range line stays non-fatal") + +(* ---- collector: source-order accumulation, sort, dedup ------------ *) + +let () = + let c = D.Collector.create () in + D.Collector.add c + (D.error ~code:"WO-E100" ~file:"b.wo" ~line:5 ~col:1 ~message:"m1" ()); + D.Collector.add c + (D.error ~code:"WO-E100" ~file:"a.wo" ~line:10 ~col:2 ~message:"m2" ()); + D.Collector.add c + (D.error ~code:"WO-E100" ~file:"a.wo" ~line:1 ~col:1 ~message:"m3" ()); + let sites = + List.map + (fun (d : D.t) -> (d.site.file, d.site.line, d.site.col)) + (D.Collector.diagnostics c) + in + check_eq "collector: output sorted by (file, line, col)" + ~expected:[ ("a.wo", 1, 1); ("a.wo", 10, 2); ("b.wo", 5, 1) ] + ~actual:sites (fun l -> + String.concat ", " + (List.map (fun (f, ln, cl) -> Printf.sprintf "%s:%d:%d" f ln cl) l)) + +let () = + let c = D.Collector.create () in + D.Collector.add c + (D.error ~code:"WO-E100" ~file:"a.wo" ~line:1 ~col:1 ~message:"first" ()); + D.Collector.add c + (D.error ~code:"WO-E100" ~file:"a.wo" ~line:1 ~col:1 ~message:"duplicate" ()); + D.Collector.add c + (D.error ~code:"WO-E200" ~file:"a.wo" ~line:1 ~col:1 + ~message:"different code, same site" ()); + let ds = D.Collector.diagnostics c in + check_eq "collector: dedups identical (code, file, line, col)" + ~expected:2 ~actual:(List.length ds) string_of_int; + (match ds with + | [ first; _second ] -> + check "collector: dedup keeps first-added occurrence" + (first.message = "first") + | _ -> check "collector: dedup result shape" false) + +(* ---- exit-code decision -------------------------------------------- *) + +let () = + let c = D.Collector.create () in + check_eq "exit code: empty collector is clean" ~expected:0 + ~actual:(D.Collector.exit_code c) string_of_int + +let () = + let c = D.Collector.create () in + D.Collector.add c + (D.warning ~code:"WO-E900" ~file:"a.wo" ~line:1 ~col:1 ~message:"w" ()); + check_eq "exit code: warnings only stays clean" ~expected:0 + ~actual:(D.Collector.exit_code c) string_of_int + +let () = + let c = D.Collector.create () in + D.Collector.add c + (D.warning ~code:"WO-E900" ~file:"a.wo" ~line:1 ~col:1 ~message:"w" ()); + D.Collector.add c + (D.error ~code:"WO-E301" ~file:"a.wo" ~line:2 ~col:1 ~message:"e" ()); + check_eq "exit code: any error reported yields 1" ~expected:1 + ~actual:(D.Collector.exit_code c) string_of_int + +let () = + (* Regression: exit_code must agree with the deduped, displayed + view, not the raw pre-dedup accumulation. A Warning added first + and an Error added second at the exact same (code, file, line, + col) dedup down to just the warning (first occurrence wins) — so + the report shows zero errors, and exit_code must be 0 to match, + not 1 from a dropped duplicate's severity. *) + let c = D.Collector.create () in + D.Collector.add c + (D.warning ~code:"WO-E301" ~file:"a.wo" ~line:1 ~col:1 + ~message:"warning first" ()); + D.Collector.add c + (D.error ~code:"WO-E301" ~file:"a.wo" ~line:1 ~col:1 + ~message:"error second, same code+site" ()); + let ds = D.Collector.diagnostics c in + check_eq "exit code: dedup survivor decides exit code, not raw items" + ~expected:1 ~actual:(List.length ds) string_of_int; + (match ds with + | [ only ] -> + check "exit code: dedup keeps the first-added warning" + (only.severity = D.Warning && only.message = "warning first") + | _ -> check "exit code: dedup survivor shape" false); + check_eq "exit code: agrees with the deduped (warning-only) view" + ~expected:0 ~actual:(D.Collector.exit_code c) string_of_int + +(* ---- summary --------------------------------------------------------*) + +let () = + Printf.printf "test_diag: %d checks, %d failures\n" !checks !failures; + if !failures > 0 then exit 1 else exit 0