From 763d20dd9968f84ca78c435e4a5a3cb28c65ec2f Mon Sep 17 00:00:00 2001
From: Carl Gay <carlgay@gmail.com>
Date: Wed, 14 Jul 2021 03:55:50 +0000
Subject: [PATCH] Support multi-level subcommands

Motivating use case:

  dylan new library --type exe my-lib
  dylan new workspace ...

In programs with a fairly large set of subcommands this just reduces
the top-level clutter and need to stuff everything into a top-level
command by adding hyphens or what-have-you.

By default subcommands support the `--help` option and there is also
a top-level `help` subcommand that accepts any (multi-level) subcommand
for which it displays help. For example,

  dylan new --help
  dylan help new workspace
---
 command-line-parser.dylan                     | 229 +++++++++++-------
 help.dylan                                    |  94 ++++---
 library.dylan                                 |   3 +-
 parsers.dylan                                 |   2 +-
 ...mmand-line-parser-test-suite-library.dylan |   8 +-
 tests/command-line-parser-test-suite.dylan    |   2 +-
 tests/subcommands-test.dylan                  | 142 +++++++++--
 7 files changed, 321 insertions(+), 159 deletions(-)

diff --git a/command-line-parser.dylan b/command-line-parser.dylan
index 5d9e0db..fade93b 100644
--- a/command-line-parser.dylan
+++ b/command-line-parser.dylan
@@ -106,44 +106,71 @@ end function;
 //======================================================================
 
 define abstract class <command> (<object>)
-  constant slot parser-tokens :: <deque> = make(<deque>); // of: <token>
   slot command-options :: <sequence> = make(<stretchy-vector>),
     init-keyword: options:;
   constant slot %command-help :: <string>,
     required-init-keyword: help:;
+  // Subcommands may be arbitrarily nested.
+  slot command-subcommands :: <sequence> = #[],
+    init-keyword: subcommands:;
+  slot selected-subcommand :: false-or(<subcommand>) = #f;
 end class;
 
