deft test: new subcommand

documentation/source/index.rst

@@ -687,6 +687,7 @@ new version of your package (tests pass, doc updated, etc.) follow these steps:
           :file:`dylan-package.json` they will be removed from the catalog
           entry for *all releases* of your package.
 
+
 .. index::
    single: deft status subcommand
    single: subcommand; deft status
@@ -716,6 +717,53 @@ Synopsis: ``deft status``
       pacman-catalog           : ## publish...master [ahead 1] (dirty)
 
 
+.. index::
+   single: deft test subcommand
+   single: subcommand; deft test
+
+deft test
+---------
+
+Run tests for packages in the current workspace.
+
+Synopsis: ``deft test [options] [library ...] [--] [...testworks options...]``
+
+`deft test`_ determines which test binaries to run by choosing the first option below
+that is not empty.
+
+1. Library names that are passed on the command line.
+2. The library specified by ``"default-test-library"`` in the :file:`workspace.json`
+   file.
+3. Any executable test libraries in the workspace's active packages. (This assumes
+   that the executable will include the other test libraries in the package.)
+4. Any non-executable test libraries in the workspace's active packages.
+
+Executable test libraries are invoked directly (it is assumed that they call the
+Testworks `run-test-application`_ function) and non-executable test libraries are run via
+`testworks-run`_.  Any options following ``--`` on the command line are passed to the
+test executable or `testworks-run`_.
+
+If any test run fails `deft test`_ exits immediately with a failure status without
+running the tests in the remaining libraries.
+
+**Options:**
+
+``--build``
+  Rebuild test libraries before running the tests. The default is to rebuild; use
+  ``--no-build`` to disable the build and use the existing test binary.
+
+``--continue``
+  If a test binary fails, continue running the remaining test binaries instead of
+  exiting immediately with a failure status.
+
+``--all``
+  In addition to the active package tests, run tests for all dependencies. *Note
+  that there is no guarantee that the tests for all dependencies will be able to
+  compile without error because they themselves may have dependencies that can't
+  be satisfied. The prime example is if they depend on a different major version
+  of Open Dylan and its bundled libraries.*
+
+
 .. index::
    single: deft update subcommand
    single: deft subcommand; update
@@ -789,3 +837,5 @@ Index and Search
 
 .. _pacman-catalog:    https://github.com/dylan-lang/pacman-catalog.git
 .. _semantic version:  https://semver.org/spec/v2.0.0.html
+.. _run-test-application: https://package.opendylan.org/testworks/reference.html#testworks:testworks:run-test-application
+.. _testworks-run:        https://package.opendylan.org/testworks/reference.html#testworks-run

dylan-package.json

@@ -7,7 +7,7 @@
     "description": "Manage Dylan workspaces, packages, and registries",
     "keywords": ["workspace", "package"],
     "dependencies": [
-        "command-line-parser@3.1.1",
+        "command-line-parser@3.2.2",
         "json@1.1",
         "logging@2.2",
         "regular-expressions@0.2",

sources/commands/build.dylan

@@ -98,9 +98,11 @@ end function;
 define function active-package-libraries
     (ws :: ws/<workspace>) => (libraries :: <seq>)
   collecting ()
-    for (lids in ws/lids-by-active-package(ws))
-      for (lid in lids)
-        collect(ws/library-name(lid));
+    for (lids keyed-by release in ws/lids-by-release(ws))
+      if (ws/active-package?(ws, release.pm/package-name))
+        for (lid in lids)
+          collect(ws/library-name(lid));
+        end;
       end;
     end;
   end

sources/commands/command-line.dylan

@@ -30,8 +30,9 @@ define function deft-command-line
                    subcommands: list($new-application-subcommand,
                                      $new-library-subcommand,
                                      $new-workspace-subcommand)),
-              $update-subcommand,
-              $status-subcommand,
               $publish-subcommand,
+              $status-subcommand,
+              $test-subcommand,
+              $update-subcommand,
               $version-subcommand))
 end function;

sources/commands/test.dylan

