This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
35
unikernel/duniverse/cmdliner/test/blueprint_cmds.ml
Normal file
35
unikernel/duniverse/cmdliner/test/blueprint_cmds.ml
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let hey () = Cmdliner.Cmd.Exit.ok
|
||||
let ho () = Cmdliner.Cmd.Exit.ok
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag")
|
||||
let infile =
|
||||
let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in
|
||||
Arg.(value & pos 0 file "-" & info [] ~doc ~docv:"FILE")
|
||||
|
||||
let hey_cmd =
|
||||
let doc = "The hey command synopsis is TODO" in
|
||||
Cmd.make (Cmd.info "hey" ~doc) @@
|
||||
let+ unit = Term.const () in
|
||||
ho ()
|
||||
|
||||
let ho_cmd =
|
||||
let doc = "The ho command synopsis is TODO" in
|
||||
Cmd.make (Cmd.info "ho" ~doc) @@
|
||||
let+ unit = Term.const () in
|
||||
ho unit
|
||||
|
||||
let cmd =
|
||||
let doc = "The tool synopsis is TODO" in
|
||||
Cmd.group (Cmd.info "TODO-toolname" ~version:"v2.0.0+dune" ~doc) @@
|
||||
[hey_cmd; ho_cmd]
|
||||
|
||||
let main () = Cmd.eval' cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
18
unikernel/duniverse/cmdliner/test/blueprint_min.ml
Normal file
18
unikernel/duniverse/cmdliner/test/blueprint_min.ml
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let tool () = Cmdliner.Cmd.Exit.ok
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let cmd =
|
||||
let doc = "The tool synopsis is TODO" in
|
||||
Cmd.make (Cmd.info "TODO-toolname" ~doc) @@
|
||||
let+ unit = Term.const () in
|
||||
tool unit
|
||||
|
||||
let main () = Cmd.eval' cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
33
unikernel/duniverse/cmdliner/test/blueprint_tool.ml
Normal file
33
unikernel/duniverse/cmdliner/test/blueprint_tool.ml
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let exit_todo = 1
|
||||
|
||||
let tool ~flag ~infile = exit_todo
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let flag = Arg.(value & flag & info ["flag"] ~doc:"The flag")
|
||||
let infile =
|
||||
let doc = "$(docv) is the input file. Use $(b,-) for $(b,stdin)." in
|
||||
Arg.(value & pos 0 file "-" & info [] ~doc ~docv:"FILE")
|
||||
|
||||
let cmd =
|
||||
let doc = "The tool synopsis is TODO" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "$(cmd) does TODO" ]
|
||||
in
|
||||
let exits =
|
||||
Cmd.Exit.info exit_todo ~doc:"When there is stuff todo" ::
|
||||
Cmd.Exit.defaults
|
||||
in
|
||||
Cmd.make (Cmd.info "TODO" ~version:"v2.0.0+dune" ~doc ~man ~exits) @@
|
||||
let+ flag and+ infile in
|
||||
tool ~flag ~infile
|
||||
|
||||
let main () = Cmd.eval' cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
38
unikernel/duniverse/cmdliner/test/example_chorus.ml
Normal file
38
unikernel/duniverse/cmdliner/test/example_chorus.ml
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Implementation of the command *)
|
||||
|
||||
let chorus ~count msg = for i = 1 to count do print_endline msg done
|
||||
|
||||
(* Command line interface *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let count =
|
||||
let doc = "Repeat the message $(docv) times." in
|
||||
Arg.(value & opt int 10 & info ["c"; "count"] ~doc ~docv:"COUNT")
|
||||
|
||||
let msg =
|
||||
let env =
|
||||
let doc = "Overrides the default message to print." in
|
||||
Cmd.Env.info "CHORUS_MSG" ~doc
|
||||
in
|
||||
let doc = "The message to print." in
|
||||
Arg.(value & pos 0 string "Revolt!" & info [] ~env ~doc ~docv:"MSG")
|
||||
|
||||
let chorus_cmd =
|
||||
let doc = "Print a customizable message repeatedly" in
|
||||
let man = [
|
||||
`S Manpage.s_bugs;
|
||||
`P "Email bug reports to <bugs@example.org>." ]
|
||||
in
|
||||
Cmd.make (Cmd.info "chorus" ~version:"v2.0.0+dune" ~doc ~man) @@
|
||||
let+ count and+ msg in
|
||||
chorus ~count msg
|
||||
|
||||
let main () = Cmd.eval chorus_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
58
unikernel/duniverse/cmdliner/test/example_cp.ml
Normal file
58
unikernel/duniverse/cmdliner/test/example_cp.ml
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Implementation, we check the dest argument and print the args *)
|
||||
|
||||
let cp ~verbose ~recurse ~force srcs dest =
|
||||
let many = List.length srcs > 1 in
|
||||
if many && (not (Sys.file_exists dest) || not (Sys.is_directory dest))
|
||||
then `Error (false, dest ^ ": not a directory") else
|
||||
`Ok (Printf.printf
|
||||
"verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n"
|
||||
verbose recurse force (String.concat ", " srcs) dest)
|
||||
|
||||
(* Command line interface *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let verbose =
|
||||
let doc = "Print file names as they are copied." in
|
||||
Arg.(value & flag & info ["v"; "verbose"] ~doc)
|
||||
|
||||
let recurse =
|
||||
let doc = "Copy directories recursively." in
|
||||
Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc)
|
||||
|
||||
let force =
|
||||
let doc = "If a destination file cannot be opened, remove it and try again."in
|
||||
Arg.(value & flag & info ["f"; "force"] ~doc)
|
||||
|
||||
let srcs =
|
||||
let doc = "Source file(s) to copy." in
|
||||
Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc)
|
||||
|
||||
let dest =
|
||||
let doc = "Destination of the copy. Must be a directory if there is more \
|
||||
than one $(i,SOURCE)." in
|
||||
let docv = "DEST" in
|
||||
Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc)
|
||||
|
||||
let cp_cmd =
|
||||
let doc = "Copy files" in
|
||||
let man_xrefs =
|
||||
[`Tool "mv"; `Tool "scp"; `Page ("umask", 2); `Page ("symlink", 7)]
|
||||
in
|
||||
let man = [
|
||||
`S Manpage.s_bugs;
|
||||
`P "Email them to <bugs@example.org>."; ]
|
||||
in
|
||||
Cmd.make (Cmd.info "cp" ~version:"v2.0.0+dune" ~doc ~man ~man_xrefs) @@
|
||||
Term.ret @@
|
||||
let+ verbose and+ recurse and+ force and+ srcs and+ dest in
|
||||
cp ~verbose ~recurse ~force srcs dest
|
||||
|
||||
let main () = Cmd.eval cp_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
156
unikernel/duniverse/cmdliner/test/example_darcs.ml
Normal file
156
unikernel/duniverse/cmdliner/test/example_darcs.ml
Normal file
|
|
@ -0,0 +1,156 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Implementations, just print the args. *)
|
||||
|
||||
type verb = Normal | Quiet | Verbose
|
||||
type copts = { debug : bool; verb : verb; prehook : string option }
|
||||
|
||||
let str = Printf.sprintf
|
||||
let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v)
|
||||
let opt_str_str = opt_str (fun s -> s)
|
||||
let verb_str = function
|
||||
| Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose"
|
||||
|
||||
let pr_copts oc copts = Printf.fprintf oc
|
||||
"debug = %B\nverbosity = %s\nprehook = %s\n"
|
||||
copts.debug (verb_str copts.verb) (opt_str_str copts.prehook)
|
||||
|
||||
let initialize copts repodir = Printf.printf
|
||||
"%arepodir = %s\n" pr_copts copts repodir
|
||||
|
||||
let record copts name email all ask_deps files = Printf.printf
|
||||
"%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n"
|
||||
pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps
|
||||
(String.concat ", " files)
|
||||
|
||||
let help copts man_format cmds topic = match topic with
|
||||
| None -> `Help (`Pager, None) (* help about the program. *)
|
||||
| Some topic ->
|
||||
let topics = "topics" :: "patterns" :: "environment" :: cmds in
|
||||
let conv = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in
|
||||
let parse = Cmdliner.Arg.Conv.parser conv in
|
||||
match parse topic with
|
||||
| Error e -> `Error (false, e)
|
||||
| Ok t when t = "topics" -> List.iter print_endline topics; `Ok ()
|
||||
| Ok t when List.mem t cmds -> `Help (man_format, Some t)
|
||||
| Ok t ->
|
||||
let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in
|
||||
`Ok (Cmdliner.Manpage.print man_format Format.std_formatter page)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
(* Help sections common to all commands *)
|
||||
|
||||
let help_secs = [
|
||||
`S Manpage.s_common_options;
|
||||
`P "These options are common to all commands.";
|
||||
`S "MORE HELP";
|
||||
`P "Use $(tool) $(i,COMMAND) --help for help on a single command.";`Noblank;
|
||||
`P "Use $(tool) $(b,help patterns) for help on patch matching."; `Noblank;
|
||||
`P "Use $(tool) $(b,help environment) for help on environment variables.";
|
||||
`S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";]
|
||||
|
||||
(* Options common to all commands *)
|
||||
|
||||
let copts debug verb prehook = { debug; verb; prehook }
|
||||
let copts_t =
|
||||
let docs = Manpage.s_common_options in
|
||||
let debug =
|
||||
let doc = "Give only debug output." in
|
||||
Arg.(value & flag & info ["debug"] ~docs ~doc)
|
||||
in
|
||||
let verb =
|
||||
let doc = "Suppress informational output." in
|
||||
let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in
|
||||
let doc = "Give verbose output." in
|
||||
let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in
|
||||
Arg.(last & vflag_all [Normal] [quiet; verbose])
|
||||
in
|
||||
let prehook =
|
||||
let doc = "Specify command to run before this $(tool) command." in
|
||||
Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc)
|
||||
in
|
||||
Term.(const copts $ debug $ verb $ prehook)
|
||||
|
||||
(* Commands *)
|
||||
|
||||
let sdocs = Manpage.s_common_options
|
||||
|
||||
let initialize_cmd =
|
||||
let repodir =
|
||||
let doc = "Run the program in repository directory $(docv)." in
|
||||
Arg.(value & opt file Filename.current_dir_name & info ["repodir"]
|
||||
~docv:"DIR" ~doc)
|
||||
in
|
||||
let doc = "make the current directory a repository" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "Turns the current directory into a Darcs repository. Any
|
||||
existing files and subdirectories become …";
|
||||
`Blocks help_secs; ]
|
||||
in
|
||||
Cmd.make (Cmd.info "initialize" ~doc ~sdocs ~man) @@
|
||||
let+ copts_t and+ repodir in
|
||||
initialize copts_t repodir
|
||||
|
||||
let record_cmd =
|
||||
let pname =
|
||||
let doc = "Name of the patch." in
|
||||
Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME"
|
||||
~doc)
|
||||
in
|
||||
let author =
|
||||
let doc = "Specifies the author's identity." in
|
||||
Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL"
|
||||
~doc)
|
||||
in
|
||||
let all =
|
||||
let doc = "Answer yes to all patches." in
|
||||
Arg.(value & flag & info ["a"; "all"] ~doc)
|
||||
in
|
||||
let ask_deps =
|
||||
let doc = "Ask for extra dependencies." in
|
||||
Arg.(value & flag & info ["ask-deps"] ~doc)
|
||||
in
|
||||
let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in
|
||||
let doc = "create a patch from unrecorded changes" in
|
||||
let man =
|
||||
[`S Manpage.s_description;
|
||||
`P "Creates a patch from changes in the working tree. If you specify
|
||||
a set of files…";
|
||||
`Blocks help_secs; ]
|
||||
in
|
||||
Cmd.make (Cmd.info "record" ~doc ~sdocs ~man) @@
|
||||
let+ copts_t and+ pname and+ author and+ all and+ ask_deps and+ files in
|
||||
record copts_t pname author all ask_deps files
|
||||
|
||||
let help_cmd =
|
||||
let topic =
|
||||
let doc = "The topic to get help on. $(b,topics) lists the topics." in
|
||||
Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc)
|
||||
in
|
||||
let doc = "display help about darcs and darcs commands" in
|
||||
let man =
|
||||
[`S Manpage.s_description;
|
||||
`P "Prints help about darcs commands and other subjects…";
|
||||
`Blocks help_secs; ]
|
||||
in
|
||||
Cmd.make (Cmd.info "help" ~doc ~man) @@
|
||||
Term.ret @@
|
||||
let+ copts_t and+ man_format = Arg.man_format
|
||||
and+ choice_names = Term.choice_names and+ topic in
|
||||
help copts_t man_format choice_names topic
|
||||
|
||||
let main_cmd =
|
||||
let doc = "a revision control system" in
|
||||
let man = help_secs in
|
||||
let info = Cmd.info "darcs" ~version:"v2.0.0+dune" ~doc ~sdocs ~man in
|
||||
let default = Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)) in
|
||||
Cmd.group info ~default [initialize_cmd; record_cmd; help_cmd]
|
||||
|
||||
let main () = Cmd.eval main_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
9
unikernel/duniverse/cmdliner/test/example_group.ml
Normal file
9
unikernel/duniverse/cmdliner/test/example_group.ml
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let main () = Cmd.eval Testing_cmdliner.sample_group_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
13
unikernel/duniverse/cmdliner/test/example_revolt1.ml
Normal file
13
unikernel/duniverse/cmdliner/test/example_revolt1.ml
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let revolt () = print_endline "Revolt!"
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let revolt_term = Term.app (Term.const revolt) (Term.const ())
|
||||
let revolt_cmd = Cmd.v (Cmd.info "revolt") revolt_term
|
||||
let main () = Cmd.eval revolt_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
17
unikernel/duniverse/cmdliner/test/example_revolt2.ml
Normal file
17
unikernel/duniverse/cmdliner/test/example_revolt2.ml
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let revolt () = print_endline "Revolt!"
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let cmd_revolt =
|
||||
Cmd.make (Cmd.info "revolt") @@
|
||||
let+ () = Term.const () in
|
||||
revolt ()
|
||||
|
||||
let main () = Cmd.eval cmd_revolt
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
65
unikernel/duniverse/cmdliner/test/example_rm.ml
Normal file
65
unikernel/duniverse/cmdliner/test/example_rm.ml
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Implementation of the command, we just print the args. *)
|
||||
|
||||
type prompt = Always | Once | Never
|
||||
let prompt_str = function
|
||||
| Always -> "always" | Once -> "once" | Never -> "never"
|
||||
|
||||
let rm ~prompt ~recurse files =
|
||||
Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n"
|
||||
(prompt_str prompt) recurse (String.concat ", " files)
|
||||
|
||||
(* Command line interface *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE")
|
||||
let prompt =
|
||||
let always =
|
||||
let doc = "Prompt before every removal." in
|
||||
Always, Arg.info ["i"] ~doc
|
||||
in
|
||||
let never =
|
||||
let doc = "Ignore nonexistent files and never prompt." in
|
||||
Never, Arg.info ["f"; "force"] ~doc
|
||||
in
|
||||
let once =
|
||||
let doc = "Prompt once before removing more than three files, or when
|
||||
removing recursively. Less intrusive than $(b,-i), while
|
||||
still giving protection against most mistakes."
|
||||
in
|
||||
Once, Arg.info ["I"] ~doc
|
||||
in
|
||||
Arg.(last & vflag_all [Always] [always; never; once])
|
||||
|
||||
let recursive =
|
||||
let doc = "Remove directories and their contents recursively." in
|
||||
Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc)
|
||||
|
||||
let rm_cmd =
|
||||
let doc = "Remove files or directories" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "$(cmd) removes each specified $(i,FILE). By default it does not
|
||||
remove directories, to also remove them and their contents, use the
|
||||
option $(b,--recursive) ($(b,-r) or $(b,-R)).";
|
||||
`P "To remove a file whose name starts with a $(b,-), for example
|
||||
$(b,-foo), use one of these commands:";
|
||||
`Pre "$(cmd) $(b,-- -foo)"; `Noblank;
|
||||
`Pre "$(cmd) $(b,./-foo)";
|
||||
`P "$(cmd) removes symbolic links, not the files referenced by the
|
||||
links.";
|
||||
`S Manpage.s_bugs; `P "Report bugs to <bugs@example.org>.";
|
||||
`S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ]
|
||||
in
|
||||
Cmd.make (Cmd.info "rm" ~version:"v2.0.0+dune" ~doc ~man) @@
|
||||
let+ prompt and+ recursive and+ files in
|
||||
rm ~prompt ~recurse:recursive files
|
||||
|
||||
let main () = Cmd.eval rm_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
89
unikernel/duniverse/cmdliner/test/example_tail.ml
Normal file
89
unikernel/duniverse/cmdliner/test/example_tail.ml
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2011 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Implementation of the command, we just print the args. *)
|
||||
|
||||
type loc = bool * int
|
||||
type verb = Verbose | Quiet
|
||||
type follow = Name | Descriptor
|
||||
|
||||
let str = Printf.sprintf
|
||||
let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v)
|
||||
let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k
|
||||
let follow_str = function Name -> "name" | Descriptor -> "descriptor"
|
||||
let verb_str = function Verbose -> "verbose" | Quiet -> "quiet"
|
||||
|
||||
let tail ~lines ~follow ~verb ~pid files =
|
||||
Printf.printf
|
||||
"lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n"
|
||||
(loc_str lines) (opt_str follow_str follow) (verb_str verb)
|
||||
(opt_str string_of_int pid) (String.concat ", " files)
|
||||
|
||||
(* Command line interface *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let loc_arg =
|
||||
let parser s =
|
||||
try
|
||||
if s <> "" && s.[0] <> '+'
|
||||
then Ok (true, int_of_string s)
|
||||
else Ok (false, int_of_string (String.sub s 1 (String.length s - 1)))
|
||||
with Failure _ -> Error "unable to parse integer"
|
||||
in
|
||||
let pp ppf p = Format.fprintf ppf "%s" (loc_str p) in
|
||||
Arg.Conv.make ~docv:"N" ~parser ~pp ()
|
||||
|
||||
let lines =
|
||||
let doc = "Output the last $(docv) lines or use $(i,+)$(docv) to start \
|
||||
output after the $(i,N)-1th line."
|
||||
in
|
||||
Arg.(value & opt loc_arg (true, 10) & info ["n"; "lines"] ~docv:"N" ~doc)
|
||||
|
||||
let follow =
|
||||
let doc = "Output appended data as the file grows. $(docv) specifies how \
|
||||
the file should be tracked, by its $(b,name) or by its \
|
||||
$(b,descriptor)."
|
||||
in
|
||||
let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in
|
||||
Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None &
|
||||
info ["f"; "follow"] ~docv:"ID" ~doc)
|
||||
|
||||
let verb =
|
||||
let quiet =
|
||||
let doc = "Never output headers giving file names." in
|
||||
Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc
|
||||
in
|
||||
let verbose =
|
||||
let doc = "Always output headers giving file names." in
|
||||
Verbose, Arg.info ["v"; "verbose"] ~doc
|
||||
in
|
||||
Arg.(last & vflag_all [Quiet] [quiet; verbose])
|
||||
|
||||
let pid =
|
||||
let doc = "With -f, terminate after process $(docv) dies." in
|
||||
Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc)
|
||||
|
||||
let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE")
|
||||
|
||||
let tail_cmd =
|
||||
let doc = "Display the last part of a file" in
|
||||
let man = [
|
||||
`S Manpage.s_description;
|
||||
`P "$(cmd) prints the last lines of each $(i,FILE) to standard output. If
|
||||
no file is specified reads standard input. The number of printed
|
||||
lines can be specified with the $(b,-n) option.";
|
||||
`S Manpage.s_bugs;
|
||||
`P "Report them to <bugs@example.org>.";
|
||||
`S Manpage.s_see_also;
|
||||
`P "$(b,cat)(1), $(b,head)(1)" ]
|
||||
in
|
||||
Cmd.make (Cmd.info "tail" ~version:"v2.0.0+dune" ~doc ~man) @@
|
||||
let+ lines and+ follow and+ verb and+ pid and+ files in
|
||||
tail ~lines ~follow ~verb ~pid files
|
||||
|
||||
let main () = Cmd.eval tail_cmd
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
437
unikernel/duniverse/cmdliner/test/test_arg.ml
Normal file
437
unikernel/duniverse/cmdliner/test/test_arg.ml
Normal file
|
|
@ -0,0 +1,437 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
(* The tests have the following structure:
|
||||
|
||||
let test =
|
||||
let cmd = … (* A command definition *) in
|
||||
(* A few snapshots of valid cli parses *)
|
||||
parse …
|
||||
(* A few snapshots of invalid cli parses *)
|
||||
error …
|
||||
(* A snapshot of a plain text version of the manual *)
|
||||
Testing_cmdliner.snap_man … *)
|
||||
|
||||
(* Positional arguments *)
|
||||
|
||||
let test_pos_all =
|
||||
Test.test "Arg.pos_all" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_pos_all" ~doc:"Test pos all") @@
|
||||
let+ all = Arg.(value & pos_all string [] & info [] ~docv:"THEARG") in
|
||||
all
|
||||
in
|
||||
let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
parse [] @@ __POS_OF__ [];
|
||||
parse ["0"] @@ __POS_OF__ ["0"];
|
||||
parse ["--"; "0"] @@ __POS_OF__ ["0"];
|
||||
parse ["0";"1"] @@ __POS_OF__ ["0"; "1"];
|
||||
parse ["0";"--"; "1"] @@ __POS_OF__ ["0"; "1"];
|
||||
(**)
|
||||
error `Term ["--opt"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_all\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mTHEARG\u{001B}[m]…\n\
|
||||
test_pos_all: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--opt\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_pos_all - Test pos all
|
||||
|
||||
SYNOPSIS
|
||||
test_pos_all [OPTION]… [THEARG]…
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_pos_all exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_pos_left =
|
||||
Test.test "Arg.pos_left" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_pos_left" ~doc:"Test pos left") @@
|
||||
let+ left = Arg.(value & pos_left 2 string [] & info [] ~docv:"LEFT") in
|
||||
left
|
||||
in
|
||||
let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
parse [] @@ __POS_OF__ [];
|
||||
parse ["--"] @@ __POS_OF__ [];
|
||||
parse ["0"] @@ __POS_OF__ ["0"];
|
||||
parse ["0"; "--"; "1" ] @@ __POS_OF__ ["0"; "1"];
|
||||
parse ["0"; "1" ] @@ __POS_OF__ ["0"; "1"];
|
||||
(**)
|
||||
error `Term ["0"; "1"; "2"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_left\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mLEFT\u{001B}[m] [\u{001B}[04mLEFT\u{001B}[m]\n\
|
||||
test_pos_left: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01m2\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_pos_left - Test pos left
|
||||
|
||||
SYNOPSIS
|
||||
test_pos_left [OPTION]… [LEFT] [LEFT]
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_pos_left exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_pos_req =
|
||||
Test.test "Arg.required & Arg.pos" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_pos_req" ~doc:"Test pos req arguments") @@
|
||||
let+ r1 = Arg.(required & pos 0 (some string) None & info [] ~docv:"R1")
|
||||
and+ r2 = Arg.(required & pos 1 (some string) None & info [] ~docv:"R2")
|
||||
and+ r3 = Arg.(required & pos 2 (some string) None & info [] ~docv:"R3")
|
||||
and+ right =
|
||||
Arg.(non_empty & pos_right 2 string [] & info [] ~docv:"RIGHT")
|
||||
in
|
||||
r1, r2, r3, right
|
||||
in
|
||||
let t = Test.T.(t4 string string string (list string)) in
|
||||
let parse = Testing_cmdliner.snap_parse t cmd in
|
||||
parse ["r1"; "r2"; "r3"; "r4"] @@ __POS_OF__ ("r1", "r2", "r3", ["r4"]);
|
||||
parse ["r1"; "r2"; "r3"; "r4"; "r5"] @@ __POS_OF__
|
||||
("r1", "r2", "r3", ["r4"; "r5"]);
|
||||
(**)
|
||||
let error = Testing_cmdliner.snap_eval_error `Term cmd in
|
||||
error [] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\
|
||||
test_pos_req: required arguments \u{001B}[04mR1\u{001B}[m, \u{001B}[04mR2\u{001B}[m, \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n";
|
||||
error ["r1"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\
|
||||
test_pos_req: required arguments \u{001B}[04mR2\u{001B}[m, \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n";
|
||||
error ["r1"; "r2"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\
|
||||
test_pos_req: required arguments \u{001B}[04mR3\u{001B}[m, \u{001B}[04mRIGHT\u{001B}[m are \u{001B}[31mmissing\u{001B}[m\n";
|
||||
error ["r1"; "r2"; "r3"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_pos_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… \u{001B}[04mR1\u{001B}[m \u{001B}[04mR2\u{001B}[m \u{001B}[04mR3\u{001B}[m \u{001B}[04mRIGHT\u{001B}[m…\n\
|
||||
test_pos_req: required argument \u{001B}[04mRIGHT\u{001B}[m is \u{001B}[31mmissing\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_pos_req - Test pos req arguments
|
||||
|
||||
SYNOPSIS
|
||||
test_pos_req [OPTION]… R1 R2 R3 RIGHT…
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_pos_req exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_pos_left_right =
|
||||
Test.test "Arg.pos_{left,right}" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_pos" ~doc:"Test pos arguments") @@
|
||||
let+ l = Arg.(value & pos_left 2 string [] & info [] ~docv:"LEFT")
|
||||
and+ t = Arg.(value & pos 2 string "undefined" & info [] ~docv:"TWO")
|
||||
and+ r = Arg.(value & pos_right 2 string [] & info [] ~docv:"RIGHT") in
|
||||
(l, t, r)
|
||||
in
|
||||
let t = Test.T.(t3 (list string) string (list string)) in
|
||||
let snap = Testing_cmdliner.snap_parse t cmd in
|
||||
snap [] @@ __POS_OF__ ([], "undefined", []);
|
||||
snap ["0"] @@ __POS_OF__ (["0"], "undefined", []);
|
||||
snap ["0"; "1"] @@ __POS_OF__ (["0"; "1"], "undefined", []);
|
||||
snap ["0"; "1"; "2"] @@ __POS_OF__ (["0"; "1"], "2", []);
|
||||
snap ["0"; "1"; "2"; "3"] @@ __POS_OF__ (["0"; "1"], "2", ["3"]);
|
||||
snap ["0"; "1"; "2"; "3"; "4"] @@ __POS_OF__ (["0"; "1"], "2", ["3"; "4"]);
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_pos - Test pos arguments
|
||||
|
||||
SYNOPSIS
|
||||
test_pos [OPTION]… [LEFT] [LEFT] [TWO] [RIGHT]…
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_pos exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|}
|
||||
;
|
||||
()
|
||||
|
||||
let test_pos_left_right_rev =
|
||||
Test.test "Arg.pos_{left,right} ~rev:true" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_pos" ~doc:"Test pos arguments") @@
|
||||
let rev = true in
|
||||
let+ l = Arg.(value & pos_left 2 ~rev string [] & info [] ~docv:"LEFT")
|
||||
and+ t = Arg.(value & pos 2 ~rev string "undefined" & info [] ~docv:"TWO")
|
||||
and+ r = Arg.(value & pos_right 2 ~rev string [] & info [] ~docv:"RIGHT") in
|
||||
(l, t, r)
|
||||
in
|
||||
let t = Test.T.(t3 (list string) string (list string)) in
|
||||
let snap = Testing_cmdliner.snap_parse t cmd in
|
||||
snap [] @@ __POS_OF__ ([], "undefined", []);
|
||||
snap ["0"] @@ __POS_OF__ ([], "undefined", ["0"]);
|
||||
snap ["0"; "1"] @@ __POS_OF__ ([], "undefined", ["0"; "1"]);
|
||||
snap ["0"; "1"; "2"] @@ __POS_OF__ ([], "0", ["1"; "2"]);
|
||||
snap ["0"; "1"; "2"; "3"] @@ __POS_OF__ (["0"], "1", ["2"; "3"]);
|
||||
snap ["0"; "1"; "2"; "3"; "4"] @@ __POS_OF__ (["0"; "1"], "2", ["3"; "4"]);
|
||||
snap ["0"; "1"; "2"; "3"; "4"; "5"] @@ __POS_OF__
|
||||
(["0"; "1"; "2"], "3", ["4"; "5"]);
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_pos - Test pos arguments
|
||||
|
||||
SYNOPSIS
|
||||
test_pos [OPTION]… [LEFT]… [TWO] [RIGHT] [RIGHT]
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_pos exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
(* Optional arguments *)
|
||||
|
||||
let test_opt_required =
|
||||
Test.test "Arg.required & Arg.opt" @@ fun () ->
|
||||
let cmd =
|
||||
let doc = "Test optional required arguments (don't do this)" in
|
||||
Cmd.make (Cmd.info "test_opt_req" ~doc) @@
|
||||
let+ req =
|
||||
Arg.(required & opt (some string) None & info ["r"; "req"] ~docv:"ARG")
|
||||
in
|
||||
req
|
||||
in
|
||||
let snap = Testing_cmdliner.snap_parse Test.T.string cmd in
|
||||
snap ["-ra"] @@ __POS_OF__ "a";
|
||||
snap ["--req"; "a"] @@ __POS_OF__ "a";
|
||||
(**)
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
error `Parse [] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\
|
||||
test_opt_req: required option \u{001B}[01m--req\u{001B}[m is \u{001B}[31mmissing\u{001B}[m\n";
|
||||
error `Term ["a"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\
|
||||
test_opt_req: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01ma\u{001B}[m\n";
|
||||
error `Term ["-ra"; "a"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\
|
||||
test_opt_req: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01ma\u{001B}[m\n";
|
||||
error `Parse ["-r"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_opt_req\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[01m--req\u{001B}[m=\u{001B}[04mARG\u{001B}[m [\u{001B}[04mOPTION\u{001B}[m]…\n\
|
||||
test_opt_req: option \u{001B}[01m-r\u{001B}[m \u{001B}[31mneeds an argument\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_opt_req - Test optional required arguments (don't do this)
|
||||
|
||||
SYNOPSIS
|
||||
test_opt_req --req=ARG [OPTION]…
|
||||
|
||||
OPTIONS
|
||||
-r ARG, --req=ARG (required)
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_opt_req exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_arg_info_docv =
|
||||
Test.test "Arg.info default's docv on strings" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_arg_docv" ~doc:"Test pos all") @@
|
||||
let+ all = Arg.(value & pos_all string [] & info [])
|
||||
and+ opt = Arg.(value & opt string "bla" & info ["field"]) in
|
||||
all, opt
|
||||
in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
(**)
|
||||
error `Term ["-z"; "a"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_arg_docv\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--field\u{001B}[m=\u{001B}[04mVAL\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mARG\u{001B}[m]…\n\
|
||||
test_arg_docv: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_arg_docv - Test pos all
|
||||
|
||||
SYNOPSIS
|
||||
test_arg_docv [--field=VAL] [OPTION]… [ARG]…
|
||||
|
||||
OPTIONS
|
||||
--field=VAL (absent=bla)
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_arg_docv exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_conv_docv =
|
||||
Test.test "Arg.Conv.docv" @@ fun () ->
|
||||
let cmd =
|
||||
let field = Arg.Conv.of_conv Arg.string ~docv:"FIELD" in
|
||||
Cmd.make (Cmd.info "test_conv_docv" ~doc:"Test conv docv") @@
|
||||
let+ all = Arg.(value & pos_all field [] & info [])
|
||||
and+ opt = Arg.(value & opt field "bla" & info ["field"]) in
|
||||
all, opt
|
||||
in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
(**)
|
||||
error `Term ["-z"; "a"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_conv_docv\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--field\u{001B}[m=\u{001B}[04mFIELD\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mFIELD\u{001B}[m]…\n\
|
||||
test_conv_docv: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_conv_docv - Test conv docv
|
||||
|
||||
SYNOPSIS
|
||||
test_conv_docv [--field=FIELD] [OPTION]… [FIELD]…
|
||||
|
||||
OPTIONS
|
||||
--field=FIELD (absent=bla)
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_conv_docv exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_arg_file =
|
||||
Test.test "Arg.file" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_arg_file" ~doc:"Test conv docv") @@
|
||||
let+ all = Arg.(value & pos_all file [] & info []) in
|
||||
all
|
||||
in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
let parse = Testing_cmdliner.snap_parse Test.T.(list string) cmd in
|
||||
parse ["-"] @@ __POS_OF__ ["-"];
|
||||
(**)
|
||||
error `Term ["-z"; "a"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_arg_file\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mPATH\u{001B}[m]…\n\
|
||||
test_arg_file: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m-z\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_arg_file - Test conv docv
|
||||
|
||||
SYNOPSIS
|
||||
test_arg_file [OPTION]… [PATH]…
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_arg_file exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let main () =
|
||||
let doc = "Test argument specifications" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
358
unikernel/duniverse/cmdliner/test/test_cmd.ml
Normal file
358
unikernel/duniverse/cmdliner/test/test_cmd.ml
Normal file
|
|
@ -0,0 +1,358 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
(* The tests have the following structure:
|
||||
|
||||
let test =
|
||||
let cmd = … (* A command definition *) in
|
||||
(* A few snapshots of valid cli parses *)
|
||||
parse …
|
||||
(* A few snapshots of invalid cli parses *)
|
||||
error …
|
||||
(* A snapshot of a plain text version of the manual *)
|
||||
Testing_cmdliner.snap_man … *)
|
||||
|
||||
let test_groups =
|
||||
Test.test "Cmd.group" @@ fun () ->
|
||||
let cmd = Testing_cmdliner.sample_group_cmd in
|
||||
let parse = Testing_cmdliner.snap_parse Test.T.unit cmd in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
let warning = Testing_cmdliner.snap_parse_warnings cmd in
|
||||
parse ["birds"] @@ __POS_OF__ ();
|
||||
parse ["birds"] @@ __POS_OF__ ();
|
||||
parse ["birds"; "fly"] @@ __POS_OF__ ();
|
||||
parse ["birds"; "land"] @@ __POS_OF__ ();
|
||||
parse ["mammals"] @@ __POS_OF__ ();
|
||||
(**)
|
||||
warning ["camels"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n";
|
||||
(**)
|
||||
error `Term [] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
|
||||
test_group: required \u{001B}[04mCOMMAND\u{001B}[m name is \u{001B}[31mmissing\u{001B}[m, must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m,\n\
|
||||
\ \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m or \u{001B}[01mmammals\u{001B}[m\n";
|
||||
error `Term ["bla"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbla\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\
|
||||
\ or \u{001B}[01mmammals\u{001B}[m\n";
|
||||
error `Parse ["birds"; "-k"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\
|
||||
test_group: option \u{001B}[01m-k\u{001B}[m \u{001B}[31mneeds an argument\u{001B}[m\n";
|
||||
error `Term ["mammals"; "land"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group mammals\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]…\n\
|
||||
test_group: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01mland\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_group
|
||||
|
||||
SYNOPSIS
|
||||
test_group COMMAND …
|
||||
|
||||
Invoke command with test_group, the command name is test_group, the
|
||||
parent is test_group and the tool name is test_group.
|
||||
|
||||
COMMANDS
|
||||
birds [COMMAND] …
|
||||
Operate on birds.
|
||||
|
||||
fishs [OPTION]… [NAME]
|
||||
Operate on fishs.
|
||||
|
||||
lookup [--kind=ENUM] [OPTION]… NAME
|
||||
Lookup animal by name.
|
||||
|
||||
mammals [OPTION]…
|
||||
Operate on mammals.
|
||||
|
||||
(Deprecated) camels [--bactrian] [OPTION]… [HERD]
|
||||
Use mammals instead. Operate on camels.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
Testing_cmdliner.snap_man ~args:["birds"; "--help=plain"] cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_group-birds - Operate on birds.
|
||||
|
||||
SYNOPSIS
|
||||
test_group birds [COMMAND] …
|
||||
|
||||
Invoke command with test_group birds, the command name is birds, the
|
||||
parent is test_group and the tool name is test_group.
|
||||
|
||||
COMMANDS
|
||||
fly [--speed=SPEED] [OPTION]… [BIRD]
|
||||
Fly birds.
|
||||
|
||||
land [OPTION]… [BIRD]
|
||||
Land birds.
|
||||
|
||||
OPTIONS
|
||||
--can-fly=BOOL (absent=false)
|
||||
BOOL indicates if the entity can fly.
|
||||
|
||||
-k VAL, --kind=VAL
|
||||
Kind of entity
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group birds exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
SEE ALSO|};
|
||||
();
|
||||
Testing_cmdliner.snap_man ~args:["birds"; "fly"; "--help=plain"] cmd @@
|
||||
__POS_OF__
|
||||
{|NAME
|
||||
test_group-birds-fly - Fly birds.
|
||||
|
||||
SYNOPSIS
|
||||
test_group birds fly [--speed=SPEED] [OPTION]… [BIRD]
|
||||
|
||||
Invoke command with test_group birds fly, the command name is fly, the
|
||||
parent is test_group birds and the tool name is test_group.
|
||||
|
||||
ARGUMENTS
|
||||
BIRD (absent=pigeon)
|
||||
Use BIRD specie.
|
||||
|
||||
OPTIONS
|
||||
--speed=SPEED (absent=2)
|
||||
Movement SPEED in m/s
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group birds fly exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
SEE ALSO|};
|
||||
Testing_cmdliner.snap_man ~args:["birds"; "land"; "--help=plain"] cmd @@
|
||||
__POS_OF__
|
||||
{|NAME
|
||||
test_group-birds-land - Land birds.
|
||||
|
||||
SYNOPSIS
|
||||
test_group birds land [OPTION]… [BIRD]
|
||||
|
||||
Invoke command with test_group birds land, the command name is land,
|
||||
the parent is test_group birds and the tool name is test_group.
|
||||
|
||||
ARGUMENTS
|
||||
BIRD (absent=pigeon)
|
||||
Use BIRD specie.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group birds land exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
SEE ALSO|};
|
||||
();
|
||||
Testing_cmdliner.snap_man ~args:["fishs"; "--help=plain"] cmd @@
|
||||
__POS_OF__
|
||||
{|NAME
|
||||
test_group-fishs - Operate on fishs.
|
||||
|
||||
SYNOPSIS
|
||||
test_group fishs [OPTION]… [NAME]
|
||||
|
||||
Invoke command with test_group fishs, the command name is fishs, the
|
||||
parent is test_group and the tool name is test_group.
|
||||
|
||||
ARGUMENTS
|
||||
NAME
|
||||
Use fish named NAME.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group fishs exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
SEE ALSO|};
|
||||
Testing_cmdliner.snap_man ~args:["mammals"; "--help=plain"] cmd @@
|
||||
__POS_OF__
|
||||
{|NAME
|
||||
test_group-mammals - Operate on mammals.
|
||||
|
||||
SYNOPSIS
|
||||
test_group mammals [OPTION]…
|
||||
|
||||
Invoke command with test_group mammals, the command name is mammals,
|
||||
the parent is test_group and the tool name is test_group.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group mammals exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
SEE ALSO|};
|
||||
Testing_cmdliner.snap_man ~args:["camels"; "--help=plain"] cmd @@
|
||||
__POS_OF__
|
||||
{|NAME
|
||||
(Deprecated) test_group-camels - Use mammals instead. Operate on
|
||||
camels.
|
||||
|
||||
SYNOPSIS
|
||||
(Deprecated) test_group camels [--bactrian] [OPTION]… [HERD]
|
||||
|
||||
Invoke command with test_group camels, the command name is camels, the
|
||||
parent is test_group and the tool name is test_group.
|
||||
|
||||
ARGUMENTS
|
||||
(Deprecated) HERD
|
||||
Herds HERD are ignored. Find in herd HERD.
|
||||
|
||||
OPTIONS
|
||||
(Deprecated) -b, --bactrian (absent BACTRIAN env)
|
||||
Use nothing instead of BACTRIAN, HA!. Specify a bactrian camel.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
test_group camels exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
ENVIRONMENT
|
||||
These environment variables affect the execution of test_group camels:
|
||||
|
||||
(Deprecated) BACTRIAN
|
||||
Use nothing instead of BACTRIAN, HA!. See option --bactrian.
|
||||
|
||||
SEE ALSO|};
|
||||
()
|
||||
|
||||
let test_std_opts =
|
||||
Test.test "Standard options" @@ fun () ->
|
||||
let cmd = Testing_cmdliner.sample_group_cmd in
|
||||
let snap_version = Testing_cmdliner.snap_help (Ok `Version) cmd in
|
||||
let ret ?__POS__ =
|
||||
let env = Testing_cmdliner.env_dumb_term in
|
||||
Testing_cmdliner.test_eval_result ?__POS__ ~env Test.T.unit cmd
|
||||
in
|
||||
snap_version ["--version"] @@ __POS_OF__ "X.Y.Z\n";
|
||||
snap_version ["--version"; "birds"] @@ __POS_OF__ "X.Y.Z\n";
|
||||
snap_version ["fishs"; "--version"; "birds"] @@ __POS_OF__ "X.Y.Z\n";
|
||||
ret ["--help"; "--version"] (Ok `Help) ~__POS__;
|
||||
ret ["--help"; "--version"] (Ok `Help) ~__POS__;
|
||||
ret ["fishs"; "--version"; "birds"; "--help"] (Ok `Help) ~__POS__;
|
||||
ret ["--help"; "crow"] (Ok `Help) ~__POS__;
|
||||
ret ["birds"; "--help"; "crow"] (Ok `Help) ~__POS__;
|
||||
ret ["fishs"; "--"; "--help"] (Ok (`Ok ())) ~__POS__;
|
||||
()
|
||||
|
||||
let main () =
|
||||
let doc = "Test command specifications" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
635
unikernel/duniverse/cmdliner/test/test_completion.ml
Normal file
635
unikernel/duniverse/cmdliner/test/test_completion.ml
Normal file
|
|
@ -0,0 +1,635 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
(* The tests have the following structure:
|
||||
|
||||
let test =
|
||||
let cmd = … (* A command definition *) in
|
||||
(* A few snapshots of completion protocol results *)
|
||||
complete … *)
|
||||
|
||||
let cmd = Testing_cmdliner.sample_group_cmd
|
||||
let complete = Testing_cmdliner.snap_completion cmd
|
||||
|
||||
let test_groups =
|
||||
Test.test "Cmd.group completions" @@ fun () ->
|
||||
complete ["--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n\
|
||||
group\n\
|
||||
Subcommands\n\
|
||||
item\n\
|
||||
birds\n\
|
||||
Operate on birds.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
mammals\n\
|
||||
Operate on mammals.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
fishs\n\
|
||||
Operate on fishs.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
camels\n\
|
||||
Operate on camels.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
lookup\n\
|
||||
Lookup animal by name.\n\
|
||||
item-end\n";
|
||||
complete ["birds"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
-k\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--can-fly\n\
|
||||
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n\
|
||||
group\n\
|
||||
Subcommands\n\
|
||||
item\n\
|
||||
fly\n\
|
||||
Fly birds.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
land\n\
|
||||
Land birds.\n\
|
||||
item-end\n";
|
||||
()
|
||||
|
||||
let test_no_options_after_dashsash =
|
||||
Test.test "no options after --" @@ fun () ->
|
||||
complete ["birds"; "fly"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--speed\n\
|
||||
Movement \u{001B}[04mSPEED\u{001B}[m in m/s\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
complete ["birds"; "fly"; "--"; "--__complete="] @@ __POS_OF__
|
||||
"1\n";
|
||||
()
|
||||
|
||||
let test_opts_starts =
|
||||
Test.test "complete optional argument names" @@ fun () ->
|
||||
complete ["birds"; "--__complete=-"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
-k\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--can-fly\n\
|
||||
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n\
|
||||
group\n\
|
||||
Subcommands\n";
|
||||
complete ["birds"; "--__complete=--"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--can-fly\n\
|
||||
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
()
|
||||
|
||||
let test_opt_value =
|
||||
Test.test "complete optional argument values" @@ fun () ->
|
||||
(* Glued *)
|
||||
complete ["birds"; "--__complete=--can-fly="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
false\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
(* next token *)
|
||||
complete ["birds"; "--can-fly"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
false\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["birds"; "--can-fly=true"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
-k\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--can-fly\n\
|
||||
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
complete ["birds"; "--can-fly"; "true"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
-k\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
Kind of entity\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--can-fly\n\
|
||||
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
()
|
||||
|
||||
let test_context_sensitive =
|
||||
Test.test "context sensitive completions" @@ fun () ->
|
||||
complete ["lookup"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
sparrow\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
parrot\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
pigeon\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
salmon\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
trout\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
piranha\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
-k\n\
|
||||
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--kind\n\
|
||||
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--version\n\
|
||||
Show version information.\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
complete ["lookup"; "-kfish"; "--__complete=s"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
salmon\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["lookup"; "-kbird"; "--__complete=p"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
parrot\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
pigeon\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
()
|
||||
|
||||
let test_restart_restricted_tool =
|
||||
Test.test "restart restricted tool" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_restart_restricted") @@
|
||||
let+ verb = Arg.(value & flag & info ["verbose"])
|
||||
and+ tool =
|
||||
let tool = Arg.enum ~docv:"VCS" ["git", `Git; "hg", `Hg] in
|
||||
Arg.(required & pos 0 (some tool) None & info [])
|
||||
and+ args =
|
||||
let arg =
|
||||
let completion = Arg.Completion.complete_restart in
|
||||
Arg.Conv.of_conv Arg.string ~docv:"ARG" ~completion
|
||||
in
|
||||
Arg.(value & pos_right 0 arg [] & info [])
|
||||
in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
git\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
hg\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--verbose\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
complete ["--__complete=g"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
git\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
(* Note no reset here: as there is no -- token *)
|
||||
complete ["git"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--verbose\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
complete ["--"; "git"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
restart\n";
|
||||
()
|
||||
|
||||
let test_restart_any_tool =
|
||||
Test.test "restart any tool" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_restart") @@
|
||||
let arg ~docv =
|
||||
let completion = Arg.Completion.complete_restart in
|
||||
Arg.Conv.of_conv Arg.string ~docv:"TOOL" ~completion
|
||||
in
|
||||
let+ verb = Arg.(value & flag & info ["verbose"])
|
||||
and+ tool = Arg.(required & pos 0 (some (arg ~docv:"TOOL")) None & info [])
|
||||
and+ args = Arg.(value & pos_right 0 (arg ~docv:"ARG") [] & info []) in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--verbose\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
(* The following two do not restart because -- is missing *)
|
||||
complete ["--__complete=gi"] @@ __POS_OF__
|
||||
"1\n";
|
||||
complete ["git"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Options\n\
|
||||
item\n\
|
||||
--verbose\n\
|
||||
\n\
|
||||
item-end\n\
|
||||
item\n\
|
||||
--help\n\
|
||||
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
|
||||
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
|
||||
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
|
||||
item-end\n";
|
||||
(* These must restart *)
|
||||
complete ["--"; "--__complete=gi"] @@ __POS_OF__
|
||||
"1\n\
|
||||
restart\n";
|
||||
complete ["--"; "git"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
restart\n";
|
||||
()
|
||||
|
||||
let test_context =
|
||||
Test.test "Context sensitive completion from optional argument" @@ fun () ->
|
||||
let ctx =
|
||||
Arg.(value & opt (some bool) None & info ["ctx"])
|
||||
in
|
||||
let dep =
|
||||
let complete ctx ~token:_ = match ctx with
|
||||
| None -> Ok [Arg.Completion.string "ctx-parse-error"]
|
||||
| Some None -> Ok [Arg.Completion.string "no-context"]
|
||||
| Some (Some ctx) -> Ok [Arg.Completion.string (Bool.to_string ctx)]
|
||||
in
|
||||
let completion = Arg.Completion.make ~context:ctx complete in
|
||||
Arg.Conv.of_conv Arg.string ~docv:"SPECIAL" ~completion
|
||||
in
|
||||
let () = (* test [dep] converter on an option *)
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_context") @@
|
||||
let+ lookup = Arg.(value & opt dep "nothing" & info ["dep"])
|
||||
and+ ctx in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
no-context\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--ctx=hey"; "--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
ctx-parse-error\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--ctx=true"; "--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--dep"; "--__complete="; "--ctx=true"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
in
|
||||
let () =
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_context") @@
|
||||
let+ lookup = Arg.(value & pos 0 dep "nothing" & info [])
|
||||
and+ ctx in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["--__complete=a"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
no-context\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--ctx=hey"; "--__complete=a"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
ctx-parse-error\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--ctx=true"; "--__complete=a"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--__complete=a"; "--ctx=true"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
in
|
||||
()
|
||||
|
||||
let test_context =
|
||||
Test.test "Context sensitive completion from positional argument" @@ fun () ->
|
||||
let ctx0 = Arg.(value & pos 0 (some bool) None & info []) in
|
||||
let dep =
|
||||
let complete ctx ~token:_ = match ctx with
|
||||
| None -> Ok [Arg.Completion.string "ctx-parse-error"]
|
||||
| Some None -> Ok [Arg.Completion.string "no-context"]
|
||||
| Some (Some ctx) -> Ok [Arg.Completion.string (Bool.to_string ctx)]
|
||||
in
|
||||
let completion = Arg.Completion.make ~context:ctx0 complete in
|
||||
Arg.Conv.of_conv Arg.string ~docv:"SPECIAL" ~completion
|
||||
in
|
||||
let () = (* test [dep] converter on an option *)
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_context") @@
|
||||
let+ lookup = Arg.(value & opt dep "nothing" & info ["dep"])
|
||||
and+ ctx0 in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
no-context\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["bla"; "--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
ctx-parse-error\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["true"; "--dep"; "--__complete="] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["--dep"; "--__complete="; "true"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
in
|
||||
let () =
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_context") @@
|
||||
let+ lookup = Arg.(value & pos 1 dep "nothing" & info [])
|
||||
and+ ctx0 in
|
||||
()
|
||||
in
|
||||
let complete = Testing_cmdliner.snap_completion cmd in
|
||||
complete ["hey"; "--__complete=a"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
ctx-parse-error\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
complete ["true"; "--__complete=a"] @@ __POS_OF__
|
||||
"1\n\
|
||||
group\n\
|
||||
Values\n\
|
||||
item\n\
|
||||
true\n\
|
||||
\n\
|
||||
item-end\n";
|
||||
in
|
||||
()
|
||||
|
||||
let main () =
|
||||
let doc = "Test completion" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
63
unikernel/duniverse/cmdliner/test/test_deprecation.ml
Normal file
63
unikernel/duniverse/cmdliner/test/test_deprecation.ml
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let cmd = Testing_cmdliner.sample_group_cmd
|
||||
let warning ?env = Testing_cmdliner.snap_parse_warnings ?env cmd
|
||||
let test_env = function "BACTRIAN" -> Some "true" | var -> Sys.getenv_opt var
|
||||
|
||||
let deprecated_command =
|
||||
Test.test "Deprecated command" @@ fun () ->
|
||||
warning ["camels"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n";
|
||||
()
|
||||
|
||||
let deprecated_arg =
|
||||
Test.test "Deprecated option argument" @@ fun () ->
|
||||
warning ["camels"; "-b"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m-b\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n";
|
||||
warning ["camels"; "--bactrian"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m--bactrian\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m,\n\
|
||||
\ \u{001B}[01mHA!\u{001B}[m.\n";
|
||||
()
|
||||
|
||||
let deprecated_pos =
|
||||
Test.test "Deprecated positional argument" @@ fun () ->
|
||||
warning ["camels"; "bla"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m argument \u{001B}[01mbla\u{001B}[m: Herds \u{001B}[04mHERD\u{001B}[m are ignored.\n";
|
||||
()
|
||||
|
||||
let deprecated_env =
|
||||
Test.test "Deprecated env variable" @@ fun () ->
|
||||
warning ~env:test_env ["camels"] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m environment variable \u{001B}[01mBACTRIAN\u{001B}[m: Use nothing instead of\n\
|
||||
\ \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n";
|
||||
warning ~env:test_env ["camels"; "-b"] (* takes over env *) @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m option \u{001B}[01m-b\u{001B}[m: Use nothing instead of \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n";
|
||||
()
|
||||
|
||||
let deprecated_combined =
|
||||
Test.test "Deprecation combined" @@ fun () ->
|
||||
warning ~env:test_env ["camels"; "bla"; ] @@ __POS_OF__
|
||||
"test_group: \u{001B}[33mdeprecated\u{001B}[m command \u{001B}[01mcamels\u{001B}[m: Use \u{001B}[01mmammals\u{001B}[m instead.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m argument \u{001B}[01mbla\u{001B}[m: Herds \u{001B}[04mHERD\u{001B}[m are ignored.\n\
|
||||
\ \u{001B}[33mdeprecated\u{001B}[m environment variable \u{001B}[01mBACTRIAN\u{001B}[m: Use nothing instead of\n\
|
||||
\ \u{001B}[01mBACTRIAN\u{001B}[m, \u{001B}[01mHA!\u{001B}[m.\n";
|
||||
()
|
||||
|
||||
let main () =
|
||||
let doc = "Test deprecation messages" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
68
unikernel/duniverse/cmdliner/test/test_legacy_prefix.ml
Normal file
68
unikernel/duniverse/cmdliner/test/test_legacy_prefix.ml
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let env ~legacy_prefixes:b =
|
||||
let b = string_of_bool b in
|
||||
function
|
||||
| "CMDLINER_LEGACY_PREFIXES" -> Some b
|
||||
| var -> Sys.getenv_opt var
|
||||
|
||||
let legacy = env ~legacy_prefixes:true
|
||||
let nolegacy = env ~legacy_prefixes:false
|
||||
|
||||
let cmd = Testing_cmdliner.sample_group_cmd
|
||||
let parse_legacy = Testing_cmdliner.snap_parse ~env:legacy Test.T.unit cmd
|
||||
let error_nolegacy err = Testing_cmdliner.snap_eval_error ~env:nolegacy err cmd
|
||||
|
||||
(* Note, we don't test Arg.conv since we cannot control it through eval's
|
||||
env variable. *)
|
||||
|
||||
(* The tests have the following structure:
|
||||
|
||||
let test =
|
||||
(* A few snapshots of valid cli parses *)
|
||||
parse …
|
||||
(* A few snapshots of invalid cli parses *)
|
||||
error … *)
|
||||
|
||||
let test_cmd =
|
||||
Test.test "command names" @@ fun () ->
|
||||
parse_legacy ["bir"] @@ __POS_OF__ ();
|
||||
parse_legacy ["bir"; "fly"] @@ __POS_OF__ ();
|
||||
parse_legacy ["mamma"] @@ __POS_OF__ ();
|
||||
(**)
|
||||
error_nolegacy `Term ["bir"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbir\u{001B}[m. Did you mean \u{001B}[01mbirds\u{001B}[m?\n";
|
||||
error_nolegacy `Term ["birds"; "fl"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mfl\u{001B}[m. Did you mean \u{001B}[01mfly\u{001B}[m?\n";
|
||||
error_nolegacy `Term ["mam"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mmam\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\
|
||||
\ or \u{001B}[01mmammals\u{001B}[m\n";
|
||||
()
|
||||
|
||||
let test_cmd =
|
||||
Test.test "option names" @@ fun () ->
|
||||
parse_legacy ["birds"; "fly"; "--sp"; "3"] @@ __POS_OF__ ();
|
||||
(**)
|
||||
error_nolegacy `Term ["birds"; "fly"; "--sp"; ] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group birds fly\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--speed\u{001B}[m=\u{001B}[04mSPEED\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mBIRD\u{001B}[m]\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--sp\u{001B}[m\n";
|
||||
error_nolegacy `Term ["birds"; "fly"; "--spe"; ] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_group birds fly\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--speed\u{001B}[m=\u{001B}[04mSPEED\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mBIRD\u{001B}[m]\n\
|
||||
test_group: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--spe\u{001B}[m. Did you mean \u{001B}[01m--speed\u{001B}[m?\n";
|
||||
()
|
||||
|
||||
let main () =
|
||||
let doc = "Test CMDLINER_LEGACY_PREFIXES behaviour" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
406
unikernel/duniverse/cmdliner/test/test_man.ml
Normal file
406
unikernel/duniverse/cmdliner/test/test_man.ml
Normal file
|
|
@ -0,0 +1,406 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let hey =
|
||||
let doc = "Equivalent to set $(opt)." in
|
||||
let env = Cmd.Env.info "TEST_ENV" ~doc in
|
||||
let doc = "Set hey." in
|
||||
Arg.(value & flag & info ["hey"; "y"] ~env ~doc)
|
||||
|
||||
let repodir =
|
||||
let doc = "See option $(opt)." in
|
||||
let env = Cmd.Env.info "TEST_REPODDIR" ~doc in
|
||||
let doc = "Run the program in repository directory $(docv)." in
|
||||
Arg.(value & opt file Filename.current_dir_name & info ["repodir"] ~env
|
||||
~docv:"DIR" ~doc)
|
||||
|
||||
let id =
|
||||
let doc = "See option $(opt)." in
|
||||
let env = Cmd.Env.info "TEST_ID" ~doc in
|
||||
let doc = "Whatever $(docv) bla $(env) and $(opt)." in
|
||||
Arg.(value & opt int ~vopt:10 0 & info ["id"; "i"] ~env ~docv:"ID)" ~doc)
|
||||
|
||||
let miaouw =
|
||||
let doc = "See option $(opt). These are term names $(tool) $(cmd.name)" in
|
||||
let docs = "MIAOUW SECTION (non-standard unpositioned do not do this)" in
|
||||
let env = Cmd.Env.info "TEST_MIAOUW" ~doc ~docs in
|
||||
let doc = "Whatever this is the doc var $(docv) this is the env var $(env) \
|
||||
this is the opt $(opt) and this is $(i,italic) and this is
|
||||
$(b,bold) and this $(b,\\$(opt\\)) is \\$(opt) in bold and this
|
||||
\\$ is a dollar. $(tool) is the main command name, $(cmd.name) \
|
||||
is the subcommand name and $(cmd) the command invocation."
|
||||
in
|
||||
Arg.(value & opt string "miaouw" & info ["m";] ~env ~docv:"MIAOUW" ~doc)
|
||||
|
||||
let test hey repodir id miaouw =
|
||||
Format.printf "hey: %B@.repodir: %s@.id: %d@.miaouw: %s@."
|
||||
hey repodir id miaouw
|
||||
|
||||
let man_test_t = Term.(const test $ hey $ repodir $ id $ miaouw)
|
||||
|
||||
let info =
|
||||
let doc = "UTF-8 test: \u{1F42B} íöüóőúűéáăîâșț ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝" in
|
||||
let envs = [ Cmd.Env.info "TEST_IT" ~doc:"This is $(env) for $(cmd.name)" ] in
|
||||
let exits = (Cmd.Exit.info ~doc:"This is a $(status) for $(cmd.name)" 1 ::
|
||||
Cmd.Exit.info ~doc:"Ranges from $(status) to $(status_max)"
|
||||
~max:10 2 ::
|
||||
Cmd.Exit.defaults)
|
||||
in
|
||||
let man = [
|
||||
`S "THIS IS A SECTION FOR $(tool)";
|
||||
`P "$(cmd.name) subst at begin and end $(tool)";
|
||||
`P "$(i,italic) and $(b,bold)";
|
||||
`P "\\$ escaped \\$\\$ escaped \\$";
|
||||
`P "This does not fail \\$(a)";
|
||||
`P ". this is a paragraph starting with a dot.";
|
||||
`P "' this is a paragraph starting with a quote.";
|
||||
`P "This: \\\\(rs is a backslash for groff and you should not see a \\\\";
|
||||
`P "This: \\\\N'46' is a quote for groff and you should not see a '";
|
||||
`P "This: \\\\\" is a groff comment and it should not be one.";
|
||||
`P "This is a non preformatted paragraph, filling will occur. This will
|
||||
be properly layout on 80 columns.";
|
||||
`Pre "This is a preformatted paragraph for $(tool) no filling will \
|
||||
occur do the $(i,ASCII) art $(b,here) this will overflow on 80 \
|
||||
columns \n\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\
|
||||
01234556789\n\n\
|
||||
... Should not break\n\
|
||||
a... Should not break\n\
|
||||
+---+\n\
|
||||
| /|\n\
|
||||
| / | ----> Let's swim to the moon.\n\
|
||||
|/ |\n\
|
||||
+---+";
|
||||
`P "These are escapes escaped \\$ \\( \\) \\\\";
|
||||
`P "() does not need to be escaped outside directives.";
|
||||
`Blocks [
|
||||
`P "The following to paragraphs are spliced in.";
|
||||
`P "This dollar needs escape \\$(var) this one as well $(b,\\$(bla\\))";
|
||||
`P "This is another paragraph \\$(bla) $(i,\\$(bla\\)) $(b,\\$\\(bla\\))";
|
||||
];
|
||||
`Noblank;
|
||||
`Pre "This is another preformatted paragraph.\n\
|
||||
There should be no blanks before and after it.";
|
||||
`Noblank;
|
||||
`P "Hey ho";
|
||||
`I ("label", "item label");
|
||||
`I ("lebal", "item lebal");
|
||||
`P "The last paragraph";
|
||||
`S Manpage.s_bugs;
|
||||
`P "Email bug reports to <hehey at example.org>.";]
|
||||
in
|
||||
let man_xrefs = [`Page ("ascii", 7); `Main; `Tool "grep";] in
|
||||
Cmd.info "man_test" ~version:"v2.0.0+dune" ~doc ~envs ~exits ~man ~man_xrefs
|
||||
|
||||
let cmd = Cmd.make info man_test_t
|
||||
|
||||
let test_plain =
|
||||
Test.test "plain text manpage" @@ fun () ->
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
man_test - UTF-8 test: 🐫 íöüóőúűéáăîâșț
|
||||
ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝
|
||||
|
||||
SYNOPSIS
|
||||
man_test [OPTION]…
|
||||
|
||||
THIS IS A SECTION FOR man_test
|
||||
man_test subst at begin and end man_test
|
||||
|
||||
italic and bold
|
||||
|
||||
$ escaped $$ escaped $
|
||||
|
||||
This does not fail $(a)
|
||||
|
||||
. this is a paragraph starting with a dot.
|
||||
|
||||
' this is a paragraph starting with a quote.
|
||||
|
||||
This: \(rs is a backslash for groff and you should not see a \
|
||||
|
||||
This: \N'46' is a quote for groff and you should not see a '
|
||||
|
||||
This: \" is a groff comment and it should not be one.
|
||||
|
||||
This is a non preformatted paragraph, filling will occur. This will be
|
||||
properly layout on 80 columns.
|
||||
|
||||
This is a preformatted paragraph for man_test no filling will occur do the ASCII art here this will overflow on 80 columns
|
||||
0123455678901234556789012345567890123455678901234556789012345567890123455678901234556789
|
||||
|
||||
... Should not break
|
||||
a... Should not break
|
||||
+---+
|
||||
| /|
|
||||
| / | ----> Let's swim to the moon.
|
||||
|/ |
|
||||
+---+
|
||||
|
||||
These are escapes escaped $ ( ) \
|
||||
|
||||
() does not need to be escaped outside directives.
|
||||
|
||||
The following to paragraphs are spliced in.
|
||||
|
||||
This dollar needs escape $(var) this one as well $(bla)
|
||||
|
||||
This is another paragraph $(bla) $(bla) $(bla)
|
||||
This is another preformatted paragraph.
|
||||
There should be no blanks before and after it.
|
||||
Hey ho
|
||||
|
||||
label
|
||||
item label
|
||||
|
||||
lebal
|
||||
item lebal
|
||||
|
||||
The last paragraph
|
||||
|
||||
MIAOUW SECTION (non-standard unpositioned do not do this)
|
||||
TEST_MIAOUW
|
||||
See option -m. These are term names man_test man_test
|
||||
|
||||
OPTIONS
|
||||
-i [ID)], --id[=ID)] (default=10) (absent=0 or TEST_ID env)
|
||||
Whatever ID) bla TEST_ID and --id.
|
||||
|
||||
-m MIAOUW (absent=miaouw or TEST_MIAOUW env)
|
||||
Whatever this is the doc var MIAOUW this is the env var
|
||||
TEST_MIAOUW this is the opt -m and this is italic and this is bold
|
||||
and this $(opt) is $(opt) in bold and this $ is a dollar. man_test
|
||||
is the main command name, man_test is the subcommand name and
|
||||
man_test the command invocation.
|
||||
|
||||
--repodir=DIR (absent=. or TEST_REPODDIR env)
|
||||
Run the program in repository directory DIR.
|
||||
|
||||
-y, --hey (absent TEST_ENV env)
|
||||
Set hey.
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
--version
|
||||
Show version information.
|
||||
|
||||
EXIT STATUS
|
||||
man_test exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
1 This is a 1 for man_test
|
||||
|
||||
2-10
|
||||
Ranges from 2 to 10
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|
||||
125 on unexpected internal errors (bugs).
|
||||
|
||||
ENVIRONMENT
|
||||
These environment variables affect the execution of man_test:
|
||||
|
||||
TEST_ENV
|
||||
Equivalent to set --hey.
|
||||
|
||||
TEST_ID
|
||||
See option --id.
|
||||
|
||||
TEST_IT
|
||||
This is TEST_IT for man_test
|
||||
|
||||
TEST_REPODDIR
|
||||
See option --repodir.
|
||||
|
||||
BUGS
|
||||
Email bug reports to <hehey at example.org>.
|
||||
|
||||
SEE ALSO|}
|
||||
|
||||
let test_groff =
|
||||
Test.test "groff manpage" @@ fun () ->
|
||||
Testing_cmdliner.snap_man ~args:["--help=groff"] cmd @@ __POS_OF__
|
||||
{|.\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R
|
||||
.\"
|
||||
.mso an.tmac
|
||||
.TH "MAN_TEST" 1 "" "Man_test v2.0.0+dune" "Man_test Manual"
|
||||
.\" Disable hyphenation and ragged-right
|
||||
.nh
|
||||
.ad l
|
||||
.SH NAME
|
||||
.P
|
||||
man_test \N'45' UTF\N'45'8 test: 🐫 íöüóőúűéáăîâșț ÍÜÓŐÚŰÉÁĂÎÂȘȚ 雙峰駱駝
|
||||
.SH SYNOPSIS
|
||||
.P
|
||||
\fBman_test\fR [\fIOPTION\fR]…
|
||||
.SH THIS IS A SECTION FOR \fBman_test\fR
|
||||
.P
|
||||
\fBman_test\fR subst at begin and end \fBman_test\fR
|
||||
.P
|
||||
\fIitalic\fR and \fBbold\fR
|
||||
.P
|
||||
$ escaped $$ escaped $
|
||||
.P
|
||||
This does not fail $(a)
|
||||
.P
|
||||
\N'46' this is a paragraph starting with a dot\N'46'
|
||||
.P
|
||||
\N'39' this is a paragraph starting with a quote\N'46'
|
||||
.P
|
||||
This: \N'92'(rs is a backslash for groff and you should not see a \N'92'
|
||||
.P
|
||||
This: \N'92'N\N'39'46\N'39' is a quote for groff and you should not see a \N'39'
|
||||
.P
|
||||
This: \N'92'" is a groff comment and it should not be one\N'46'
|
||||
.P
|
||||
This is a non preformatted paragraph, filling will occur\N'46' This will be properly layout on 80 columns\N'46'
|
||||
.P
|
||||
.nf
|
||||
This is a preformatted paragraph for \fBman_test\fR no filling will occur do the \fIASCII\fR art \fBhere\fR this will overflow on 80 columns
|
||||
0123455678901234556789012345567890123455678901234556789012345567890123455678901234556789
|
||||
|
||||
\N'46'\N'46'\N'46' Should not break
|
||||
a\N'46'\N'46'\N'46' Should not break
|
||||
+\N'45'\N'45'\N'45'+
|
||||
| /|
|
||||
| / | \N'45'\N'45'\N'45'\N'45'> Let\N'39's swim to the moon\N'46'
|
||||
|/ |
|
||||
+\N'45'\N'45'\N'45'+
|
||||
.fi
|
||||
.P
|
||||
These are escapes escaped $ ( ) \N'92'
|
||||
.P
|
||||
() does not need to be escaped outside directives\N'46'
|
||||
.P
|
||||
The following to paragraphs are spliced in\N'46'
|
||||
.P
|
||||
This dollar needs escape $(var) this one as well \fB$(bla)\fR
|
||||
.P
|
||||
This is another paragraph $(bla) \fI$(bla)\fR \fB$(bla)\fR
|
||||
.sp -1
|
||||
.P
|
||||
.nf
|
||||
This is another preformatted paragraph\N'46'
|
||||
There should be no blanks before and after it\N'46'
|
||||
.fi
|
||||
.sp -1
|
||||
.P
|
||||
Hey ho
|
||||
.TP 4
|
||||
label
|
||||
item label
|
||||
.TP 4
|
||||
lebal
|
||||
item lebal
|
||||
.P
|
||||
The last paragraph
|
||||
.SH MIAOUW SECTION (non\N'45'standard unpositioned do not do this)
|
||||
.TP 4
|
||||
\fBTEST_MIAOUW\fR
|
||||
See option \fB\N'45'm\fR\N'46' These are term names \fBman_test\fR \fBman_test\fR
|
||||
.SH OPTIONS
|
||||
.TP 4
|
||||
\fB\N'45'i\fR [\fIID)\fR], \fB\N'45'\N'45'id\fR[=\fIID)\fR] (default=\fB10\fR) (absent=\fB0\fR or \fBTEST_ID\fR env)
|
||||
Whatever \fIID)\fR bla \fBTEST_ID\fR and \fB\N'45'\N'45'id\fR\N'46'
|
||||
.TP 4
|
||||
\fB\N'45'm\fR \fIMIAOUW\fR (absent=\fBmiaouw\fR or \fBTEST_MIAOUW\fR env)
|
||||
Whatever this is the doc var \fIMIAOUW\fR this is the env var \fBTEST_MIAOUW\fR this is the opt \fB\N'45'm\fR and this is \fIitalic\fR and this is \fBbold\fR and this \fB$(opt)\fR is $(opt) in bold and this $ is a dollar\N'46' \fBman_test\fR is the main command name, \fBman_test\fR is the subcommand name and \fBman_test\fR the command invocation\N'46'
|
||||
.TP 4
|
||||
\fB\N'45'\N'45'repodir\fR=\fIDIR\fR (absent=\fB\N'46'\fR or \fBTEST_REPODDIR\fR env)
|
||||
Run the program in repository directory \fIDIR\fR\N'46'
|
||||
.TP 4
|
||||
\fB\N'45'y\fR, \fB\N'45'\N'45'hey\fR (absent \fBTEST_ENV\fR env)
|
||||
Set hey\N'46'
|
||||
.SH COMMON OPTIONS
|
||||
.TP 4
|
||||
\fB\N'45'\N'45'help\fR[=\fIFMT\fR] (default=\fBauto\fR)
|
||||
Show this help in format \fIFMT\fR\N'46' The value \fIFMT\fR must be one of \fBauto\fR, \fBpager\fR, \fBgroff\fR or \fBplain\fR\N'46' With \fBauto\fR, the format is \fBpager\fR or \fBplain\fR whenever the \fBTERM\fR env var is \fBdumb\fR or undefined\N'46'
|
||||
.TP 4
|
||||
\fB\N'45'\N'45'version\fR
|
||||
Show version information\N'46'
|
||||
.SH EXIT STATUS
|
||||
.P
|
||||
\fBman_test\fR exits with:
|
||||
.TP 4
|
||||
0
|
||||
on success\N'46'
|
||||
.TP 4
|
||||
1
|
||||
This is a 1 for \fBman_test\fR
|
||||
.TP 4
|
||||
2\N'45'10
|
||||
Ranges from 2 to 10
|
||||
.TP 4
|
||||
123
|
||||
on indiscriminate errors reported on standard error\N'46'
|
||||
.TP 4
|
||||
124
|
||||
on command line parsing errors\N'46'
|
||||
.TP 4
|
||||
125
|
||||
on unexpected internal errors (bugs)\N'46'
|
||||
.SH ENVIRONMENT
|
||||
.P
|
||||
These environment variables affect the execution of \fBman_test\fR:
|
||||
.TP 4
|
||||
\fBTEST_ENV\fR
|
||||
Equivalent to set \fB\N'45'\N'45'hey\fR\N'46'
|
||||
.TP 4
|
||||
\fBTEST_ID\fR
|
||||
See option \fB\N'45'\N'45'id\fR\N'46'
|
||||
.TP 4
|
||||
\fBTEST_IT\fR
|
||||
This is \fBTEST_IT\fR for \fBman_test\fR
|
||||
.TP 4
|
||||
\fBTEST_REPODDIR\fR
|
||||
See option \fB\N'45'\N'45'repodir\fR\N'46'
|
||||
.SH BUGS
|
||||
.P
|
||||
Email bug reports to <hehey at example\N'46'org>\N'46'
|
||||
.SH SEE ALSO
|
||||
.P
|
||||
ascii(7), grep(1)|}
|
||||
|
||||
let main () =
|
||||
let doc = "Test manpage specifications" in
|
||||
let test_help =
|
||||
let doc = "Test manpage interactively as if --help[$(docv)] is invoked" in
|
||||
let help_fmts =
|
||||
["auto", "=auto"; "pager", "=pager"; "groff", "=groff";
|
||||
"plain", "=plain"; "", ""]
|
||||
in
|
||||
let help_enum = Cmdliner.Arg.enum help_fmts and docv = "FMT" in
|
||||
Arg.(value & opt ~vopt:(Some "") (some help_enum) None &
|
||||
info ["test-help"] ~docv ~doc)
|
||||
in
|
||||
Test.main' test_help ~doc @@ function
|
||||
| None ->
|
||||
Test.log "Invoke with %a[=FMT] to test %a[=FMT] interactively"
|
||||
Fmt.code "--test-help" Fmt.code "--help";
|
||||
Test.autorun ()
|
||||
| Some fmt ->
|
||||
Test.set_main_exit @@ fun () ->
|
||||
let argv = Array.of_list (Cmd.name cmd :: ["--help" ^ fmt ]) in
|
||||
Cmd.eval ~argv (Cmd.v info man_test_t)
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
159
unikernel/duniverse/cmdliner/test/test_term.ml
Normal file
159
unikernel/duniverse/cmdliner/test/test_term.ml
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
(* The tests have the following structure:
|
||||
|
||||
let test =
|
||||
let cmd = … (* A command definition *) in
|
||||
(* A few snapshots of valid cli parses *)
|
||||
parse …
|
||||
(* A few snapshots of invalid cli parses *)
|
||||
error …
|
||||
(* A snapshot of a plain text version of the manual *)
|
||||
Testing_cmdliner.snap_man … *)
|
||||
|
||||
let test_with_used_args =
|
||||
Test.test "Term.with_used_args" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_with_used_args" ~doc:"Test cli arg capture") @@
|
||||
let args =
|
||||
let+ a = Arg.(value & flag & info ["a"; "aaa"])
|
||||
and+ b = Arg.(value & opt (some string) None & info ["b"; "bbb"])
|
||||
and+ c = Arg.(value & pos_all string [] & info []) in
|
||||
(a, b, c)
|
||||
in
|
||||
let+ parse, args = Term.with_used_args args in
|
||||
args, parse
|
||||
in
|
||||
let t = Test.T.(t2 (list string) (t3 bool (option string) (list string))) in
|
||||
let parse = Testing_cmdliner.snap_parse t cmd in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
parse [] @@ __POS_OF__
|
||||
([], (false, None, []));
|
||||
(* Note some of these are bugs, see issue #204 *)
|
||||
parse ["--"] @@ __POS_OF__
|
||||
([], (false, None, []));
|
||||
parse ["hoho"; "-a"; "-bmsg"] @@ __POS_OF__
|
||||
(["-a"; "-b"; "msg"; "hoho"], (true, Some "msg", ["hoho"]));
|
||||
parse ["hoho"; "-a"; "-bmsg"; "hihi"] @@ __POS_OF__
|
||||
(["-a"; "-b"; "msg"; "hoho"; "hihi"], (true, Some "msg", ["hoho"; "hihi"]));
|
||||
parse ["--"; "hoho"; "-a"; "-bbla"; "hihi"] @@ __POS_OF__
|
||||
(["hoho"; "-a"; "-bbla"; "hihi"],
|
||||
(false, None, ["hoho"; "-a"; "-bbla"; "hihi"]));
|
||||
parse ["hoho"; "-a"; "--bbb=msg"; "hihi"] @@ __POS_OF__
|
||||
(["-a"; "--bbb"; "msg"; "hoho"; "hihi"],
|
||||
(true, Some "msg", ["hoho"; "hihi"]));
|
||||
(**)
|
||||
error `Term ["--opt"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_with_used_args\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--aaa\u{001B}[m] [\u{001B}[01m--bbb\u{001B}[m=\u{001B}[04mVAL\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mARG\u{001B}[m]…\n\
|
||||
test_with_used_args: \u{001B}[31munknown\u{001B}[m option \u{001B}[01m--opt\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_with_used_args - Test cli arg capture
|
||||
|
||||
SYNOPSIS
|
||||
test_with_used_args [--aaa] [--bbb=VAL] [OPTION]… [ARG]…
|
||||
|
||||
OPTIONS
|
||||
-a, --aaa
|
||||
|
||||
-b VAL, --bbb=VAL
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_with_used_args exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let term_duplication =
|
||||
Test.test "Term.app duplicates" @@ fun () ->
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_term_dups" ~doc:"Test multiple term usage") @@
|
||||
let+ p =
|
||||
let doc = "First pos argument should show up only once in the docs" in
|
||||
Arg.(value & pos 0 string "popopo" & info [] ~doc ~docv:"POS")
|
||||
and+ o =
|
||||
let doc = "This should show up only once in the docs" in
|
||||
Arg.(value & flag & info ["f"; "flag"] ~doc)
|
||||
in
|
||||
(p, p, o, o)
|
||||
in
|
||||
let t = Test.T.(t4 string string bool bool) in
|
||||
let parse = Testing_cmdliner.snap_parse t cmd in
|
||||
let error err = Testing_cmdliner.snap_eval_error err cmd in
|
||||
parse [] @@ __POS_OF__ ("popopo", "popopo", false, false);
|
||||
parse ["0"] @@ __POS_OF__ ("0", "0", false, false);
|
||||
parse ["0"; "-f"] @@ __POS_OF__ ("0", "0", true, true);
|
||||
(**)
|
||||
error `Term ["0"; "1"] @@ __POS_OF__
|
||||
"Usage: \u{001B}[01mtest_term_dups\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[01m--flag\u{001B}[m] [\u{001B}[04mOPTION\u{001B}[m]… [\u{001B}[04mPOS\u{001B}[m]\n\
|
||||
test_term_dups: \u{001B}[31mtoo many arguments\u{001B}[m, don't know what to do with \u{001B}[01m1\u{001B}[m\n";
|
||||
(**)
|
||||
Testing_cmdliner.snap_man cmd @@ __POS_OF__
|
||||
{|NAME
|
||||
test_term_dups - Test multiple term usage
|
||||
|
||||
SYNOPSIS
|
||||
test_term_dups [--flag] [OPTION]… [POS]
|
||||
|
||||
ARGUMENTS
|
||||
POS (absent=popopo)
|
||||
First pos argument should show up only once in the docs
|
||||
|
||||
OPTIONS
|
||||
-f, --flag
|
||||
This should show up only once in the docs
|
||||
|
||||
COMMON OPTIONS
|
||||
--help[=FMT] (default=auto)
|
||||
Show this help in format FMT. The value FMT must be one of auto,
|
||||
pager, groff or plain. With auto, the format is pager or plain
|
||||
whenever the TERM env var is dumb or undefined.
|
||||
|
||||
EXIT STATUS
|
||||
test_term_dups exits with:
|
||||
|
||||
0 on success.
|
||||
|
||||
123 on indiscriminate errors reported on standard error.
|
||||
|
||||
124 on command line parsing errors.
|
||||
|};
|
||||
()
|
||||
|
||||
let test_env =
|
||||
Test.test "Term.env" @@ fun () ->
|
||||
let env = function "HEYHO" -> Some "Let's go" | _ -> None in
|
||||
let cmd =
|
||||
Cmd.make (Cmd.info "test_env" ~doc:"Test Term.env") @@
|
||||
let+ env = Term.env in
|
||||
Test.(option T.string) (env "HEYHO") (Some "Let's go")
|
||||
in
|
||||
Testing_cmdliner.test_eval_result ~env Test.T.unit cmd [] (Ok (`Ok ()));
|
||||
()
|
||||
|
||||
|
||||
let main () =
|
||||
let doc = "Test term specifications" in
|
||||
Test.main ~doc @@ fun () -> Test.autorun ()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
199
unikernel/duniverse/cmdliner/test/testing_cmdliner.ml
Normal file
199
unikernel/duniverse/cmdliner/test/testing_cmdliner.ml
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2025 The cmdliner programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Cmdliner
|
||||
|
||||
(* Snapshotting command line evaluations *)
|
||||
|
||||
let capture_fmt f =
|
||||
let buf = Buffer.create 255 in
|
||||
let fmt = Format.formatter_of_buffer buf in
|
||||
let ret = f fmt in
|
||||
ret, (Buffer.contents buf)
|
||||
|
||||
let make_argv cmd args = Array.of_list (Cmd.name cmd :: args)
|
||||
let env_dumb_term = function
|
||||
| "TERM" -> Some "dumb"
|
||||
| var -> Sys.getenv_opt var
|
||||
|
||||
let t_eval_result ok =
|
||||
let test_eval_error : Cmd.eval_error Test.T.t =
|
||||
let pp ppf = function
|
||||
| `Parse -> Fmt.string ppf "`Parse"
|
||||
| `Term -> Fmt.string ppf "`Term"
|
||||
| `Exn -> Fmt.string ppf "`Exn"
|
||||
in
|
||||
Test.T.make ~equal:(=) ~pp ()
|
||||
in
|
||||
let test_eval_ok ok =
|
||||
let pp ppf = function
|
||||
| `Ok v -> Test.T.pp ok ppf v
|
||||
| `Version -> Fmt.string ppf "`Version"
|
||||
| `Help -> Fmt.string ppf "`Help"
|
||||
in
|
||||
let equal v0 v1 = match v0, v1 with
|
||||
| `Ok v0, `Ok v1 -> Test.T.equal ok v0 v1
|
||||
| v0, v1 -> v0 = v1
|
||||
in
|
||||
Test.T.make ~equal ~pp ()
|
||||
in
|
||||
Test.T.result' ~ok:(test_eval_ok ok) ~error:test_eval_error
|
||||
|
||||
let get_eval_value ?__POS__ = function
|
||||
| Ok (`Ok v) -> v
|
||||
| (Error _ | Ok `Version | Ok `Help) as v ->
|
||||
Test.failstop ?__POS__ "Unexpected evalution: %a"
|
||||
(Test.T.pp (t_eval_result Test.T.any)) v
|
||||
|
||||
let test_eval_result ?__POS__ ?env t cmd args exp =
|
||||
let argv = make_argv cmd args in
|
||||
let (ret, _), _ = (* Ignore outputs *)
|
||||
capture_fmt @@ fun err ->
|
||||
capture_fmt @@ fun help ->
|
||||
Cmd.eval_value ?env ~help ~err cmd ~argv
|
||||
in
|
||||
Test.eq ?__POS__ (t_eval_result t) ret exp
|
||||
|
||||
let snap_parse ?env t cmd args exp =
|
||||
let loc = Test.Snapshot.loc exp in
|
||||
let argv = make_argv cmd args in
|
||||
let ret = Cmd.eval_value ?env cmd ~argv in
|
||||
Test.snap t (get_eval_value ~__POS__:loc ret) exp
|
||||
|
||||
let snap_parse_warnings ?env cmd args exp =
|
||||
let loc = Test.Snapshot.loc exp in
|
||||
let argv = make_argv cmd args in
|
||||
let ret, err = capture_fmt @@ fun err -> Cmd.eval_value ?env ~err cmd ~argv in
|
||||
ignore (get_eval_value ~__POS__:loc ret);
|
||||
Snap.lines err exp
|
||||
|
||||
let snap_eval_error ?env error cmd args exp =
|
||||
let loc = Test.Snapshot.loc exp in
|
||||
let argv = make_argv cmd args in
|
||||
let ret, err = capture_fmt @@ fun err -> Cmd.eval_value ?env ~err cmd ~argv in
|
||||
Test.eq (t_eval_result Test.T.any) ret (Error error) ~__POS__:loc ;
|
||||
Snap.lines err exp
|
||||
|
||||
let snap_help ?env retv cmd args exp =
|
||||
let loc = Test.Snapshot.loc exp in
|
||||
let argv = make_argv cmd args in
|
||||
let (ret, help), err =
|
||||
capture_fmt @@ fun err ->
|
||||
capture_fmt @@ fun help -> Cmd.eval_value ?env ~help ~err cmd ~argv
|
||||
in
|
||||
Test.string err "";
|
||||
Test.eq (t_eval_result Test.T.any) ret retv ~__POS__:loc;
|
||||
Snap.lines help exp
|
||||
|
||||
let snap_completion ?env cmd args exp =
|
||||
snap_help ?env (Ok `Help) cmd ("--__complete" :: args) exp
|
||||
|
||||
let snap_man ?env ?(args = ["--help=plain"]) cmd exp =
|
||||
snap_help ?env (Ok `Help) cmd args exp
|
||||
|
||||
(* Sample commands *)
|
||||
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let sample_group_cmd =
|
||||
let man = [ `P "Invoke command with $(cmd), the command name is \
|
||||
$(cmd.name), the parent is $(cmd.parent) and the tool \
|
||||
name is $(tool)." ] in
|
||||
let kind =
|
||||
let doc = "Kind of entity" in
|
||||
Arg.(value & opt (some string) None & info ["k";"kind"] ~doc)
|
||||
in
|
||||
let speed =
|
||||
let doc = "Movement $(docv) in m/s" in
|
||||
Arg.(value & opt int 2 & info ["speed"] ~doc ~docv:"SPEED")
|
||||
in
|
||||
let can_fly =
|
||||
let doc = "$(docv) indicates if the entity can fly." in
|
||||
Arg.(value & opt bool false & info ["can-fly"] ~doc)
|
||||
in
|
||||
let birds =
|
||||
let bird =
|
||||
let doc = "Use $(docv) specie." in
|
||||
Arg.(value & pos 0 string "pigeon" & info [] ~doc ~docv:"BIRD")
|
||||
in
|
||||
let fly =
|
||||
Cmd.make (Cmd.info "fly" ~doc:"Fly birds." ~man) @@
|
||||
let+ bird and+ speed in ()
|
||||
in
|
||||
let land' =
|
||||
Cmd.make (Cmd.info "land" ~doc:"Land birds." ~man) @@
|
||||
let+ bird in ()
|
||||
in
|
||||
let info = Cmd.info "birds" ~doc:"Operate on birds." ~man in
|
||||
Cmd.group ~default:Term.(const (fun _ _-> ()) $ kind $ can_fly) info @@
|
||||
[fly; land']
|
||||
in
|
||||
let mammals =
|
||||
let man_xrefs = [`Main; `Cmd "birds" ] and doc = "Operate on mammals." in
|
||||
Cmd.make (Cmd.info "mammals" ~doc ~man_xrefs ~man) @@
|
||||
Term.(const (fun () -> ()) $ const ())
|
||||
in
|
||||
let fishs =
|
||||
let name' =
|
||||
let doc = "Use fish named $(docv)." in
|
||||
Arg.(value & pos 0 (some string) None & info [] ~doc ~docv:"NAME")
|
||||
in
|
||||
Cmd.make (Cmd.info "fishs" ~doc:"Operate on fishs." ~man) @@
|
||||
let+ name' in ()
|
||||
in
|
||||
let camels =
|
||||
let herd =
|
||||
let doc = "Find in herd $(docv)." and docv = "HERD" in
|
||||
let deprecated = "Herds $(docv) are ignored." in
|
||||
Arg.(value & pos 0 (some string) None & info [] ~deprecated ~doc ~docv)
|
||||
in
|
||||
let bactrian =
|
||||
let deprecated = "Use nothing instead of $(env), $(b,HA!)." in
|
||||
let doc = "Specify a bactrian camel." in
|
||||
let env = Cmd.Env.info "BACTRIAN" ~deprecated in
|
||||
Arg.(value & flag & info ["bactrian"; "b"] ~deprecated ~env ~doc)
|
||||
in
|
||||
let deprecated = "Use $(b,mammals) instead." in
|
||||
Cmd.make (Cmd.info "camels" ~deprecated ~doc:"Operate on camels." ~man) @@
|
||||
let+ bactrian and+ herd in ()
|
||||
in
|
||||
let lookup =
|
||||
let kind_opt =
|
||||
let kinds = ["bird", `Bird; "fish", `Fish] in
|
||||
let doc =
|
||||
"$(docv) restricts the animal kind. Must be " ^ Arg.doc_alts_enum kinds
|
||||
in
|
||||
Arg.(value & opt (some (enum kinds)) None & info ["k"; "kind"] ~doc)
|
||||
in
|
||||
let name_conv =
|
||||
let bird_names = ["sparrow"; "parrot"; "pigeon"] in
|
||||
let fish_names = ["salmon"; "trout"; "piranha"] in
|
||||
let completion =
|
||||
let select ~token:prefix n =
|
||||
if String.starts_with ~prefix n
|
||||
then Some (Arg.Completion.string n) else None
|
||||
in
|
||||
let func kind ~token = match Option.join kind with
|
||||
| None -> Ok (List.filter_map (select ~token) (bird_names @ fish_names))
|
||||
| Some `Bird -> Ok (List.filter_map (select ~token) bird_names)
|
||||
| Some `Fish -> Ok (List.filter_map (select ~token) fish_names)
|
||||
in
|
||||
Arg.Completion.make ~context:kind_opt func
|
||||
in
|
||||
Arg.Conv.of_conv Arg.string ~completion
|
||||
in
|
||||
Cmd.make (Cmd.info "lookup" ~doc:"Lookup animal by name.") @@
|
||||
let+ kind_opt
|
||||
and+ name =
|
||||
let doc = "$(docv) is the animal name to lookup" and docv = "NAME" in
|
||||
Arg.(required & pos 0 (some name_conv) None & info [] ~doc ~docv)
|
||||
in
|
||||
()
|
||||
in
|
||||
Cmd.group (Cmd.info "test_group" ~version:"X.Y.Z" ~man) @@
|
||||
[birds; mammals; fishs; camels; lookup]
|
||||
Loading…
Add table
Add a link
Reference in a new issue