From af7a84076faf97e46debbf739bd5eb6a0ac5672e Mon Sep 17 00:00:00 2001
From: Carl Gay <carlgay@gmail.com>
Date: Mon, 7 Mar 2022 04:59:34 +0000
Subject: [PATCH] Add --match and --skip options

---
 command-line.dylan                       | 30 +++++++++++++++++-------
 library.dylan                            |  2 ++
 run.dylan                                | 26 ++++++++++++++++++--
 tests/testworks-test-suite-library.dylan |  2 ++
 4 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/command-line.dylan b/command-line.dylan
index a746fee..6c48f47 100644
--- a/command-line.dylan
+++ b/command-line.dylan
@@ -72,28 +72,35 @@ define function parse-args
                   help: "Load the given shared library file before searching for"
                     " test suites. May be repeated."));
 
-  // TODO(cgay): Replace these 4 options with --skip and --match (or
-  // --include?).  Because Dylan is a Lisp-1 suites, tests, and
-  // benchmarks share a common namespace and --skip and --match will
-  // be unambiguous.
+  add-option(parser,
+             make(<parameter-option>,
+                  names: "match",
+                  variable: "REGEX",
+                  help: "Run only tests with names that match this regular expression."));
+  add-option(parser,
+             make(<parameter-option>,
+                  names: "skip",
+                  variable: "REGEX",
+                  help: "Skip tests with names that match this regular expression."));
+
   add-option(parser,
              make(<repeated-parameter-option>,
                   names: "suite",
-                  help: "Run (or list) only these named suites. May be repeated."));
+                  help: "DEPRECATED, use --match instead. Run (or list) only these named suites. May be repeated."));
   add-option(parser,
              make(<repeated-parameter-option>,
                   names: "test",
-                  help: "Run (or list) only these named tests. May be repeated."));
+                  help: "DEPRECATED, use --match instead. Run (or list) only these named tests. May be repeated."));
   add-option(parser,
              make(<repeated-parameter-option>,
                   names: "skip-suite",
                   variable: "SUITE",
-                  help: "Skip these named suites. May be repeated."));
+                  help: "DEPRECATED, use --skip instead. Skip these named suites. May be repeated."));
   add-option(parser,
              make(<repeated-parameter-option>,
                   names: "skip-test",
                   variable: "TEST",
-                  help: "Skip these named tests. May be repeated."));
+                  help: "DEPRECATED, use --skip instead. Skip these named tests. May be repeated."));
   add-option(parser,
              make(<choice-option>,
                   names: #("list", "l"),
@@ -154,8 +161,13 @@ define function make-runner-from-command-line
                  end;
   let report = get-option-value(parser, "report");
   let report-function = element($report-functions, report);
+  let match = get-option-value(parser, "match");
+  let skip = get-option-value(parser, "skip");
   let runner = make(<test-runner>,
                     debug: debug,
+                    match-regex: match & compile-regex(match),
+                    skip-regex: skip & compile-regex(skip),
+                    // DEPRECATED
                     skip: concatenate(map(find-component,
                                           get-option-value(parser, "skip-suite")),
                                       map(find-component,
@@ -226,6 +238,8 @@ define function run-test-application
   end;
 end function;
 
+// components is a list of components passed to run-test-application
+// by the user, which is deprecated.
 define function process-command-line
     (parser :: <command-line-parser>, components)
  => (suite :: <component>, runner :: <test-runner>, reporter :: <function>)
diff --git a/library.dylan b/library.dylan
index aaa7417..409be9e 100644
--- a/library.dylan
+++ b/library.dylan
@@ -14,6 +14,7 @@ define library testworks
   use io,
     import: { format, print, standard-io, streams };
   use coloring-stream;
+  use regular-expressions;
   use strings;
   use system,
     import: { date, file-system, locators, operating-system };
@@ -113,6 +114,7 @@ define module %testworks
   use operating-system,
     prefix: "os/";
   use print, import: { print-object };
+  use regular-expressions;
   use simple-random,
     import: { random };
   use standard-io;
diff --git a/run.dylan b/run.dylan
index 9d38b74..aaf71ed 100644
--- a/run.dylan
+++ b/run.dylan
@@ -137,6 +137,11 @@ define open class <test-runner> (<object>)
     init-keyword: progress:;
   constant slot runner-debug :: <debug-option> = $debug-none,
     init-keyword: debug:;
+  constant slot runner-match-regex :: false-or(<regex>) = #f,
+    init-keyword: match-regex:;
+  constant slot runner-skip-regex :: false-or(<regex>) = #f,
+    init-keyword: skip-regex:;
+  // DEPRECATED.  Use --match and --skip instead.
   constant slot runner-skip :: <sequence> = #[],   // of components
     init-keyword: skip:;
   constant slot runner-order :: <order> = $default-order,
@@ -178,11 +183,28 @@ define open generic execute-component?
     (component :: <component>, runner :: <test-runner>)
  => (execute? :: <boolean>);
 
+// Suites are always executed because otherwise we will not descend into them
+// to decide whether to run their tests.
+define method execute-component?
+    (component :: <suite>, runner :: <test-runner>)
+ => (execute? :: <boolean>)
+  #t
+end method;
+
 define method execute-component?
     (component :: <component>, runner :: <test-runner>)
  => (execute? :: <boolean>)
-  ~member?(component, runner.runner-skip) & tags-match?(runner.runner-tags, component)
-end;
+  ~member?(component, runner.runner-skip) // deprecated
+    & tags-match?(runner.runner-tags, component)
+    & begin
+        let name = component.component-name;
+        let match-regex = runner-match-regex(runner);
+        let skip-regex = runner-skip-regex(runner);
+        let matches? = ~match-regex | regex-search(match-regex, name);
+        let skip? = skip-regex & regex-search(skip-regex, name);
+        matches? & ~skip?
+      end
+end method;
 
 define method maybe-execute-component
     (component :: <component>, runner :: <test-runner>)
diff --git a/tests/testworks-test-suite-library.dylan b/tests/testworks-test-suite-library.dylan
index 10c1da9..a1a6b98 100644
--- a/tests/testworks-test-suite-library.dylan
+++ b/tests/testworks-test-suite-library.dylan
@@ -13,6 +13,7 @@ define library testworks-test-suite
   use common-dylan;
   use io,
     import: { format, streams };
+  use regular-expressions;
   use strings;
   use system,
     import: { file-system, locators };
@@ -28,6 +29,7 @@ define module testworks-test-suite
     prefix: "fs/";
   use format;
   use locators;
+  use regular-expressions;
   use streams;
   use strings;
   use table-extensions,