Something went wrong. Try again.
How a command-line program ends
Something went wrong. Try again.
16 kB · 386 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387(* Every ending is a process's, so each case runs the probe as one. *)
let probe = match Sys.getenv_opt "CLI_EXIT_PROBE" with | Some p -> p | None -> failwith "CLI_EXIT_PROBE names the probe this suite runs as a subprocess"
(* A group that strips a root-level option before dispatch. *)let dispatch = match Sys.getenv_opt "CLI_EXIT_DISPATCH" with | Some p -> p | None -> failwith "CLI_EXIT_DISPATCH names the group probe this suite runs as a \ subprocess"
(* A command whose term answers its exit status. *)let status_probe = match Sys.getenv_opt "CLI_EXIT_STATUS_PROBE" with | Some p -> p | None -> failwith "CLI_EXIT_STATUS_PROBE names the status probe this suite runs as a \ subprocess"
(* A command whose term answers its status, run with [~parse_error]. *)let parse_probe = match Sys.getenv_opt "CLI_EXIT_PARSE_PROBE" with | Some p -> p | None -> failwith "CLI_EXIT_PARSE_PROBE names the parse-error probe this suite runs as a \ subprocess"
let contains needle haystack = let n = String.length needle and m = String.length haystack in let rec seek i = i + n <= m && (String.sub haystack i n = needle || seek (i + 1)) in n = 0 || seek 0
let status = let pp ppf = function | Unix.WEXITED n -> Fmt.pf ppf "exited %d" n | Unix.WSIGNALED n -> Fmt.pf ppf "died on signal %d" n | Unix.WSTOPPED n -> Fmt.pf ppf "stopped on signal %d" n in Alcotest.testable pp ( = )
let read_all fd = let buf = Buffer.create 256 in let chunk = Bytes.create 4096 in let rec loop () = match Unix.read fd chunk 0 (Bytes.length chunk) with | 0 -> Buffer.contents buf | n -> Buffer.add_subbytes buf chunk 0 n; loop () in loop ()
let spawn ?(program = probe) ?(env = Unix.environment ()) ~out args = let err_r, err_w = Unix.pipe () in let argv = Array.of_list (program :: args) in let pid = Unix.create_process_env program argv env Unix.stdin out err_w in Unix.close err_w; let err = read_all err_r in Unix.close err_r; let _, st = Unix.waitpid [] pid in (st, err)
(* Runs the probe with its standard output on a pipe whose reader has already gone, so the first write meets a closed pipe whatever the scheduler does. *)let with_closed_reader ?program ?env args = let r, w = Unix.pipe () in Unix.close r; let st, err = spawn ?program ?env ~out:w args in Unix.close w; (st, err)
(* Runs the probe with a reader on both pipes and answers everything it wrote. stderr stays small in every case that uses this, so reading stdout first cannot fill it. *)let with_reader ?(program = probe) ?(env = Unix.environment ()) args = let out_r, out_w = Unix.pipe () in let err_r, err_w = Unix.pipe () in let argv = Array.of_list (program :: args) in let pid = Unix.create_process_env program argv env Unix.stdin out_w err_w in Unix.close out_w; Unix.close err_w; let out = read_all out_r in let err = read_all err_r in Unix.close out_r; Unix.close err_r; let _, st = Unix.waitpid [] pid in (st, out, err)
let check_quiet ?program ?env what args = let st, err = with_closed_reader ?program ?env args in Alcotest.(check string) (what ^ ": nothing on stderr") "" err; Alcotest.check status (what ^ ": ends at 0") (Unix.WEXITED 0) st
let test_listing () = check_quiet "a listing" [ "lines" ]
(* What cmdliner writes itself, before anything has ignored SIGPIPE; the default disposition would end the process here at signal 13. *)let test_help () = check_quiet "the program's help" [ "--help=plain" ]
(* This process's environment with each binding replacing whatever it inherited under that name, so a case that pins TERM answers the same on a machine that already sets one. *)let env_with bindings = let names = List.map (fun binding -> String.sub binding 0 (String.index binding '=')) bindings in let inherited = List.filter (fun binding -> not (List.exists (fun name -> String.starts_with ~prefix:(name ^ "=") binding) names)) (Array.to_list (Unix.environment ())) in Array.of_list (bindings @ inherited)
(* A pager script that leaves a file behind, and the path it leaves. A file, not a string in the output: a pager that runs and writes nothing would leave no trace in what the reader sees. *)let pager_that_marks () = let dir = Filename.temp_file "cli-exit-pager" "" in Sys.remove dir; Unix.mkdir dir 0o700; let mark = Filename.concat dir "ran" in let script = Filename.concat dir "pager.sh" in let oc = open_out script in output_string oc (Fmt.str "#!/bin/sh@.: > %s@.cat@." (Filename.quote mark)); close_out oc; Unix.chmod script 0o755; (script, mark)
let terminal_env () = let pager, mark = pager_that_marks () in (env_with [ "TERM=xterm-256color"; "PAGER=" ^ pager; "MANPAGER=" ], mark)
(* Auto help under a terminal's TERM ends quietly rather than through a pager child. *)let test_auto_help () = let env, _mark = terminal_env () in check_quiet ~env "Auto help into a closed reader" [ "--help" ]
(* A bare [--help] under a terminal's TERM spawns nothing, returns, and writes the same bytes [--help=plain] does. *)let test_auto_help_is_not_paged () = let env, mark = terminal_env () in let st, out, err = with_reader ~env [ "--help" ] in Alcotest.check status "returns, at 0" (Unix.WEXITED 0) st; Alcotest.(check string) "writes nothing to stderr" "" err; Alcotest.(check bool) "spawns no pager" false (Sys.file_exists mark); Alcotest.(check bool) "writes text, not groff overstrike" false (String.contains out '\b'); let _, plain, _ = with_reader ~env [ "--help=plain" ] in Alcotest.(check string) "one spelling of the manual" plain out
(* The manual says the page is never paged, under the terminal's TERM where cmdliner's own sentence would say the opposite. *)let test_help_says_the_manual_never_pages () = let env, _mark = terminal_env () in let st, out, err = with_reader ~env [ "--help" ] in Alcotest.check status "returns, at 0" (Unix.WEXITED 0) st; Alcotest.(check string) "writes nothing to stderr" "" err; Alcotest.(check bool) "the option is still documented" true (contains "--help[=FMT]" out); Alcotest.(check bool) "cmdliner's own rule is not on the page" false (contains "the format is pager or plain" out); Alcotest.(check bool) "the page says what this program does" true (contains "never opens a pager" out)
(* Suppressing cmdliner's [--help] item does not suppress [--version]: it is still parsed, still answers, and is still listed. *)let test_version_survives_the_substitution () = let st, out, err = with_reader [ "--version" ] in Alcotest.check status "exits at 0" (Unix.WEXITED 0) st; Alcotest.(check string) "writes the version" "1.0\n" out; Alcotest.(check string) "writes nothing to stderr" "" err; let _, manual, _ = with_reader [ "--help=plain" ] in Alcotest.(check bool) "and the manual still lists it" true (contains "Show version information." manual)
let test_eio_output () = check_quiet "a listing through Eio" [ "copy" ]
(* A closed pipe must not cost the report for an exception nothing expected. *)let test_internal_error () = let st, out, err = with_reader [ "boom" ] in Alcotest.check status "exits at the internal-error code" (Unix.WEXITED 125) st; Alcotest.(check string) "writes nothing to stdout" "" out; let first = List.hd (String.split_on_char '\n' err) in Alcotest.(check string) "reports it under the program's own name" "probe: internal error, uncaught exception:" first; Alcotest.(check bool) "names the exception" true (contains "Failure(\"nothing expected this\")" err); let styled = String.exists (fun c -> Char.code c < 32 && not (Char.equal c '\n')) err in Alcotest.(check bool) "carries no terminal styling" false styled
(* An exception the program raises to refuse reaches [run], the case [~refusal] exists for: without it the caller's own condition is reported as a defect in the program. *)let test_refusal () = let st, out, err = with_reader [ "deny" ] in Alcotest.check status "exits at the refusal status" (Unix.WEXITED Cli_exit.refused) st; Alcotest.(check string) "writes nothing to stdout" "" out; Alcotest.(check string) "reports the sentence alone, under the program's name" "probe: the count is not one this command counts to\n" err; let _, manual, _ = with_reader [ "--help=plain" ] in Alcotest.(check bool) "the manual declares the status a refusal ends on" true (contains (Fmt.str "\n %d " Cli_exit.refused) manual)
(* A command line the term refuses is the operator's to fix, so it keeps the status cmdliner gives it. *)let test_refused () = let st, out, err = with_reader [ "refuse" ] in Alcotest.check status "exits at the cli-error code" (Unix.WEXITED 124) st; Alcotest.(check string) "writes nothing to stdout" "" out; Alcotest.(check string) "reports what the term refused" "probe: the image is not one this command reads\n" err
(* Writes that met no closed reader leave the process alone, and the call answers what the function answered. *)let test_writing_output_is_transparent () = let answer = Cli_exit.writing_output (fun () -> "written") in Alcotest.(check string) "answers what the function answered" "written" answer
(* A root-level option stripped before dispatch, so the verb runs on the command line the caller shortened. *)let test_argv_reaches_the_verb () = let st, out, err = with_reader ~program:dispatch [ "-C"; "somewhere"; "say"; "hello" ] in Alcotest.check status "exits at 0" (Unix.WEXITED 0) st; Alcotest.(check string) "the verb ran, and the option reached it" "somewhere hello\n" out; Alcotest.(check string) "writes nothing to stderr" "" err
(* A run with no [~argv] reaches the probe's own command line, pinning the {!Sys.argv} default. *)let test_ordinary_run () = let st, out, err = with_reader [ "lines"; "--count"; "3" ] in Alcotest.check status "exits at 0" (Unix.WEXITED 0) st; Alcotest.(check string) "writes its listing" "line 1\nline 2\nline 3\n" out; Alcotest.(check string) "writes nothing to stderr" "" err
(* A command answering its own status ends quietly at 0 on a closed pipe, not at the status it would have answered. *)let test_status_listing () = check_quiet ~program:status_probe "a status command's listing" [ "--status"; "3" ]
(* With its reader present, the process ends at the status the term answered, after its whole listing. *)let test_status_answered () = let st, out, err = with_reader ~program:status_probe [ "--count"; "2"; "--status"; "3" ] in Alcotest.check status "exits at the term's status" (Unix.WEXITED 3) st; Alcotest.(check string) "writes its listing" "line 1\nline 2\n" out; Alcotest.(check string) "writes nothing to stderr" "" err
let parse_usage = "Usage: parse-probe [--help] [--count=N] [--refuse] [OPTION]\u{2026}\n"
(* An unknown option ends at the status [~parse_error] answers: cmdliner's usage line stays on stderr, and its message reaches the program alone. *)let test_parse_error () = let env = env_with [ "TERM=dumb" ] in let st, out, err = with_reader ~program:parse_probe ~env [ "--no-such-flag" ] in Alcotest.check status "exits at the status parse_error answers" (Unix.WEXITED 2) st; Alcotest.(check string) "the message reaches the program, without its name" "refused: unknown option '--no-such-flag'\n" out; Alcotest.(check string) "the usage stays on stderr, alone" parse_usage err
(* A value the converter refuses is a command line that does not parse. *)let test_parse_error_value () = let env = env_with [ "TERM=dumb" ] in let st, out, err = with_reader ~program:parse_probe ~env [ "--count=x" ] in Alcotest.check status "exits at the status parse_error answers" (Unix.WEXITED 2) st; Alcotest.(check string) "the converter's message reaches the program" "refused: option '--count': invalid value 'x', expected an integer\n" out; Alcotest.(check string) "the usage stays on stderr, alone" parse_usage err
(* An error of the term's own, which cmdliner answers as it answers a parse error, with no usage line. *)let test_parse_error_term () = let env = env_with [ "TERM=dumb" ] in let st, out, err = with_reader ~program:parse_probe ~env [ "--refuse" ] in Alcotest.check status "exits at the status parse_error answers" (Unix.WEXITED 2) st; Alcotest.(check string) "the term's message reaches the program" "refused: the term refused\n" out; Alcotest.(check string) "nothing on stderr" "" err
(* Off a terminal, under a TERM cmdliner styles for, the usage line and the message read as they do under TERM=dumb: no escape, and a name quoted. *)let test_parse_error_plain () = let env = env_with [ "TERM=xterm-256color"; "NO_COLOR=" ] in let st, out, err = with_reader ~program:parse_probe ~env [ "--no-such-flag" ] in Alcotest.check status "exits at the status parse_error answers" (Unix.WEXITED 2) st; Alcotest.(check string) "the usage is plain" parse_usage err; Alcotest.(check string) "the message is the plain one" "refused: unknown option '--no-such-flag'\n" out; let _, out, err = with_reader ~program:parse_probe ~env [ "--count=x" ] in Alcotest.(check string) "a refused value's usage is plain" parse_usage err; Alcotest.(check string) "a refused value's message is the plain one" "refused: option '--count': invalid value 'x', expected an integer\n" out
(* A command line that parses never reaches [parse_error]. *)let test_parse_error_unused () = let env = env_with [ "TERM=dumb" ] in let st, out, err = with_reader ~program:parse_probe ~env [ "--count"; "2" ] in Alcotest.check status "exits at the term's status" (Unix.WEXITED 0) st; Alcotest.(check string) "writes its listing" "line 1\nline 2\n" out; Alcotest.(check string) "writes nothing to stderr" "" err
let suite = ( "cli_exit", [ Alcotest.test_case "a listing into a closed reader" `Quick test_listing; Alcotest.test_case "help into a closed reader" `Quick test_help; Alcotest.test_case "Auto help into a closed reader" `Quick test_auto_help; Alcotest.test_case "Auto help is written, never paged" `Quick test_auto_help_is_not_paged; Alcotest.test_case "the manual says it is never paged" `Quick test_help_says_the_manual_never_pages; Alcotest.test_case "--version survives the substitution" `Quick test_version_survives_the_substitution; Alcotest.test_case "Eio output into a closed reader" `Quick test_eio_output; Alcotest.test_case "an exception nothing expected" `Quick test_internal_error; Alcotest.test_case "an exception raised to refuse" `Quick test_refusal; Alcotest.test_case "a refused command line" `Quick test_refused; Alcotest.test_case "writing_output answers its function" `Quick test_writing_output_is_transparent; Alcotest.test_case "an option stripped before dispatch" `Quick test_argv_reaches_the_verb; Alcotest.test_case "a status command into a closed reader" `Quick test_status_listing; Alcotest.test_case "a status command ends at its status" `Quick test_status_answered; Alcotest.test_case "an ordinary run" `Quick test_ordinary_run; Alcotest.test_case "parse_error: an unknown option" `Quick test_parse_error; Alcotest.test_case "parse_error: a value refused" `Quick test_parse_error_value; Alcotest.test_case "parse_error: the term's own error" `Quick test_parse_error_term; Alcotest.test_case "parse_error: plain off a terminal, whatever TERM" `Quick test_parse_error_plain; Alcotest.test_case "parse_error: a line that parses" `Quick test_parse_error_unused; ] )