diff --git a/Makefile b/Makefile index 36e10466..c5a8a445 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ NAME := jbuilder default: boot.exe - ./boot.exe -j 4 + ./boot.exe -j 4 --dev boot.exe: bootstrap.ml ocaml bootstrap.ml diff --git a/bin/main.ml b/bin/main.ml index c1d02266..2af9a108 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -47,13 +47,15 @@ type common = ; debug_rules: bool ; debug_dep_path: bool ; debug_findlib: bool + ; dev_mode: bool } let set_common c = Clflags.concurrency := c.concurrency; Clflags.debug_rules := c.debug_rules; Clflags.debug_dep_path := c.debug_dep_path; - Clflags.debug_findlib := c.debug_findlib + Clflags.debug_findlib := c.debug_findlib; + Clflags.dev_mode := c.dev_mode let copts_sect = "COMMON OPTIONS" let help_secs = @@ -66,15 +68,22 @@ let help_secs = ] let common = - let make concurrency debug_rules debug_dep_path debug_findlib = - { concurrency ; debug_rules ; debug_dep_path ; debug_findlib } in + let make concurrency debug_rules debug_dep_path debug_findlib dev_mode = + { concurrency + ; debug_rules + ; debug_dep_path + ; debug_findlib + ; dev_mode + } + in let docs = copts_sect in let concurrency = Arg.(value & opt int !Clflags.concurrency & info ["j"] ~docs) in let drules = Arg.(value & flag & info ["drules"] ~docs) in let ddep_path = Arg.(value & flag & info ["ddep-path"] ~docs) in let dfindlib = Arg.(value & flag & info ["dfindlib"] ~docs) in - Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib) + let dev = Arg.(value & flag & info ["dev"] ~docs) in + Term.(const make $ concurrency $ drules $ ddep_path $ dfindlib $ dev) let build_package pkg = Future.Scheduler.go ~log:(create_log ()) diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 304badea..60aead68 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -1,4 +1,4 @@ -open Import +open! Import module Target : sig type t = diff --git a/src/clflags.ml b/src/clflags.ml index dc77359f..7dbb4d11 100644 --- a/src/clflags.ml +++ b/src/clflags.ml @@ -6,3 +6,4 @@ let debug_run = ref true let debug_findlib = ref false let warnings = ref "-40" let debug_dep_path = ref false +let dev_mode = ref false diff --git a/src/clflags.mli b/src/clflags.mli index 753d7e81..ad610368 100644 --- a/src/clflags.mli +++ b/src/clflags.mli @@ -23,3 +23,6 @@ val debug_findlib : bool ref (** Compiler warnings *) val warnings : string ref + +(** Whether we are compiling with extra warnings *) +val dev_mode : bool ref diff --git a/src/future.ml b/src/future.ml index 7b227840..919a9171 100644 --- a/src/future.ml +++ b/src/future.ml @@ -192,12 +192,6 @@ let run_capture_line ?dir ?env prog args = cmdline (String.concat l ~sep:"\n") module Scheduler = struct - let key_for_color prog = - let s = Filename.basename prog in - match String.lsplit2 s ~on:'.' with - | None -> s - | Some (s, _) -> s - let colorize_prog s = let len = String.length s in if len = 0 then @@ -247,15 +241,6 @@ module Scheduler = struct | None -> s | Some dir -> sprintf "(cd %s && %s)" dir s - let stderr_supports_colors = lazy( - not Sys.win32 && - Unix.(isatty stderr) && - match Sys.getenv "TERM" with - | exception Not_found -> false - | "dumb" -> false - | _ -> true - ) - type running_job = { id : int ; job : job @@ -322,7 +307,7 @@ module Scheduler = struct Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc -> let pid, status = Unix.waitpid [WNOHANG] pid in if pid <> 0 then begin - (pid, job, status) :: acc + (job, status) :: acc end else acc) in @@ -331,7 +316,7 @@ module Scheduler = struct Unix.sleepf 0.001; wait_win32 () | _ -> - List.iter finished ~f:(fun (pid, job, status) -> + List.iter finished ~f:(fun (job, status) -> process_done job status) let () = diff --git a/src/gen_rules.ml b/src/gen_rules.ml index f90b2af8..406fcb69 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -2,8 +2,6 @@ open Import open Jbuild_types open Build.O -module BS = Build_system - (* +-----------------------------------------------------------------+ | Utils | +-----------------------------------------------------------------+ *) @@ -15,10 +13,33 @@ let g () = [] module Ocaml_flags = struct - let default_ocamlc_flags = g () - let default_ocamlopt_flags = g () + let default_ocamlc_flags = g + let default_ocamlopt_flags = g - let default_flags = [ "-w"; !Clflags.warnings ] + let dev_mode_warnings = + "@a" ^ + String.concat ~sep:"" + (List.map ~f:(sprintf "-%d") + [ 4 + ; 29 + ; 40 + ; 41 + ; 42 + ; 44 + ; 45 + ; 48 + ; 58 + ; 59 + ]) + + let default_flags () = + if !Clflags.dev_mode then + [ "-w"; dev_mode_warnings ^ !Clflags.warnings + ; "-strict-sequence" + ; "-strict-formats" + ] + else + [ "-w"; !Clflags.warnings ] type t = { common : string list @@ -27,10 +48,10 @@ module Ocaml_flags = struct let make { Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } = let eval = Ordered_set_lang.eval_with_standard in - { common = eval flags ~standard:default_flags + { common = eval flags ~standard:(default_flags ()) ; specific = - { byte = eval ocamlc_flags ~standard:default_ocamlc_flags - ; native = eval ocamlopt_flags ~standard:default_ocamlopt_flags + { byte = eval ocamlc_flags ~standard:(default_ocamlc_flags ()) + ; native = eval ocamlopt_flags ~standard:(default_ocamlopt_flags ()) } } @@ -38,7 +59,13 @@ module Ocaml_flags = struct let get_for_cm t ~cm_kind = get t (Mode.of_cm_kind cm_kind) - let default = make (Sexp.Of_sexp.record Buildable.v1 (List [])) + let default () = + { common = default_flags () + ; specific = + { byte = default_ocamlc_flags () + ; native = default_ocamlopt_flags () + } + } end let default_c_flags = g () @@ -978,7 +1005,7 @@ module Gen(P : Params) = struct build_modules ~flags ~dir ~dep_graph ~modules ~requires ~alias_module; Option.iter alias_module ~f:(fun m -> - let flags = Ocaml_flags.default in + let flags = Ocaml_flags.default () in build_module m ~flags:{ flags with common = "-w" :: "-49" :: flags.common } ~dir diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 6307d223..b81682ee 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -12,7 +12,7 @@ let load ~dir ~visible_packages ~version = let version, stanzas = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) (fun sexps -> - let versions, stanzas = + let versions, sexps = List.partition_map sexps ~f:(function | List [Atom ("jbuilder_version" | "Jbuilder_version"); ver] as sexp -> Inl (Jbuilder_version.t ver, sexp) diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index 784bf29c..e5fd49ba 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -840,7 +840,7 @@ module Stanza = struct match String_map.keys visible_packages with | [pkg] -> pkg | [] -> error "no packages are defined here" - | pkgs -> + | _ :: _ :: _ -> error "there is more than one package visible here:\n\ %s\n\ You need to add a (package ...) field in your (install ...) stanzas" diff --git a/src/main.ml b/src/main.ml index 58335652..7f301a2f 100644 --- a/src/main.ml +++ b/src/main.ml @@ -97,8 +97,11 @@ let bootstrap () = let pkg = "jbuilder" in let main () = let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in - Arg.parse [ "-j", Set_int Clflags.concurrency, "JOBS concurrency" ] - anon "Usage: boot.exe [-j JOBS]\nOptions are:"; + Arg.parse + [ "-j" , Set_int Clflags.concurrency, "JOBS concurrency" + ; "--dev", Set Clflags.dev_mode , " set development mode" + ] + anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:"; Future.Scheduler.go ~log:(create_log ()) (setup () >>= fun { build_system = bs; _ } -> Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")]) diff --git a/src/sexp.ml b/src/sexp.ml index b404f4b6..ee0c2897 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -185,9 +185,9 @@ module Of_sexp = struct let field name ?default value_of_sexp state = match Name_map.find name state.unparsed with - | Some { value = Some value } -> + | Some { value = Some value; _ } -> (value_of_sexp value, consume name state) - | Some { value = None } -> + | Some { value = None; _ } -> of_sexp_error state.record (Printf.sprintf "field %s needs a value" name) | None -> match default with @@ -197,17 +197,17 @@ module Of_sexp = struct let field_o name value_of_sexp state = match Name_map.find name state.unparsed with - | Some { value = Some value } -> + | Some { value = Some value; _ } -> (Some (value_of_sexp value), consume name state) - | Some { value = None } -> + | Some { value = None; _ } -> of_sexp_error state.record (Printf.sprintf "field %s needs a value" name) | None -> (None, add_known name state) let field_b name state = match Name_map.find name state.unparsed with - | Some { value = Some value } -> + | Some { value = Some value; _ } -> (bool value, consume name state) - | Some { value = None } -> + | Some { value = None; _ } -> (true, consume name state) | None -> (false, add_known name state) @@ -273,8 +273,6 @@ module Of_sexp = struct ; args : ('a, 'b) Constructor_args_spec.t ; make : 'a } -> 'b t - - let name (T t) = t.name end let cstr name args make =