From ec7d2c76a7ae7447866522103b18107f154083cb Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 9 Jan 2020 11:50:27 +0000 Subject: [PATCH] cmdline: Make sure all errors go through main () function. --- src/cmdline.ml | 54 +++++++++++++++++++++++++++++------------------------- src/cmdline.mli | 24 ++++++++++++------------ src/eval.ml | 14 +++++--------- src/jobs.ml | 4 ++-- src/main.ml | 23 +++++++++++++---------- src/parse.ml | 22 +++++++++------------- src/parser.mly | 2 +- src/run.ml | 12 ++++-------- 8 files changed, 75 insertions(+), 80 deletions(-) diff --git a/src/cmdline.ml b/src/cmdline.ml index 0549833..0ac1ad5 100644 --- a/src/cmdline.ml +++ b/src/cmdline.ml @@ -45,21 +45,19 @@ let datadir = let stdlibdir = datadir // "stdlib" let prelude_gl_file = stdlibdir // "prelude.gl" let prelude_sh_file = stdlibdir // "prelude.sh" -let () = + +let debug_flag = ref false +let directory = ref "." +let input_file = ref "Goalfile" +let includes = ref [stdlibdir] +let add_include dir = includes := dir :: !includes +let nr_jobs = ref 4 (* XXX use nproc *) +let use_prelude = ref true + +let parse () = if not (is_directory stdlibdir) || not (Sys.file_exists prelude_gl_file) then failwithf "%s: cannot find the standard library directory, expected %s. If the standard library directory is in a non-standard location then set GOALS_DATADIR. If you can trying to run goals from the build directory then use ‘./run goals ...’" - Sys.executable_name stdlibdir - -let input_file, - debug_flag, directory, includes, nr_jobs, use_prelude, anon_vars, targets = - let args = ref [] in - let debug_flag = ref false in - let directory = ref "." in - let input_file = ref "Goalfile" in - let includes = ref [stdlibdir] in - let add_include dir = includes := dir :: !includes in - let nr_jobs = ref 4 (* XXX use nproc *) in - let use_prelude = ref true in + Sys.executable_name stdlibdir; let argspec = [ "-C", Arg.Set_string directory, @@ -88,19 +86,15 @@ let input_file, " Print version and exit"; ] in let argspec = Arg.align argspec in + let args = ref [] in let anon_fun s = args := s :: !args in Arg.parse argspec anon_fun usage; - let args = List.rev !args in - let debug_flag = !debug_flag in - let directory = !directory in - let input_file = !input_file in - (* Don't reverse includes - we want newer -I options to take precedence. *) - let includes = !includes in - let nr_jobs = !nr_jobs in - if nr_jobs < 1 then + (* Check various params are sensible. *) + if !nr_jobs < 1 then failwithf "%s: -j must be >= 1" Sys.executable_name; - let use_prelude = !use_prelude in + + let args = List.rev !args in (* Get the anon var assignments and targets. *) let anon_vars, targets = @@ -116,10 +110,20 @@ let input_file, (name, expr) ) anon_vars in - input_file, - debug_flag, directory, includes, nr_jobs, use_prelude, anon_vars, targets + anon_vars, targets + +let debug_flag () = !debug_flag (* Create the debug function. *) let debug fs = - let display str = if debug_flag then prerr_endline str in + let display str = if debug_flag () then prerr_endline str in ksprintf display fs + +let directory () = !directory +let input_file () = !input_file + +(* Don't reverse includes - we want newer -I options to take precedence. *) +let includes () = !includes + +let nr_jobs () = !nr_jobs +let use_prelude () = !use_prelude diff --git a/src/cmdline.mli b/src/cmdline.mli index d2e889f..3372684 100644 --- a/src/cmdline.mli +++ b/src/cmdline.mli @@ -17,6 +17,12 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +val parse : unit -> (string * string) list * string list +(** Parse the command line. + Returns two lists: + anon_vars = List of anonymous variable assignments. + targets = List of target expressions on the command line. *) + val stdlibdir : string (** Get the stdlib directory. *) @@ -26,30 +32,24 @@ val prelude_gl_file : string val prelude_sh_file : string (** Get the absolute path of the prelude.sh file. *) -val input_file : string +val input_file : unit -> string (** Get the name of the input Goalfile. *) val debug : ('a, unit, string, unit) format4 -> 'a (** If debugging is enabled (-d option) then print the formatted output. If debugging was not enabled then nothing is printed. *) -val debug_flag : bool +val debug_flag : unit -> bool (** If debugging is enabled. *) -val directory : string +val directory : unit -> string (** Get the name of working directory (-C option). *) -val includes : string list +val includes : unit -> string list (** Get list of include directories (-I option). *) -val nr_jobs : int +val nr_jobs : unit -> int (** Number of jobs (-j option). *) -val use_prelude : bool +val use_prelude : unit -> bool (** True if we should load the prelude, or false if --no-prelude. *) - -val anon_vars : (string * string) list -(** List of anonymous variable assignments on the command line. *) - -val targets : string list -(** List of target expressions on the command line. *) diff --git a/src/eval.ml b/src/eval.ml index 4589a40..59f4ca4 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -186,7 +186,7 @@ and run_code_to_string_list env loc code = i, lines and prepare_code env loc (code, quiet) = - let quiet = if Cmdline.debug_flag then false else quiet in + let quiet = if Cmdline.debug_flag () then false else quiet in let code = to_shell_script env loc code in "source " ^ Filename.quote Cmdline.prelude_sh_file ^ "\n" ^ "set -e\n" ^ @@ -270,18 +270,14 @@ and call_function_really env loc name returning code = match returning with | RetExpr -> let r, b = run_code_to_string env loc code in - if r <> 0 then ( - eprintf "*** function ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); + if r <> 0 then + failwithf "function ‘%s’ failed with exit code %d" name r; Parse.parse_expr (sprintf "function:%s" name) b | RetString -> let r, b = run_code_to_string env loc code in - if r <> 0 then ( - eprintf "*** function ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); + if r <> 0 then + failwithf "function ‘%s’ failed with exit code %d" name r; Ast.EConstant (loc, Ast.CString b) | RetStrings -> diff --git a/src/jobs.ml b/src/jobs.ml index 5b1067f..708a258 100644 --- a/src/jobs.ml +++ b/src/jobs.ml @@ -90,7 +90,7 @@ module Make (K : Key) = struct let id = Thread.id (Thread.self ()) in Mutex.lock lock; incr ready; - while not !stop && !ready <= Cmdline.nr_jobs do + while not !stop && !ready <= Cmdline.nr_jobs () do (* See if there's any queue with a job which is ready to run. *) Cmdline.debug "thread %d: checking for a runnable queue" id; match get_runnable_queue () with @@ -176,7 +176,7 @@ module Make (K : Key) = struct while not (all_done group); do decr ready; (* Start more threads if fewer than nr_jobs threads are ready. *) - let needed = Cmdline.nr_jobs - !ready in + let needed = Cmdline.nr_jobs () - !ready in if needed > 0 then ignore (Array.init needed (Thread.create worker)); diff --git a/src/main.ml b/src/main.ml index 62ea68a..9890dba 100644 --- a/src/main.ml +++ b/src/main.ml @@ -27,8 +27,11 @@ let () = Parser.eval_substitute := Some Eval.substitute let main () = + (* Handle the command line. *) + let anon_vars, targets = Cmdline.parse () in + (* Change directory (-C option). *) - Sys.chdir Cmdline.directory; + Sys.chdir (Cmdline.directory ()); (* Create the initial environment, containing the system environment * and a few other standard strings. @@ -48,12 +51,12 @@ let main () = (* Parse the prelude. *) let env = - if Cmdline.use_prelude then + if Cmdline.use_prelude () then Parse.parse_goalfile env Cmdline.prelude_gl_file else env in (* Parse the input file. *) - let env = Parse.parse_goalfile env Cmdline.input_file in + let env = Parse.parse_goalfile env (Cmdline.input_file ()) in (* Parse the command line assignments. *) let env = @@ -61,17 +64,17 @@ let main () = fun env (name, expr) -> let expr = Parse.parse_expr "commandline" expr in Ast.Env.add name expr env - ) env Cmdline.anon_vars in + ) env anon_vars in (* Parse the target expressions. *) - let targets = List.map (Parse.parse_expr "commandline") Cmdline.targets in + let targets = List.map (Parse.parse_expr "commandline") targets in (* If no target was set on the command line, use "all ()". *) let targets = if targets <> [] then targets else [Ast.ECall (Ast.noloc, "all", [])] in - if Cmdline.debug_flag then + if Cmdline.debug_flag () then Ast.print_env stderr env; (* Run the target expressions. *) @@ -80,7 +83,7 @@ let main () = let () = try main () with - Failure msg | Sys_error msg -> - Run.stop_all (); - prerr_endline ("*** error: " ^ msg); - exit 1 + | Failure msg | Sys_error msg -> + Run.stop_all (); + prerr_endline ("*** error: " ^ msg); + exit 1 diff --git a/src/parse.ml b/src/parse.ml index 19c57ac..34ed38b 100644 --- a/src/parse.ml +++ b/src/parse.ml @@ -17,15 +17,15 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Lexer open Lexing - open Printf -let print_position fp lexbuf = +open Utils +open Lexer + +let string_position () lexbuf = let pos = lexbuf.lex_curr_p in - fprintf fp "%s:%d:%d" - pos.pos_fname pos.pos_lnum (pos.pos_cnum - pos.pos_bol) + sprintf "%s:%d:%d" pos.pos_fname pos.pos_lnum (pos.pos_cnum - pos.pos_bol) let parse_file env lexbuf = try @@ -33,21 +33,17 @@ let parse_file env lexbuf = Ast.Env.merge env env' with | SyntaxError msg -> - eprintf "%a: %s\n" print_position lexbuf msg; - exit 1 + failwithf "%a: %s" string_position lexbuf msg | Parser.Error -> - eprintf "%a: parse error\n" print_position lexbuf; - exit 1 + failwithf "%a: parse error" string_position lexbuf let parse_expr lexbuf = try Parser.expr Lexer.read lexbuf with | SyntaxError msg -> - eprintf "%a: %s\n" print_position lexbuf msg; - exit 1 + failwithf "%a: %s" string_position lexbuf msg | Parser.Error -> - eprintf "%a: parse error\n" print_position lexbuf; - exit 1 + failwithf "%a: parse error" string_position lexbuf (* This is used to parse the Goalfile. *) let parse_goalfile env filename = diff --git a/src/parser.mly b/src/parser.mly index 7146a99..eedbddb 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -38,7 +38,7 @@ let find_on_include_path filename = let path = inc // filename in if Sys.file_exists path then path else loop incs in - loop Cmdline.includes + loop (Cmdline.includes ()) ) let do_include env loc filename optflag file = diff --git a/src/run.ml b/src/run.ml index c3aa11e..2df305b 100644 --- a/src/run.ml +++ b/src/run.ml @@ -168,10 +168,8 @@ and run_goal env loc name args (params, patterns, deps, code) extra_deps = | [] -> env | d :: _ -> Ast.Env.add "^" d env in let r = Eval.run_code env loc code in - if r <> 0 then ( - eprintf "*** goal ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); + if r <> 0 then + failwithf "goal ‘%s’ failed with exit code %d" name r; (* Check all targets were updated after the code was * run (else it's an error). @@ -229,10 +227,8 @@ and needs_rebuild env loc deps extra_deps pattern = let r = Eval.run_code env loc code in if r = 99 (* means "needs rebuild" *) then true else if r = 0 (* means "doesn't need rebuild" *) then false - else ( - eprintf "*** tactic ‘%s’ failed with exit code %d\n" tactic r; - exit 1 - ) + else + failwithf "tactic ‘%s’ failed with exit code %d" tactic r (* Find the goal which matches the given tactic and start it. * cargs is a list of parameters (all constants). -- 1.8.3.1