@@ -0,0 +1,153 @@
+Module: deft
+Synopsis: test subcommand
+
+// The deft test subcommand builds test libraries and runs the tests.  It uses heuristics
+// on the library name to figure out which libraries are test libraries (see
+// test-library-name?).
+
+// Some workspaces (especially multi-package libraries) may have both test executables
+// (e.g., foo-test-app) and test shared libraries.  In that case we only run the
+// executables, on the assumption that they will take care of running all the tests.
+// Otherwise it could result in running some tests multiple times.
+
+// If any test run fails `deft test` exits immediately with a failure status without
+// running the tests in the remaining libraries.
+
+
+define class <test-subcommand> (<new-subcommand>)
+  keyword name = "test";
+  keyword help = "Run tests for workspace packages.";
+end class;
+
+define constant $test-subcommand
+  = make(<test-subcommand>,
+         options:
+           list(make(<flag-option>,
+                     names: #("all", "a"),
+                     help: "Also run tests for dependencies. [off]"),
+                make(<flag-option>,
+                     names: #("continue", "c"),
+                     help: "Continue running test binaries even after one fails. [off]"),
+                make(<flag-option>,
+                     names: #("build"),
+                     negative-names: #("no-build"),
+                     default: #t,
+                     help: "Rebuild test binaries before running them. [on]"),
+                make(<positional-option>,
+                     names: #("libraries"),
+                     help: "Libraries to test, optionally followed by '--' and Testworks options.",
+                     repeated?: #t,
+                     required?: #f)));
+
+define method execute-subcommand
+    (parser :: <command-line-parser>, subcmd :: <test-subcommand>)
+ => (status :: false-or(<int>))
+  let exit-status = 0;
+  let build? = get-option-value(subcmd, "build");
+  let libraries = get-option-value(subcmd, "libraries") | #();
+  let all? = get-option-value(subcmd, "all") | ~empty?(libraries);
+  local
+    method is-exe-library? (lid)
+      #"executable" == as(<symbol>, ws/lid-value(lid, #"target-type") | "")
+    end,
+    method filter-to-command-line-libraries (lids)
+      choose(method (lid)
+               empty?(libraries)
+                 | member?(ws/library-name(lid), libraries, test: \=)
+             end,
+             lids)
+    end;
+  block (return)
+    let ws = ws/load-workspace();
+    let lid-map = ws/find-active-package-test-libraries(ws, all?);
+    if (lid-map.empty?)
+      warn("No libraries found in workspace? No tests to run.");
+      return(1);
+    end;
+    let exes = #();
+    let dlls = #();
+    let seen-libraries = make(<stretchy-vector>);
+    for (lids keyed-by release in lid-map)
+      let lids = filter-to-command-line-libraries(lids);
+      let _exes = choose(is-exe-library?, lids);
+      if (empty?(_exes))
+        // Only build DLL tests for this package if there are no EXE tests.
+        // Assume the exe tests include the dlls.
+        let _dlls = choose(complement(is-exe-library?), lids);
+        if (_dlls.empty?)
+          warn("No tests found for package %s.", release.pm/package-name);
+        end;
+        dlls := concat(dlls, _dlls);
+      else
+        exes := concat(exes, _exes);
+      end;
+    end for;
+    let ws-dir = ws/workspace-directory(ws);
+    if (build?)
+      do(rcurry(build-library, "executable", ws-dir), exes);
+      ~empty?(dlls) & build-testworks-run(ws-dir);
+      do(rcurry(build-library, "dll", ws-dir), dlls);
+    end;
+    local method run-test (lid :: ws/<lid>, exe?)
+            let library = ws/library-name(lid);
+            let binary = ws/lid-value(lid, #"executable") | library;
+            let build-dir = ws/build-directory(ws);
+            let testworks-options = subcmd.unconsumed-arguments; // args after "--"
+            let command
+              = if (exe?)
+                  let exe-path = as(<string>, file-locator(build-dir, "bin", binary));
+                  if (~fs/file-exists?(exe-path))
+                    note("Building test %s (no binary found)", library);
+                    build-library(lid, "executable", ws-dir);
+                  end;
+                  apply(vector, exe-path, testworks-options)
+                else
+                  let extension = select (os/$os-name)
+                                    #"win32" => ".dll";
+                                    #"darwin" => ".dylib";
+                                    otherwise => ".so";
+                                  end;
+                  let lib-name = concat("lib", binary, extension);
+                  let exe-path = as(<string>, file-locator(build-dir, "bin", "testworks-run"));
+                  apply(vector, exe-path, "--load", lib-name, testworks-options)
+                end;
+            let status = os/run-application(command, under-shell?: #f, working-directory: ws-dir);
+            if (status ~== 0)
+              if (~get-option-value(subcmd, "continue"))
+                return(1);
+              end;
+              exit-status := 1;
+            end;
+          end method;
+    do(rcurry(run-test, #t), exes);
+    do(rcurry(run-test, #f), dlls);
+    if (exes.size + dlls.size < libraries.size)
+      warn("Some tests specified on the command-line were not found.");
+    end;
+  end block;
+  exit-status
+end method execute-subcommand;
+
+define method build-library
+    (lid :: ws/<lid>, target-type :: <string>, dir :: <directory-locator>)
+  build-library(lid.ws/library-name, target-type, dir)
+end method;
+
+define method build-library
+    (library :: <string>, target-type :: <string>, dir :: <directory-locator>)
+  let command = join(list("dylan-compiler", "-build", "-target", target-type, library), " ");
+  let status = os/run-application(command, under-shell?: #t, working-directory: dir);
+  if (status ~== 0)
+    warn("Error building library %s:", library);
+  end;
+end method;
+
+define variable *testworks-run-built?* = #f;
+
+define function build-testworks-run
+    (ws-dir :: <directory-locator>) => ()
+  if (~*testworks-run-built?*)
+    *testworks-run-built?* := #t;
+    build-library("testworks-run", "executable", ws-dir);
+  end;
+end function;

sources/deft.lid

@@ -18,6 +18,7 @@ Files: library.dylan
        commands/new-workspace.dylan
        commands/publish.dylan
        commands/status.dylan
+       commands/test.dylan
        commands/update.dylan
        commands/utils.dylan
        commands/version.dylan

sources/library.dylan

@@ -26,25 +26,25 @@ end library;
 
 // Utilities shared by all Deft modules, and also a set of shared imports.
 define module deft-shared
-  use collectors, export: all;
+  use collectors,          export: all;
   use command-line-parser, export: all;
-  use date, import: { current-date, <duration> }, export: all;
-  use dylan-extensions, import: { address-of }, export: all;
-  use file-source-records, prefix: "sr/", export: all;
-  use file-system, prefix: "fs/", export: all;
-  use format-out, export: all;
-  use format, export: all;
-  use json, export: all;
-  use locators, export: all;
-  use operating-system, prefix: "os/", export: all;
-  use print, export: all;
+  use date,                export: all, import: { current-date, <duration> };
+  use dylan-extensions,    export: all, import: { address-of };
+  use file-source-records, export: all, prefix: "sr/";
+  use file-system,         export: all, prefix: "fs/";
+  use format-out,          export: all;
+  use format,              export: all;
+  use json,                export: all;
+  use locators,            export: all;
+  use operating-system,    export: all, prefix: "os/";
+  use print,               export: all;
   use regular-expressions, export: all;
-  use standard-io, export: all;
-  use streams, export: all;
-  use strings, export: all;
-  use threads, import: { dynamic-bind }, export: all;
-  use uncommon-dylan, export: all;
-  use uncommon-utils, export: all;
+  use standard-io,         export: all;
+  use streams,             export: all;
+  use strings,             export: all;
+  use threads,             export: all, import: { dynamic-bind };
+  use uncommon-dylan,      export: all;
+  use uncommon-utils,      export: all;
 
   export
     *debug?*,
@@ -149,15 +149,20 @@ define module workspaces
     active-package-directory,
     active-package-file,
     active-package?,
+    build-directory,
     current-dylan-package,
     ensure-deps-installed,
+    find-active-package-test-libraries,
     find-dylan-package-file,
     find-workspace-directory,
     find-workspace-file,
     library-name,
-    lids-by-active-package,
+    <lid>,
+    lid-value,
+    lid-values,
     lids-by-library,
     lids-by-pathname,
+    lids-by-release,
     load-workspace,
     registry-directory,
     update-registry,
@@ -171,15 +176,13 @@ define module %workspaces
   use workspaces;
   use pacman,
     prefix: "pm/",
-    // Because / followed by * is seen as a comment by dylan-mode.
+    // Because pm/*... is seen as a /* comment by dylan-mode.
     rename: { *package-manager-directory* => *package-manager-directory* };
 
   // Exports for the test suite.
   export
     $lid-key,
     lid-data,
-    lid-value,
-    lid-values,
     parse-lid-file;
 end module;