Check compiler-flags when a build starts

changes/validate-compiler-flags.polish.md

@@ -0,0 +1 @@
+- Report an unknown flag, a flag without its value, or a flag the build system sets itself in `compiler-flags` once, as an error in `rescript.json`, instead of failing every module.

compiler/bsc/rescript_compiler_driver.ml

@@ -520,6 +520,32 @@ let command_line_flags () : (string * Bsc_args.spec * string) array =
       "*internal* make runtime library" );
   |]
 
+type flag_error =
+  | Unknown_flag of string
+  | Missing_argument of string
+  | Not_a_flag of string
+  | Reserved_flag of string
+
+(* Walks [flags] as the parser does, without applying them: some flags print,
+   exit or compile a file. *)
+let check_flags ~reserved flags =
+  let table = command_line_flags () in
+  let rec check = function
+    | [] -> Ok ()
+    | flag :: rest -> (
+      if flag = "" || flag.[0] <> '-' then Error (Not_a_flag flag)
+      else if List.mem flag reserved then Error (Reserved_flag flag)
+      else
+        match Ext_spec.assoc3 table flag with
+        | None -> Error (Unknown_flag flag)
+        | Some (Bsc_args.Unit_dummy | Unit _) -> check rest
+        | Some (String _) -> (
+          match rest with
+          | [] -> Error (Missing_argument flag)
+          | _argument :: rest -> check rest))
+  in
+  check flags
+
 (** parse flags in config *)
 let file_level_flags_handler (e : Parsetree.expression option) =
   match e with

compiler/bsc/rescript_compiler_driver.mli

@@ -24,6 +24,17 @@ val run_request :
     I/O against [cwd] without changing the process working directory. Request
     state is restored on success and failure. *)
 
+type flag_error =
+  | Unknown_flag of string
+  | Missing_argument of string  (** A flag that takes a value, last *)
+  | Not_a_flag of string  (** A value where a flag was expected *)
+  | Reserved_flag of string
+
+val check_flags :
+  reserved:string list -> string list -> (unit, flag_error) Stdlib.result
+(** Checks that [flags] are flags of the compiler with their values, and none of
+    [reserved], without applying them. *)
+
 val run : string array -> int
 (** Command-line entry point of the standalone [bsc]. It writes to the process's
     stdout and stderr as it goes. *)

rewatch-ocaml/build_preparation.ml

@@ -23,6 +23,10 @@ let run ~(root_config : Config.t) ~prod ~features ~warn_error ~filter ~watch
       ~warn_error ~filter ~attempt
   in
   Module_graph.validate_visible_namespaces ~root_config package_plans;
+  List.iter
+    (fun (package : Package_plan.t) ->
+      Compiler_args.check_user_flags package.config)
+    package_plans;
   let runtime = runtime_path root_config.root in
   let source_map_args = Compiler_args.source_map_args workspace_config ~watch in
   let compiler_context =

rewatch-ocaml/compiler_args.ml

@@ -52,6 +52,45 @@ let parser_flags ?(ppx_flags = []) (config : Config.t) =
   ppx_args @ config.jsx_args @ config.experimental_args @ config.warning_flags
   @ config.compiler_flags
 
+(* The build system passes these flags itself. *)
+let build_system_flags =
+  [
+    "-o";
+    "-bs-ns";
+    "-bs-package-name";
+    "-bs-package-output";
+    "-bs-project-root";
+    "-bs-read-cmi";
+    "-bs-ast";
+    "-runtime-path";
+  ]
+
+(* With these flags the compiler prints, formats or evaluates instead of
+   compiling the module. *)
+let non_compiling_flags =
+  ["-e"; "-v"; "-version"; "-warn-help"; "-format"; "-reprint-source"]
+
+let check_user_flags (config : Config.t) =
+  let fail message =
+    raise
+      (Project_context.Error
+         (Printf.sprintf "%s: field \"compiler-flags\": %s" config.path message))
+  in
+  match
+    Rescript_compiler_driver.check_flags
+      ~reserved:(build_system_flags @ non_compiling_flags)
+      config.compiler_flags
+  with
+  | Ok () -> ()
+  | Error (Unknown_flag flag) -> fail (Printf.sprintf "unknown flag %S" flag)
+  | Error (Missing_argument flag) ->
+    fail (Printf.sprintf "flag %S needs a value" flag)
+  | Error (Not_a_flag value) -> fail (Printf.sprintf "%S is not a flag" value)
+  | Error (Reserved_flag flag) when List.mem flag build_system_flags ->
+    fail (Printf.sprintf "flag %S is set by the build system" flag)
+  | Error (Reserved_flag flag) ->
+    fail (Printf.sprintf "flag %S does not compile a module" flag)
+
 let compiler_flags ~watch (config : Config.t) =
   config.jsx_args
   @ source_map_args config ~watch

rewatch-ocaml/compiler_args.mli

@@ -6,6 +6,11 @@ val source_map_args : Config.t -> watch:bool -> string list
 val parser_flags : ?ppx_flags:string list list -> Config.t -> string list
 (** The flags of a parse, in the order they are passed to the parser. *)
 
