From: Richard W.M. Jones Date: Tue, 7 Jan 2020 13:31:46 +0000 (+0000) Subject: eval: Split running external code according to return type. X-Git-Tag: v'0.2'~70 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=800244e4c76abb5092b1f265a1186d76cfba6f06;p=goals.git eval: Split running external code according to return type. Previously we were wrongly hiding stdout in some cases. Fixes commit a48b05d35f0646322e8178ff10f8ed7af3e739aa and commit 2ac1b84cb49ad04e27b4543436b0227153fbfb15. --- diff --git a/src/eval.ml b/src/eval.ml index 6115321..b614ddc 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -144,15 +144,12 @@ and expr_to_shell_string env = function failwithf "%a: cannot use tactic in shell expansion" Ast.string_loc loc -and run_code env loc (code, quiet) = - let code = to_shell_script env loc code in - let code = - "source " ^ Filename.quote Cmdline.prelude_sh_file ^ "\n" ^ - "set -e\n" ^ - (if not quiet then "set -x\n" else "") ^ - "\n" ^ - code in +and run_code env loc code = + let code = prepare_code env loc code in + Sys.command code +and run_code_to_string env loc code = + let code = prepare_code env loc code in let chan = Unix.open_process_in code in let b = Buffer.create 1024 in (try @@ -171,6 +168,31 @@ and run_code env loc (code, quiet) = failwithf "%a: stopped by signal %d" Ast.string_loc loc i in i, Buffer.contents b +and run_code_to_string_list env loc code = + let code = prepare_code env loc code in + let chan = Unix.open_process_in code in + let lines = ref [] in + (try while true do lines := input_line chan :: !lines done + with End_of_file -> ()); + let st = Unix.close_process_in chan in + let i = + match st with + | Unix.WEXITED i -> i + | Unix.WSIGNALED i -> + failwithf "%a: killed by signal %d" Ast.string_loc loc i + | Unix.WSTOPPED i -> + failwithf "%a: stopped by signal %d" Ast.string_loc loc i in + let lines = List.rev !lines in + i, lines + +and prepare_code env loc (code, quiet) = + let code = to_shell_script env loc code in + "source " ^ Filename.quote Cmdline.prelude_sh_file ^ "\n" ^ + "set -e\n" ^ + (if not quiet then "set -x\n" else "") ^ + "\n" ^ + code + and evaluate_goal_arg env = function | Ast.EVar (loc, name) -> let expr = Ast.getvar env loc name in @@ -244,26 +266,26 @@ and call_function env loc name args (params, returning, pure, code) = else call_function_really env loc name returning code and call_function_really env loc name returning code = - let r, b = run_code env loc code in - if r <> 0 then ( - eprintf "*** function ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); - match returning with - | RetExpr -> Parse.parse_expr (sprintf "function:%s" name) b - | RetString -> Ast.EConstant (loc, Ast.CString b) + | 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 + ); + 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 + ); + Ast.EConstant (loc, Ast.CString b) + | RetStrings -> - (* run_code always adds \n after the final line, so when we - * read it back we will get a final empty string which we - * have to drop. XXX Probably better to preserve the lines - * read from the external command. - *) - let strs = nsplit "\n" b in - let strs = List.rev strs in - let strs = match strs with "" :: xs -> xs | xs -> xs in - let strs = List.rev strs in - let strs = List.map (fun s -> Ast.EConstant (loc, Ast.CString s)) strs in + let r, lines = run_code_to_string_list env loc code in + let strs = List.map (fun s -> Ast.EConstant (loc, Ast.CString s)) lines in EList (loc, strs) (* For pure functions, check if the function can be matched to diff --git a/src/eval.mli b/src/eval.mli index 82bab71..a2c2872 100644 --- a/src/eval.mli +++ b/src/eval.mli @@ -27,9 +27,18 @@ val to_constant : Ast.env -> Ast.expr -> Ast.constant raises [Failure _]. *) val substitute : Ast.env -> Ast.loc -> Ast.substs -> string -(** Run a code section. Returns the exit code and the output printed - by the script. Raises [Failure _] on error. *) -val run_code : Ast.env -> Ast.loc -> Ast.code -> int * string +(** Run a code section. Returns the exit code. + Raises [Failure _] on error. *) +val run_code : Ast.env -> Ast.loc -> Ast.code -> int + +(** Run a code section. Returns the exit code and the full stdout + as a string. Raises [Failure _] on error. *) +val run_code_to_string : Ast.env -> Ast.loc -> Ast.code -> int * string + +(** Run a code section. Returns the exit code and the full stdout + as a list of strings. Raises [Failure _] on error. *) +val run_code_to_string_list : Ast.env -> Ast.loc -> Ast.code -> + int * string list (** Evaluate a goal argument. This substitutes any variables found, and recursively calls functions. *) diff --git a/src/run.ml b/src/run.ml index 9eb3df6..0d4fa88 100644 --- a/src/run.ml +++ b/src/run.ml @@ -132,7 +132,7 @@ and run_goal env loc name args (params, patterns, deps, code) extra_deps = match deps with | [] -> env | d :: _ -> Ast.Env.add "^" d env in - let r, _ = Eval.run_code env loc code 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 @@ -191,7 +191,7 @@ and needs_rebuild env loc deps extra_deps pattern = match deps with | [] -> env | d :: _ -> Ast.Env.add "^" d env in - let r, _ = Eval.run_code env loc code in + 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 (