-define method initialize (cmd :: <command>, #key) => ()
+// The --help option is added by default but we provide a way to turn it off here.
+define method initialize
+    (cmd :: <command>, #key help-option? :: <boolean> = #t, #all-keys)
+ => ()
+  if (help-option?)
+    add-help-option(cmd);
+  end;
   next-method();
-  validate-options(cmd.command-options);
+  validate-options(cmd);
+end method;
+
+define open abstract class <subcommand> (<command>)
+  constant slot subcommand-name :: <string>,
+    required-init-keyword: name:;
+end class;
+
+define method debug-name
+    (subcmd :: <subcommand>) => (name :: <string>)
+  subcmd.subcommand-name
 end method;
 
-define function validate-options (options :: <sequence>)
+define function validate-options
+    (cmd :: <command>) => ()
+  let description = if (instance?(cmd, <subcommand>))
+                      format-to-string("Subcommand %=", cmd.subcommand-name)
+                    else
+                      "Command"
+                    end;
+  if (cmd.has-subcommands? & cmd.positional-options.size > 0)
+    parser-error("%s has both subcommands and positional options", description);
+  end;
   // Don't care if positionals are mixed in with pass-by-names because
   // positional-options will extract them in order.
   let names = make(<stretchy-vector>);
   let repeated-positional = #f;
   let optional-positional = #f;
-  for (option in options)
+  for (option in cmd.command-options)
     for (name in option.option-names)
       if (member?(name, names, test: \=))
-        parser-error("Duplicate option name: %=", name);
+        parser-error("%s has duplicate option name: %=", description, name);
       end;
       add!(names, name);
     end;
     if (repeated-positional)
-      parser-error("only one repeated positional option (currently %=) is"
-                     " allowed and it must be the last option",
-                   repeated-positional.canonical-name);
+      parser-error("%s has options following repeated positional option %=",
+                   description, repeated-positional.canonical-name);
     end;
     if (instance?(option, <positional-option>))
       if (option.option-repeated?)
         repeated-positional := option;
       end;
       if (option.option-required? & optional-positional)
-        parser-error("required positional option %= may not follow"
+        parser-error("%s has required positional option %= following"
                        " optional positional option %=",
-                     option.canonical-name,
+                     description, option.canonical-name,
                      optional-positional.canonical-name);
       end;
       if (~option.option-required?)
@@ -167,90 +194,105 @@ define function pass-by-name-options
          cmd.command-options)
 end function;
 
-define open abstract class <subcommand> (<command>)
-  constant slot subcommand-name :: <string>,
-    required-init-keyword: name:;
-end class;
-
-define method debug-name
-    (subcmd :: <subcommand>) => (name :: <string>)
-  subcmd.subcommand-name
-end method;
-
-// Should this just be another method on execute-command instead?
-define open generic execute-subcommand
-    (parser :: <command-line-parser>, subcmd :: <object>)
- => (status :: false-or(<integer>));
-
-define method execute-subcommand
-    (parser :: <command-line-parser>, subcmd :: <object>)
- => (status :: false-or(<integer>))
-  error("don't know how to execute subcommand %=. add an execute-subcommand method?",
-        subcmd);
-end method;
-
-define open class <command-line-parser> (<command>)
-  slot parser-subcommands :: <sequence> = #[],
-    init-keyword: subcommands:;
-  slot selected-subcommand :: false-or(<subcommand>) = #f;
-end class;
-
-// Help options are on by default but may be turned off.
-define method initialize
-    (parser :: <command-line-parser>,
-     #key help-option? :: <boolean> = #t,
-          help-subcommand? :: <boolean> = #t, #all-keys) => ()
-  next-method();
-  if (help-option?)
-    add-help-option(parser);
-  end;
-  if (help-subcommand? & parser.has-subcommands?)
-    add-help-subcommand(parser);
-  end;
-end method;
-
 define function has-subcommands?
-    (parser :: <command-line-parser>) => (_ :: <boolean>)
-  parser.parser-subcommands.size > 0
+    (cmd :: <command>) => (_ :: <boolean>)
+  cmd.command-subcommands.size > 0
 end;
 
 define generic find-subcommand
-    (parser :: <command-line-parser>, object)
+    (cmd :: <command>, object)
  => (subcommand :: false-or(<subcommand>));
 
 define method find-subcommand
-    (parser :: <command-line-parser>, class :: subclass(<subcommand>))
+    (cmd :: <command>, class :: subclass(<subcommand>))
  => (subcommand :: false-or(<subcommand>))
-  let subs = parser.parser-subcommands;
+  let subs = cmd.command-subcommands;
   let key = find-key(subs, rcurry(instance?, class));
   key & subs[key]
 end method;
 
 define method find-subcommand
-    (parser :: <command-line-parser>, name :: <string>)
+    (cmd :: <command>, name :: <string>)
  => (subcommand :: false-or(<subcommand>))
-  let subs = parser.parser-subcommands;
+  let subs = cmd.command-subcommands;
   let key = find-key(subs, method (subcmd)
                              name = subcmd.subcommand-name
                            end);
   key & subs[key]
 end method;
 
+define method find-subcommand
+    (cmd :: <command>, path :: <sequence>)
+ => (subcommand :: false-or(<subcommand>))
+  iterate loop (cmd = cmd, i = 0)
+    if (i >= path.size)
+      cmd
+    else
+      let subs = cmd.command-subcommands;
+      let name = path[i];
+      let k = find-key(subs, method (subcmd)
+                               name = subcmd.subcommand-name
+                             end);
+      k & loop(subs[k], i + 1)
+    end
+  end
+end method;
+
 define function add-subcommand
-    (parser :: <command-line-parser>, subcmd :: <subcommand>) => ()
+    (cmd :: <command>, subcmd :: <subcommand>) => ()
   let name = subcommand-name(subcmd);
-  if (parser.positional-options.size > 0)
-    parser-error("a command line parser may not have both positional"
+  if (cmd.positional-options.size > 0)
+    parser-error("a command may not have both positional"
                    " options and subcommands");
   end;
-  if (find-subcommand(parser, name))
+  if (find-subcommand(cmd, name))
     parser-error("a subcommand named %= already exists", name);
   end;
-  parser.parser-subcommands := add!(parser.parser-subcommands, subcmd);
+  cmd.command-subcommands := add!(cmd.command-subcommands, subcmd);
 end function;
 
+define open generic execute-subcommand
+    (parser :: <command-line-parser>, subcmd :: <object>)
+ => (status :: false-or(<integer>));
+
+define method execute-subcommand
+    (parser :: <command-line-parser>, subcmd :: <object>)
+ => (status :: false-or(<integer>))
+  error("don't know how to execute subcommand %=. add an execute-subcommand method?",
+        subcmd);
+end method;
+
+// A <command-line-parser> is just a top-level command that handles the overall command
+// line processing.
+define open class <command-line-parser> (<command>)
+  constant slot parser-tokens :: <deque> = make(<deque>); // of: <token>
+end class;
+
+define method initialize
+    (cmd :: <command-line-parser>, #key help-subcommand? :: <boolean> = #t, #all-keys)
+ => ()
+  next-method();
+  // A "help" subcommand is added only if there are other subcommands since adding
+  // subcommands changes the way the overall command is parsed.
+  //
+  // TODO(cgay): This isn't called if someone uses the pattern
+  //   let cmd = make(<command-line-parser>, ...no subcommands: argument...);
+  //   add-subcommand(cmd, subcmd);
+  // So for now if you use that pattern you have to add the help subcommand manually.
+  // I don't like that it means there's a different level of knowledge necessary for
+  // that pattern. We could stash away the value of `help-subcommand?` here and use
+  // it later if add-subcommand is called. I want to see how the new macros look before
+  // deciding how to handle this though.
+  if (help-subcommand? & cmd.has-subcommands?)
+    add-help-subcommand(cmd);
+  end;
+end method;
+
+// This wasn't really well thought out. It's only useful to call if you have subcommands
+// and each one has its own subclass.
 define generic execute-command
-    (parser :: <command-line-parser>) => (status :: false-or(<integer>));
+    (parser :: <command-line-parser>)
+ => (status :: false-or(<integer>));
 
 define method execute-command
     (parser :: <command-line-parser>) => (status :: false-or(<integer>))
@@ -272,9 +314,8 @@ define generic add-option (cmd :: <command>, option :: <option>) => ();
 
 define method add-option
     (cmd :: <command>, option :: <option>) => ()
-  let new-options = add(cmd.command-options, option);
-  validate-options(new-options);
-  cmd.command-options := new-options;
+  cmd.command-options := add(cmd.command-options, option);
+  validate-options(cmd);
 end method;
 
 define generic find-option
@@ -309,21 +350,21 @@ define function get-option-value
 end function;
 
 define function add-argument-token
-    (parser :: <command>, class :: <class>, value :: <string>,
+    (parser :: <command-line-parser>, class :: <class>, value :: <string>,
      #rest keys, #key, #all-keys)
  => ()
   push-last(parser.parser-tokens, apply(make, class, value: value, keys));
 end;
 
 define function tokens-remaining?
-    (parser :: <command>) => (remaining? :: <boolean>)
+    (parser :: <command-line-parser>) => (remaining? :: <boolean>)
   ~parser.parser-tokens.empty?
 end;
 
 // TODO(cgay): This says it returns false-or, but it doesn't. I think it would be an
 // improvement to make it do that and get rid of tokens-remaining?.
 define function peek-token
-    (parser :: <command>) => (token :: false-or(<token>))
+    (parser :: <command-line-parser>) => (token :: false-or(<token>))
   unless (tokens-remaining?(parser))
     usage-error("Ran out of arguments.")
   end;
@@ -331,7 +372,7 @@ define function peek-token
 end;
 
 define function pop-token
-    (parser :: <command>) => (token :: false-or(<token>))
+    (parser :: <command-line-parser>) => (token :: false-or(<token>))
   unless (tokens-remaining?(parser))
     usage-error("Ran out of arguments.")
   end;
@@ -408,6 +449,9 @@ define method initialize
   let type = option.option-type;
   if (default)
     if (option.option-repeated?)
+      // TODO(cgay): Verify that each element of the default value can be converted to an
+      // instance of the option's type via parse-option-value. (I forget whether the
+      // default is normally converted to the type: or not....)
       type := <collection>
     end;
     if (~instance?(default, type))
@@ -675,7 +719,7 @@ define method parse-command-line
   let (clean-args, extra-args) = split-args(args);
   let chopped-args = chop-args(clean-args);
   tokenize-args(parser, chopped-args);
-  process-tokens(parser, #f);
+  process-tokens(program-name(), parser, #f);
 
   if (~empty?(extra-args))
     // Append any more positional options from after the '--'.  If there's a
@@ -702,17 +746,26 @@ end method;
 define open generic parse-option
     (option :: <option>, args :: <command>) => ();
 
-// Process the tokens, side-effecting the <command>, the <subcommand> (if any),
-// and the <option>s. If a subcommand is encountered, the remaining tokens are
-// passed to it and this is called recursively.
+// Process the tokens, side-effecting the <command>, the <subcommand>s (if any), and the
+// <option>s. If a subcommand is encountered, the remaining tokens are passed to it and
+// this is called recursively. Only the last (sub)command may have positional args.
 //
 // One bit of subtlety here (which would be cleaned up by separating the parser
 // from the command descriptions) is that the full tokenized command line is
 // stored in the <command-line-parser> while some of the options may be stored
 // in a <subcommand>.
 define function process-tokens
-    (parser :: <command-line-parser>, subcmd :: false-or(<subcommand>))
-  let pos-opts = as(<list>, (subcmd | parser).positional-options);
+    (name :: <string>, parser :: <command-line-parser>, subcmd :: false-or(<subcommand>))
+  let cmd = subcmd | parser;
+  let pos-opts = as(<list>, cmd.positional-options);
+  if (~empty?(pos-opts) & cmd.has-subcommands?)
+    // TODO(cgay): move this to validate-options or equivalent so that it happens at
+    // instantiation time.
+    usage-error("The %= %s has subcommands so it may not have its own positional"
+                  " arguments.",
+                name,
+                if (instance?(cmd, <subcommand>)) "subcommand" else "command" end);
+  end;
   while (tokens-remaining?(parser))
     let token = peek-token(parser);
     let value = token.token-value;
@@ -720,35 +773,37 @@ define function process-tokens
       <argument-token> =>
         // Got an argument token without a preceding <short/long-option-token>
         // so it must be a subcommand or a positional argument.
-        if (~subcmd & parser.has-subcommands?)
-          let sub = find-subcommand(parser, value)
+        if (cmd.has-subcommands?)
+          let sub = find-subcommand(cmd, value)
             | usage-error("%= does not name a subcommand.", value);
           pop-token(parser);
+          // Store the selected subcommand in the parent subcommand, and the top-level
+          // parser always receives the final subcommand.
+          cmd.selected-subcommand := sub;
           parser.selected-subcommand := sub;
-          //subcommand.parser-tokens := parser.parser-tokens;
-          process-tokens(parser, sub);
+          process-tokens(sub.subcommand-name, parser, sub);
         else
           if (empty?(pos-opts))
             usage-error("Too many positional arguments: %=", value);
           end;
           let option = head(pos-opts);
           if (option.option-repeated?)
-            assert(pos-opts.size = 1);
+            assert(pos-opts.size = 1); // Repeated option must be last option.
           else
             pos-opts := tail(pos-opts);
           end;
-          parse-option(option, parser);
+          parse-option(option, parser); // Parser contains the unprocessed tokens.
           option.option-present? := #t;
         end;
       <short-option-token>, <long-option-token> =>
-        let option = find-option(subcmd | parser, value)
+        let option = find-option(cmd, value)
           | usage-error("Unrecognized option: %s%s",
                         if (value.size = 1) "-" else "--" end,
                         value);
         if (instance?(option, <help-option>))
           // Handle --help early in case the remainder of the command line is
           // invalid or there are missing required arguments.
-          print-help(parser, subcmd);
+          print-help(cmd);
           abort-command(0);
         end;
         parse-option(option, parser);
diff --git a/help.dylan b/help.dylan
index 0a09be8..f6b4793 100644
--- a/help.dylan
+++ b/help.dylan
@@ -33,6 +33,7 @@ define function add-help-subcommand
                       options: list(make(<positional-option>,
                                          name: "subcommand",
                                          required?: #f,
+                                         repeated?: #t,
                                          help: "A subcommand name."))))
 end function;
 
@@ -71,12 +72,12 @@ define method execute-subcommand
   if (name)
     let subcmd = find-subcommand(parser, name);
     if (subcmd)
-      print-help(parser, subcmd);
+      print-help(subcmd);
     else
-      usage-error("Subcommand %= not found.", name);
+      usage-error("Subcommand %= not found.", join(name, " "));
     end;
   else
-    print-help(parser, #f);     // 'app help' same as 'app --help'
+    print-help(parser);         // 'app help' same as 'app --help'
   end;
 end method;
 
@@ -87,7 +88,7 @@ end;
 
 // make open generic?
 define function add-help-option
-    (parser :: <command-line-parser>) => ()
+    (parser :: <command>) => ()
   add-option(parser, make(<help-option>,
                           names: #("help", "h"),
                           help: "Display this message."));
@@ -149,61 +150,47 @@ define method format-option-usage
   option.canonical-option-name
 end;
 
-define open generic print-help
-    (parser :: <command-line-parser>, subcmd :: false-or(<subcommand>), #key stream);
-
-define method print-help
-    (parser :: <command-line-parser>, subcmd == #f,
-     #key stream :: <stream> = *standard-output*)
-  format(stream, "%s\n", parser.command-help);
-  format(stream, "\n%s\n", generate-usage(parser));
-  print-options(stream, parser,
-                if (empty?(parser-subcommands(parser)))
-                  "Options:"
-                else
-                  "Global options:"
-                end);
-  if (~empty?(parser-subcommands(parser)))
+define function print-help
+    (cmd :: <command>, #key stream :: <stream> = *standard-output*)
+  format(stream, "%s\n", command-help(cmd));
+  format(stream, "\n%s\n", generate-usage(cmd));
+  print-options(cmd, stream);
+  if (cmd.has-subcommands?)
     format(stream, "\nSubcommands:\n");
-    let (names, docs) = subcommand-columns(parser);
+    let (names, docs) = subcommand-columns(cmd);
     if (~empty?(names))
       let name-width = reduce1(max, map(size, names));
       for (name in names, doc in docs)
         format(stream, "%s  %s\n", pad-right(name, name-width), doc);
       end;
     end;
-    let help-subcommand = find-subcommand(parser, <help-subcommand>);
+    format(stream, "\n");
+    let help-subcommand = find-subcommand(cmd, <help-subcommand>);
     if (help-subcommand)
-      format(stream, "\nUse '%s %s <subcommand>' to see subcommand options.\n",
+      format(stream, "Use '%s %s <cmd> [<cmd> ...]' to see subcommand options.\n",
              program-name(), subcommand-name(help-subcommand));
     end;
   end;
-end method;
-
-define method print-help
-    (parser :: <command-line-parser>, subcmd :: <subcommand>,
-     #key stream :: <stream> = *standard-output*)
-  format(stream, "%s\n", subcmd.command-help);
-  format(stream, "\n%s\n", generate-usage(subcmd));
-  print-options(stream, subcmd, "Options:");
-  let help-option = find-option(parser, <help-option>);
-  if (help-option)
-    format(stream, "\nUse '%s %s' to see global options.\n",
-           program-name(), help-option.canonical-name.visible-option-name);
+  if (~instance?(cmd, <command-line-parser>))
+    let help-option = find-option(cmd, <help-option>);
+    if (help-option)
+      format(stream, "Use '%s %s' to see global options.\n",
+             program-name(), help-option.canonical-name.visible-option-name);
+    end;
   end;
-end method;
+end function;
 
-define method print-options
-    (stream :: <stream>, command :: <command>, header :: <string>) => ()
-  let (names, docs) = option-columns(command);
+define function print-options
+    (cmd :: <command>, stream :: <stream>) => ()
+  let (names, docs) = option-columns(cmd);
   if (~empty?(names))
-    format(stream, "\n%s\n", header);
+    format(stream, "\nOptions:\n");
     let name-width = reduce1(max, map(size, names));
     for (name in names, doc in docs)
       format(stream, "  %s  %s\n", pad-right(name, name-width), doc);
     end;
   end;
-  let (names, docs) = positional-columns(command);
+  let (names, docs) = positional-columns(cmd);
   if (~empty?(names))
     format(stream, "\nPositional arguments:\n");
     let name-width = reduce1(max, map(size, names));
@@ -211,7 +198,7 @@ define method print-options
       format(stream, "  %s  %s\n", pad-right(name, name-width), doc);
     end;
   end;
-end method;
+end function;
 
 define function positional-columns
     (cmd :: <command>) => (names :: <sequence>, docs :: <sequence>)
@@ -256,17 +243,24 @@ define function option-columns
   values(names, docs)
 end function;
 
-// There is much work to be done to make this better.
 define function subcommand-columns
-    (parser :: <command-line-parser>)
+    (cmd :: <command>)
  => (names :: <sequence>, docs :: <sequence>)
   let names = make(<stretchy-vector>);
   let docs = make(<stretchy-vector>);
-  for (subcmd in parser.parser-subcommands)
-    add!(names, concatenate("  ", subcmd.subcommand-name));
-    // TODO(cgay): Wrap doc text.
-    add!(docs, subcmd.command-help);
-  end for;
+  iterate loop (subs = as(<list>, cmd.command-subcommands), indent = "  ")
+    if (~empty?(subs))
+      let subcmd = subs[0];
+      add!(names, concatenate(indent, subcmd.subcommand-name));
+      // TODO(cgay): Wrap doc text.
+      add!(docs, subcmd.command-help);
+      if (subcmd.has-subcommands?)
+        loop(subcmd.command-subcommands, concatenate(indent, "  "));
+      else
+        loop(tail(subs), indent)
+      end;
+    end;
+  end iterate;
   values(names, docs)
 end function;
 
@@ -281,10 +275,10 @@ define method generate-usage
     let subs? = cmd.has-subcommands?;
     format(stream, "Usage: %s", program-name());
     if (cmd.pass-by-name-options.size > 0)
-      format(stream, " [%soptions]", if (subs?) "global " else "" end);
+      format(stream, " [options]");
     end;
     if (subs?)
-      format(stream, " <subcommand> [sub options] args...")
+      format(stream, " <cmd> [cmd options] args...")
     end;
     print-positional-args(stream, cmd);
   end
diff --git a/library.dylan b/library.dylan
index b472419..398cd20 100644
--- a/library.dylan
+++ b/library.dylan
@@ -77,9 +77,10 @@ define module command-line-parser
   export
     <subcommand>,               // Subclass this for each subcommand...
     <help-subcommand>,          // ...except use this for the help subcommand.
+    add-subcommand,
     execute-subcommand;         // Override this for each subcommand.
 
-  // Option classes
+  // Options
   export
     <option>,
     <flag-option>,               // --opt or --opt=yes/no
diff --git a/parsers.dylan b/parsers.dylan
index c4f1798..98a0aff 100644
--- a/parsers.dylan
+++ b/parsers.dylan
@@ -51,7 +51,7 @@ define method negative-option?
 end;
 
 define method parse-option
-    (option :: <flag-option>, parser :: <command>)
+    (option :: <flag-option>, parser :: <command-line-parser>)
  => ()
   let token = pop-token(parser);
   option.option-value := ~negative-option?(option, token);
diff --git a/tests/command-line-parser-test-suite-library.dylan b/tests/command-line-parser-test-suite-library.dylan
index dcb1884..c113d2e 100644
--- a/tests/command-line-parser-test-suite-library.dylan
+++ b/tests/command-line-parser-test-suite-library.dylan
@@ -13,7 +13,13 @@ define module command-line-parser-test-suite
   use command-line-parser;
   use common-dylan, exclude: { format-to-string };
   use format;
-  use option-parser-protocol;
+  use option-parser-protocol,
+    import: {
+      option-help,
+      option-value,
+      positional-options,
+      selected-subcommand
+    };
   use standard-io;
   use streams;
   use strings;
diff --git a/tests/command-line-parser-test-suite.dylan b/tests/command-line-parser-test-suite.dylan
index ae8e244..37af80e 100644
--- a/tests/command-line-parser-test-suite.dylan
+++ b/tests/command-line-parser-test-suite.dylan
@@ -89,7 +89,7 @@ end test test-command-line-parser;
 define test test-synopsis-format ()
   let parser = make-parser();
   let synopsis = with-output-to-string (stream)
-                   print-help(parser, #f, stream: stream)
+                   print-help(parser, stream: stream)
                  end;
   let expected = #:str:"x
 
diff --git a/tests/subcommands-test.dylan b/tests/subcommands-test.dylan
index 1e49450..609aed5 100644
--- a/tests/subcommands-test.dylan
+++ b/tests/subcommands-test.dylan
@@ -4,28 +4,134 @@ Module: command-line-parser-test-suite
 define class <subcommand-s1> (<subcommand>) end;
 
 define test test-subcommand-parsing ()
-  let global-a = make(<flag-option>, names: #("a"), help: "a help");
-  let global-b = make(<parameter-option>, names: #("b"), help: "b help");
-  let local-c  = make(<flag-option>, names: #("c"), help: "c help");
-  let positional-d = make(<positional-option>, names: #("d"), help: "d help");
-  let positional-e = make(<positional-option>,
-                          repeated?: #t, names: #("e"), help: "e help");
-  let s1 = make(<subcommand-s1>, name: "s1", help: "s1 help");
-  add-option(s1, local-c);
-  add-option(s1, positional-d);
-  add-option(s1, positional-e);
-  let p = make(<command-line-parser>,
-               help: "main help",
-               subcommands: list(s1));
-  add-option(p, global-a);
-  add-option(p, global-b);
-
-  // Done with setup
-
+  local method make-parser ()
+          let global-a = make(<flag-option>,
+                              name: "a", help: "a help");
+          let global-b = make(<parameter-option>,
+                              name: "b", help: "b help");
+          let local-c  = make(<flag-option>,
+                              name: "c", help: "c help");
+          let positional-d = make(<positional-option>,
+                                  name: "d", help: "d help", required?: #t);
+          let positional-e = make(<positional-option>,
+                                  name: "e", help: "e help", repeated?: #t);
+          let s1 = make(<subcommand-s1>, name: "s1", help: "s1 help");
+          add-option(s1, local-c);
+          add-option(s1, positional-d);
+          add-option(s1, positional-e);
+          let p = make(<command-line-parser>,
+                       help: "main help",
+                       subcommands: list(s1));
+          add-option(p, global-a);
+          add-option(p, global-b);
+          values(p, s1)
+        end method;
+  let (p, s1) = make-parser();
   assert-no-errors(parse-command-line(p, #["-a", "s1", "-c", "d", "e", "e"]));
   assert-true(get-option-value(p, "a"));
   assert-false(get-option-value(p, "b"));
   assert-true(get-option-value(s1, "c"));
   assert-equal("d", get-option-value(s1, "d"));
   assert-equal(#["e", "e"], get-option-value(s1, "e"));
+
+  let p = make-parser();
+  assert-signals(<command-line-parser-error>, parse-command-line(p, #["s1"]),
+                 "missing required argument d signals error?");
+end test;
+
+// Perhaps making <subcommand> abstract was a bad idea and we should allow passing a
+// "handler" function instead of writing an execute-subcommand method.
+define class <subcommand-new> (<subcommand>) end;
+define class <subcommand-workspace> (<subcommand>) end;
+define class <subcommand-library> (<subcommand>) end;
+
+define function make-multi-level-command ()
+  let new = make(<subcommand-new>, name: "new", help: "help");
+  let workspace = make(<subcommand-workspace>,
+                       name: "workspace",
+                       help: "help",
+                       options: list(make(<flag-option>, name: "wf", help: "help"),
+                                     make(<keyed-option>, name: "wk", help: "help"),
+                                     make(<positional-option>,
+                                          name: "name",
+                                          help: "help",
+                                          required?: #t)));
+  let library = make(<subcommand-library>,
+                     name: "library",
+                     help: "help",
+                     options: list(make(<parameter-option>,
+                                        name: "lp",
+                                        help: "help",
+                                        default: "ld"),
+                                   make(<positional-option>,
+                                        name: "name",
+                                        help: "help",
+                                        required?: #t,
+                                        repeated?: #t)));
+  add-subcommand(new, workspace);
+  add-subcommand(new, library);
+  let p = make(<command-line-parser>, help: "help", subcommands: list(new));
+  values(p, new, workspace, library)
+end function;
+
+define test test-subcommands-missing-positional-args ()
+  let (p, new, workspace) = make-multi-level-command();
+  assert-signals(<usage-error>, parse-command-line(p, #["new", "workspace"]));
+  assert-equal(workspace, new.selected-subcommand);
+  assert-equal(workspace, p.selected-subcommand);
+end test;
+
+define test test-subcommands-all-args-provided ()
+  let (p, _, workspace) = make-multi-level-command();
+  parse-command-line(p, #["new", "workspace", "--wf", "--wk", "A=B", "lib"]);
+  assert-equal(workspace, p.selected-subcommand);
+  assert-equal(#t, get-option-value(workspace, "wf"));
+  assert-equal("B", get-option-value(workspace, "wk")["A"]);
+  assert-equal("lib", get-option-value(workspace, "name"));
+end test;
+
+define test test-subcommands-too-many-positional-args ()
+  let p = make-multi-level-command();
+  assert-signals(<usage-error>,
+                 parse-command-line(p, #["new", "workspace", "lib1", "lib2"]));
+end test;
+
+define test test-subcommands-missing-required-repeated-option ()
+  // Missing required repeated option.
+  let p = make-multi-level-command();
+  assert-signals(<usage-error>,
+                 parse-command-line(p, #["new", "library", "--lp", "lp-opt"]));
+end test;
+
+define test test-subcommands-multiple-repeated-args ()
+  let (p, _, _, library) = make-multi-level-command();
+  parse-command-line(p, #["new", "library", "--lp", "lp-opt", "a", "b", "c"]);
+  assert-equal(library, p.selected-subcommand);
+  assert-equal("lp-opt", get-option-value(library, "lp"));
+  assert-equal(#["a", "b", "c"], get-option-value(library, "name"));
+end test;
+
+define test test-subcommands-support-help-option ()
+  // There is no explicit condition for help being signaled so verify that it's
+  // a direct instance of <abort-command-error>.
+  let p = make-multi-level-command();
+  block ()
+    parse-command-line(p, #["new", "--help"]);
+    assert-true(#f, "--help signaled an error?");
+  exception (ex :: <abort-command-error>)
+    assert-false(instance?(ex, <usage-error>),
+                 "--help should not signal <usage-error>");
+  end;
+end test;
+
+define test test-subcommands-do-not-support-help-subcommand ()
+  let p = make-multi-level-command();
+  assert-signals(<usage-error>, parse-command-line(p, #["new", "help"]));
+end test;
+
+define test test-subcommands-root-command-supports-help ()
+  let p = make-multi-level-command();
+  assert-no-errors(parse-command-line(p, #["help"]));
+  assert-no-errors(parse-command-line(p, #["help", "new"]));
+  assert-no-errors(parse-command-line(p, #["help", "new", "library"]));
 end test;