+val check_user_flags : Config.t -> unit
+(** Rejects a ["compiler-flags"] entry that the compiler does not know, that
+    lacks its value, that the build system sets itself, or that makes the
+    compiler do something other than compile. Raises {!Project_context.Error}. *)
+
 val compiler_flags : watch:bool -> Config.t -> string list
 (** The configured flags of a compile, including source maps and genType. *)
 

rewatch/tests/compile/25-invalid-compiler-flags.sh

@@ -0,0 +1,55 @@
+#!/bin/bash
+# A build rejects compiler-flags that the compiler would reject for every
+# module, or that conflict with the flags the build system passes itself,
+# once and with the location of the field. Other commands don't check them.
+
+cd "$(dirname "$0")"
+source "../utils.sh"
+
+bold "Test: Invalid compiler flags are a configuration error"
+
+test_dir=$(pwd)
+fixture=$(mktemp -d 2>/dev/null || mktemp -d -t rewatch-compiler-flags)
+trap 'cd "$test_dir"; rm -rf "$fixture"' EXIT
+cd "$fixture"
+mkdir src
+printf 'let value = 1\n' > src/A.res
+
+# Usage: expect_error <compiler-flags JSON> <expected error>
+expect_error() {
+  printf '{"name": "flags", "sources": ["src"], "compiler-flags": %s}\n' "$1" \
+    > rescript.json
+  if output=$(rewatch build 2>&1); then
+    error "Build accepted compiler-flags $1"
+    exit 1
+  fi
+  if ! printf '%s\n' "$output" | grep -qF "field \"compiler-flags\": $2"; then
+    error "Unexpected error for compiler-flags $1"
+    printf '%s\n' "$output" >&2
+    exit 1
+  fi
+}
+
+expect_error '["-bs-fooo"]' 'unknown flag "-bs-fooo"'
+expect_error '["-bs-g", "-open"]' 'flag "-open" needs a value'
+expect_error '[["-w", "-40+6"], "Belt"]' '"Belt" is not a flag'
+expect_error '["-bs-ns Other"]' 'flag "-bs-ns" is set by the build system'
+expect_error '["-v"]' 'flag "-v" does not compile a module'
+
+# Formatting does not compile, so it ignores the flags.
+printf 'let value =    1\n' > src/A.res
+if ! output=$(rewatch format 2>&1); then
+  error "Format failed because of compiler-flags"
+  printf '%s\n' "$output" >&2
+  exit 1
+fi
+
+printf '{"name": "flags", "sources": ["src"], "compiler-flags": ["-bs-g", "-w -40+6", "-open Stdlib"]}\n' \
+  > rescript.json
+if ! output=$(rewatch build 2>&1); then
+  error "Build rejected valid compiler-flags"
+  printf '%s\n' "$output" >&2
+  exit 1
+fi
+
+success "Invalid compiler flags are a configuration error"

rewatch/tests/suite.sh

@@ -86,6 +86,7 @@ fi
 ./compile/21-rebuild-dependency-for-package-specs.sh &&
 ./compile/22-qualified-own-namespace-dependency.sh &&
 ./compile/23-root-source-dir-rebuild.sh &&
+./compile/25-invalid-compiler-flags.sh &&
 ./compile/14-no-testrepo-changes.sh &&
 ./compile/15-no-new-files.sh &&
 ./compile/16-snapshots-unchanged.sh &&

tests/rewatch_ounit_tests/compiler_args_tests.ml

@@ -186,3 +186,21 @@ let tests =
              Test_support.contains_text message
                "Expected to find dependent package outside of app")
           "compiler-args does not search above a workspace dependency boundary"))
+
+let check_flags_tests =
+  "check_flags" >:: fun _context ->
+  let check_flags = Rescript_compiler_driver.check_flags ~reserved:["-bs-ns"] in
+  assert_equal (Ok ())
+    (check_flags ["-bs-g"; "-w"; "-40+6"; "-open"; "Belt"])
+    ~msg:"a flag's value may start with a dash";
+  assert_equal (Ok ())
+    (check_flags ["-ppx"; "-bs-ns"])
+    ~msg:"a reserved flag's name is accepted as a value";
+  assert_equal (Error (Rescript_compiler_driver.Unknown_flag "-bs-fooo"))
+    (check_flags ["-bs-g"; "-bs-fooo"]);
+  assert_equal (Error (Rescript_compiler_driver.Missing_argument "-open"))
+    (check_flags ["-open"]);
+  assert_equal (Error (Rescript_compiler_driver.Not_a_flag "Belt"))
+    (check_flags ["-bs-g"; "Belt"]);
+  assert_equal (Error (Rescript_compiler_driver.Reserved_flag "-bs-ns"))
+    (check_flags ["-bs-ns"; "Ns"])

tests/rewatch_ounit_tests/rewatch_ounit_tests_main.ml

@@ -12,6 +12,7 @@ let () =
            Cli_tests.tests;
            Compile_assets_tests.tests;
            Compiler_args_tests.tests;
+           Compiler_args_tests.check_flags_tests;
            Compiler_info_tests.tests;
            Compiler_process_tests.tests;
            Compiler_scheduler_tests.tests;