From 652361e16952c37af816bda8f095ad2e15b2c507 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Thu, 17 Sep 2026 21:44:55 +0700 Subject: [PATCH] A missing file is a sentence, and flan run's two argument lists are told apart MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit with_errors had no Sys_error arm, so flan check nosuch.flan ended in OCaml's default handler; the daemon has had that arm since before the CLI did. A Not_found backstop joins it — nothing reaches it today, and the day something does the failure should name the file rather than say nothing at all. flan run handed every flag it did not understand to the compiled program: flan run game.flan --debug built at -O2 and gave the game a --debug. Build flags are now the build's, -- ends them, and an unknown dash argument before -- is refused by name with -- named as the way to mean it for the program. -O0 through -O3 get a spelling on build and run, which they did not have at all: Build.default pinned -O2 and --debug was the only route to anything else. Four levels and not five, because -Os is clang's and llc rejects it, and the same string reaches both. --debug with a higher level is refused rather than quietly overruled by Build's own -O0. --- bin/main.ml | 131 +++++++++++++++++++++++++++++++++++++--- test/test_acceptance.ml | 65 ++++++++++++++++++++ 2 files changed, 188 insertions(+), 8 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 52ac753..5801d72 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -31,6 +31,31 @@ let with_errors path f = prerr_endline ("flan: " ^ m); ignore path; exit 1 + (* A file that is not there, or that cannot be read. The exception already + carries the path and the reason the operating system gave, which is the + whole of what anybody can act on, so it is passed through as it is — + [lib/dev.ml]'s [message_of_exn] does the same for the same reason, and + the daemon has had this arm since before the CLI did. Without it + [flan check nosuch.flan] ends in [Fatal error: exception Sys_error(...)], + which is the compiler telling the user it did not expect to be asked. *) + | Sys_error m -> + prerr_endline ("flan: " ^ m); + ignore path; + exit 1 + (* The backstop. Nothing in this binary reaches it today: every [Hashtbl.find] + on a path a command can take is guarded by a [find_opt]. It is here so + that the day one is not, the failure is a sentence naming the file being + worked on rather than a bare [Fatal error: exception Not_found] — which + says nothing at all, not even which file. Its own exit status, because a + compiler bug is not a refusal of the program and a script should be able + to tell the two apart. *) + | Not_found -> + prerr_endline + ("flan: internal error — a lookup failed with no name to report, while \ + working on " ^ path + ^ ". This is a bug in the compiler and not a fault in the program; \ + please report the file that provoked it."); + exit 4 let summarise (d : Flan.Ast.decl) = let open Flan.Ast in @@ -143,8 +168,43 @@ let flags = usage error. *) let target_prefix = "--target=" +(* The optimisation level, which until now had no spelling at all: [Build.default] + pinned -O2 and [--debug] was the only route to anything else. Four levels and + not five — -Os is clang's and llc rejects it outright ("invalid optimization + level"), and the same string reaches both ([Build] at the clang compile and + again at the llc step of the live loop), so offering a level one of the two + tools does not know would be a flag that works for [flan build] and breaks + [C-c C-c]. + + Last one wins, which is what every compiler does with a repeated -O and the + only rule that does not need explaining. *) +let opt_levels = [ "-O0"; "-O1"; "-O2"; "-O3" ] + +let opt_of args = + List.fold_left + (fun acc a -> if List.mem a opt_levels then Some a else acc) + None args + let is_flag a = - List.mem a flags || String.starts_with ~prefix:target_prefix a + List.mem a flags || List.mem a opt_levels + || String.starts_with ~prefix:target_prefix a + +(* [--debug] forces -O0 in [Build] and says why there: [llvm.dbg.declare] + describes an alloca and mem2reg deletes the alloca, so a debug build at -O2 + has a line table over code whose locals are gone. That is a good rule, and + it makes [--debug -O2] a request that cannot be honoured — so it is refused + here by name instead of being quietly overruled two modules away. *) +let check_opt_against_debug ~debug ~opt = + match (debug, opt) with + | true, Some o when o <> "-O0" -> + prerr_endline + ("flan: --debug and " ^ o + ^ " ask for opposite things — a debug build is -O0 because \ + llvm.dbg.declare describes an alloca and mem2reg at any higher level \ + deletes it, leaving a line table over locals that are not there. \ + Drop one of the two."); + exit 2 + | _ -> () let target_of args = List.find_map @@ -507,6 +567,8 @@ let () = let debug = List.mem debug_flag rest in let sanitize = List.mem sanitize_flag rest in let x86 = List.mem x86_flag rest in + let opt = opt_of rest in + check_opt_against_debug ~debug ~opt; let target = target_of rest in let out = match List.filter (fun a -> not (is_flag a)) rest with @@ -524,7 +586,8 @@ let () = | _ -> base) | _ -> prerr_endline - "usage: flan build [-o out] [--no-bounds-checks] \ + "usage: flan build [-o out] [-O0|-O1|-O2|-O3] \ + [--no-bounds-checks] \ [--dev] [--debug] [--sanitize] [--target=wasm32-wasi|web]"; exit 2 in @@ -538,7 +601,9 @@ let () = let p, csrcs, lflags = Flan.Reach.link ~dev l p in ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev; debug; sanitize; - target; x86 } + target; x86; + opt = Option.value opt + ~default:Flan.Build.default.Flan.Build.opt } ~csrcs ~lflags ~pnames:(if debug then param_names l else []) p ~out)) (* The daemon an editor talks to: one session, the program it belongs to @@ -626,6 +691,48 @@ let () = this host can exec. Use flan build --target=... and a wasm runtime."; exit 2 | _ :: "run" :: path :: args -> + (* One command, two argument lists, and until now no rule saying which was + which: [flan run game.flan --debug] built at -O2 and handed the game a + [--debug] it had never heard of. Nothing reported that, because neither + side thought it had been given anything wrong. + + The rule, in one line: a build flag is the build's, [--] ends the build + flags, and everything after [--] is the program's whatever it looks + like. Before [--], an argument that starts with a dash and is not a + build flag this command offers is refused by name — not guessed at, + because guessing is the failure this exists to stop, and a program of + one's own that wants [-v] has [--] to ask for it. Plain arguments need + no ceremony: they were never ambiguous and they still go straight + through, so [flan run calc-me.flan "1+2"] is unchanged. *) + let run_flags = [ no_checks_flag; dev_flag; debug_flag; sanitize_flag; + x86_flag ] @ opt_levels in + let build_args, prog_args = + let rec split acc = function + | "--" :: rest -> (List.rev acc, rest) + | a :: rest when String.length a > 1 && a.[0] = '-' -> + if List.mem a run_flags then split (a :: acc) rest + else begin + prerr_endline + ("flan run: " ^ a + ^ " is not a flag this command offers, and it will not be \ + guessed at — a build flag belongs to the build and \ + anything else belongs to the program. Write it after -- to \ + send it to the program: flan run " + ^ Filename.basename path ^ " -- " ^ a); + exit 2 + end + | a :: rest -> let l, r = split acc rest in (l, a :: r) + | [] -> (List.rev acc, []) + in + split [] args + in + let checks = not (List.mem no_checks_flag build_args) in + let dev = List.mem dev_flag build_args in + let debug = List.mem debug_flag build_args in + let sanitize = List.mem sanitize_flag build_args in + let x86 = List.mem x86_flag build_args in + let opt = opt_of build_args in + check_opt_against_debug ~debug ~opt; with_errors path (fun () -> let exe = Filename.concat (Filename.get_temp_dir_name ()) @@ -633,10 +740,17 @@ let () = in let l = load path in let p = Flan.Check.program_all l.decls in - let p, csrcs, lflags = Flan.Reach.link l p in - ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe); + let p, csrcs, lflags = Flan.Reach.link ~dev l p in + ignore (Flan.Build.executable + ~opts:{ Flan.Build.default with checks; dev; debug; sanitize; + x86; + opt = Option.value opt + ~default:Flan.Build.default.Flan.Build.opt } + ~csrcs ~lflags ~pnames:(if debug then param_names l else []) + p ~out:exe); let code = - Sys.command (String.concat " " (List.map Filename.quote (exe :: args))) + Sys.command + (String.concat " " (List.map Filename.quote (exe :: prog_args))) in (try Sys.remove exe with Sys_error _ -> ()); exit code) @@ -645,9 +759,10 @@ let () = "usage: flan (read|parse|check|emit|shim) ...\n flan emit [--x86] [--dev] [--debug] [--no-bounds-checks]\n\ \ flan import-c [package.flan...] [clang flags...]\n\ \ flan generate-c \n\ - \ flan build [-o out] [--no-bounds-checks] [--dev] \ + \ flan build [-o out] [-O0|-O1|-O2|-O3] \ + [--no-bounds-checks] [--dev] \ [--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\ - \ flan run [args...]\n\ + \ flan run [build flags...] [--] [program args...]\n\ \ flan reload [-o out.so] [--x86]\n\ \ flan dev [-s socket] [--x86]"; exit 2 diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index a99ab31..120c833 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3670,6 +3670,71 @@ ERR@7 unexpected token: not the kind the caller was reading outputs ~opt:"-O0" "utf-8, splitting and ascii case, -O0" "programs/utf8.flan" utf8_out; + (* ── The driver's own refusals ───────────────────────────────────── + + Not about compiled code at all: about what the CLI does when it is + handed something it cannot do. Each of these was an escape before — + an OCaml exception printed by the default handler, or a build flag + silently forwarded to the program — and each is pinned here because + "it prints a sentence" is exactly the kind of claim that rots without + a test to hold it. *) + let cli args = + let out = Filename.concat scratch "flan-cli.out" in + let code = + Sys.command + (Printf.sprintf "../bin/main.exe %s > %s 2>&1" args (Filename.quote out)) + in + let text = In_channel.with_open_bin out In_channel.input_all in + (try Sys.remove out with Sys_error _ -> ()); + (code, text) + in + let cli_case name args ~code:want_code ~says = + let code, text = cli args in + let bad = + code <> want_code + || List.exists (fun n -> not (contains text n)) says + (* The point of half of these: no arm here may end in OCaml's default + handler, whatever else it does. *) + || contains text "Fatal error" + in + if bad then begin + incr failures; + Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted exit %d with %s\n" + name text code want_code (String.concat ", " says) + end + in + (* A path that is not there. This used to be + [Fatal error: exception Sys_error("...")] — the compiler reporting that + it had not expected to be asked. *) + cli_case "check on a file that is not there" + "check no-such-file.flan" ~code:1 + ~says:[ "no-such-file.flan"; "No such file or directory" ]; + (* And every other front end takes the same route, since the arm is on the + one wrapper they all go through. *) + cli_case "build on a file that is not there" + "build no-such-file.flan -o /dev/null" ~code:1 + ~says:[ "no-such-file.flan" ]; + (* [flan run] and its two argument lists. -O0 is the build's, so calc-me + never sees it and answers the expression that follows; before the split + it was handed "-O0" as the expression and said it could not parse it. *) + cli_case "run keeps a build flag out of the program's argv" + "run ../calc-me.flan -O0 '1+2'" ~code:0 ~says:[ "3" ]; + (* -- hands the rest over whatever it looks like, which is what makes the + refusal below affordable. *) + cli_case "run passes everything after -- to the program" + "run ../calc-me.flan -O0 -- '3*4'" ~code:0 ~says:[ "12" ]; + (* And an unknown dash argument is refused by name rather than guessed at + in either direction. *) + cli_case "run refuses a flag it does not offer" + "run ../calc-me.flan --lint" ~code:2 + ~says:[ "--lint"; "will not be guessed at"; "--" ]; + (* The one pair of flags that cannot both be honoured: --debug is -O0 in + [Build] and says why, so asking for it alongside a higher level is a + request with two answers. *) + cli_case "--debug and an explicit -O are refused together" + "build ../calc-me.flan --debug -O2 -o /dev/null" ~code:2 + ~says:[ "--debug"; "-O2"; "Drop one of the two" ]; + if !failures = 0 then print_endline "acceptance: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures;