diff --git a/documentation/source/index.rst b/documentation/source/index.rst index 6cde1e0..f422db6 100644 --- a/documentation/source/index.rst +++ b/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 diff --git a/dylan-package.json b/dylan-package.json index 1103461..87dd96a 100644 --- a/dylan-package.json +++ b/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", diff --git a/sources/commands/build.dylan b/sources/commands/build.dylan index 11dd87c..67a3568 100644 --- a/sources/commands/build.dylan +++ b/sources/commands/build.dylan @@ -98,9 +98,11 @@ end function; define function active-package-libraries (ws :: ws/) => (libraries :: ) 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 diff --git a/sources/commands/command-line.dylan b/sources/commands/command-line.dylan index c246107..bacbef2 100644 --- a/sources/commands/command-line.dylan +++ b/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; diff --git a/sources/commands/test.dylan b/sources/commands/test.dylan new file mode 100644 index 0000000..b579e1f --- /dev/null +++ b/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 () + keyword name = "test"; + keyword help = "Run tests for workspace packages."; +end class; + +define constant $test-subcommand + = make(, + options: + list(make(, + names: #("all", "a"), + help: "Also run tests for dependencies. [off]"), + make(, + names: #("continue", "c"), + help: "Continue running test binaries even after one fails. [off]"), + make(, + names: #("build"), + negative-names: #("no-build"), + default: #t, + help: "Rebuild test binaries before running them. [on]"), + make(, + names: #("libraries"), + help: "Libraries to test, optionally followed by '--' and Testworks options.", + repeated?: #t, + required?: #f))); + +define method execute-subcommand + (parser :: , subcmd :: ) + => (status :: false-or()) + 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(, 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(); + 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/, 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(, 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(, 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/, target-type :: , dir :: ) + build-library(lid.ws/library-name, target-type, dir) +end method; + +define method build-library + (library :: , target-type :: , dir :: ) + 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 :: ) => () + if (~*testworks-run-built?*) + *testworks-run-built?* := #t; + build-library("testworks-run", "executable", ws-dir); + end; +end function; diff --git a/sources/deft.lid b/sources/deft.lid index 4ff5a84..1b85457 100644 --- a/sources/deft.lid +++ b/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 diff --git a/sources/library.dylan b/sources/library.dylan index 8708df7..44cec21 100644 --- a/sources/library.dylan +++ b/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, }, 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, }; + 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-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; diff --git a/sources/workspaces/lid.dylan b/sources/workspaces/lid.dylan index 019bef1..deb3e29 100644 --- a/sources/workspaces/lid.dylan +++ b/sources/workspaces/lid.dylan @@ -49,8 +49,8 @@ define function lid-value end function; define function library-name - (lid :: ) => (name :: false-or()) - lid-value(lid, $library-key, error?: #f) + (lid :: , #key error? :: ) => (name :: false-or()) + lid-value(lid, $library-key, error?: error?) end function; // Return the transitive (via files included with the "LID" header) contents of @@ -78,21 +78,31 @@ define function dylan-source-files files end function; +define function matches-current-platform? + (lid :: ) => (matches? :: ) + let current-platform = as(, os/$platform-name); + let platform = lid-value(lid, $platforms-key); + // Assume that if the LID is included in another LID then it contains the + // platform-independent attributes of a multi-platform project and is not a top-level + // library. + platform = current-platform + | (~platform & lid.library-name & empty?(lid.lid-included-in)) +end function; + define function add-lid (ws :: , active-package :: false-or(pm/), lid :: ) => () - let library-name = lid-value(lid, $library-key); - if (library-name) - let lids = element(ws.%lids-by-library, library-name, default: #()); - if (member?(lid, lids)) - debug("Re-adding %s, all lids for this library: %=", lid, lids); + if (matches-current-platform?(lid)) + let library = lid-value(lid, $library-key); + if (library) + let lids = element(ws.%lids-by-library, library, default: #()); + ws.%lids-by-library[library] := pair(lid, lids); + end; + ws.%lids-by-pathname[as(, lid.lid-locator)] := lid; + if (active-package) + let lids = element(ws.%lids-by-release, active-package, default: #()); + ws.%lids-by-release[active-package] := pair(lid, lids); end; - ws.%lids-by-library[library-name] := pair(lid, lids); - end; - ws.%lids-by-pathname[as(, lid.lid-locator)] := lid; - if (active-package) - let lids = element(ws.%lids-by-active-package, active-package, default: #()); - ws.%lids-by-active-package[active-package] := pair(lid, lids); end; end function; diff --git a/sources/workspaces/registry.dylan b/sources/workspaces/registry.dylan index bc58aea..d240f38 100644 --- a/sources/workspaces/registry.dylan +++ b/sources/workspaces/registry.dylan @@ -48,18 +48,11 @@ end function; define function update-registry (ws :: , releases :: , actives :: ) => (total :: , written :: , no-platform-libs :: ) - let current-platform = as(, os/$platform-name); let total = 0; let written = 0; let no-platform = make(); for (lids keyed-by library in ws.lids-by-library) - let candidates - = choose(method (lid) - let platform = lid-value(lid, $platforms-key); - platform = current-platform - | (~platform & empty?(lid.lid-included-in)) - end, - lids); + let candidates = choose(matches-current-platform?, lids); select (candidates.size) 0 => // We'll display these at the end, as a group. @@ -71,7 +64,7 @@ define function update-registry otherwise => warn("Library %= has multiple .lid files for platform %=.\n" " %s\nRegistry will point to the first one, arbitrarily.", - library, current-platform, + library, as(, os/$platform-name), join(candidates, "\n ", key: method (lid) as(, lid.lid-locator) end)); diff --git a/sources/workspaces/workspaces.dylan b/sources/workspaces/workspaces.dylan index c46a6ea..6123563 100644 --- a/sources/workspaces/workspaces.dylan +++ b/sources/workspaces/workspaces.dylan @@ -40,22 +40,22 @@ define class () slot workspace-default-library-name :: false-or() = #f; // These three %lids-by-* slots are computed lazily rather than in load-workspace - // because some deft commands don't need them. + // because some deft commands don't need them. They only contain the LIDs that match + // the current platform (see matches-current-platform?). They contain mappings for + // active package releases and dependency releases. // A map from library names to sequences of s that define the library. (A library - // with platform-specific definitions may have multiple lids.) There are mappings here - // for active package libraries and for dependency libraries. + // with platform-specific definitions may have multiple lids.) constant slot %lids-by-library :: = make(); - // A map from full absolute pathname of a LID file to the associated . There are - // mappings here for active package libraries and for dependency libraries. + // A map from full absolute pathname of a LID file to the associated . constant slot %lids-by-pathname :: - //= make(); // works, but not correct - //= iff(os/$os-name == #"win32", make(), make()); // slot is set to #f! - = if (os/$os-name == #"win32") make() else make() end; // works + = make(if (os/$os-name == #"win32") else end); - // A map from active package to a sequence of s it contains. - constant slot %lids-by-active-package ::
= make(
); + // A map from to a sequence of s the release contains. Releases for + // active packages and dependencies are present. Only LIDs matching the current + // platform (based on the usual rules) are included. + constant slot %lids-by-release ::
= make(
); // Prevent infinite recursion when scanning a workspace that has no active packages. slot active-packages-scanned? :: = #f; @@ -77,12 +77,17 @@ define function lids-by-pathname ws.%lids-by-pathname end function; -define function lids-by-active-package +define function lids-by-release (ws :: ) => (t ::
) if (~ws.active-packages-scanned?) scan-workspace(ws) end; - ws.%lids-by-active-package + ws.%lids-by-release +end function; + +define function build-directory + (ws :: ) => (dir :: ) + subdirectory-locator(ws.workspace-directory, "_build") end function; define function registry-directory @@ -121,8 +126,8 @@ end function; // populated and deps can be determined. define function scan-workspace (ws :: ) => () - // First do active packages to populate %lids-by-active-package. - for (package in find-active-packages(ws.workspace-directory)) + // First do active packages to populate %lids-by-release. + for (package in ws.workspace-active-packages) let directory = active-package-directory(ws, package); fs/do-directory(curry(scan-workspace-file, ws, package), directory); end; @@ -174,7 +179,7 @@ define function load-workspace-config local method find-default-library () block (return) let fallback = #f; - for (lids keyed-by package in ws.lids-by-active-package) + for (lids keyed-by package in ws.lids-by-release) for (lid in lids) let name = lid.library-name; fallback := fallback | name; @@ -347,7 +352,7 @@ define function find-active-package-deps // Dev deps could go into deps, above, but they're kept separate so that // pacman can give more specific error messages. let dev-deps = make(); - for (lids keyed-by release in ws.lids-by-active-package) + for (lids keyed-by release in ws.lids-by-release) actives[pm/package-name(release)] := release; for (dep in pm/release-dependencies(release)) add-new!(deps, dep, test: \=) @@ -363,3 +368,31 @@ define function find-active-package-deps let releases-to-install = pm/resolve-deps(cat, deps, dev-deps, actives); values(releases-to-install, actives) end function; + +// Find the names of all test libraries defined in the active packages within a +// workspace. Returns a table mapping active package names to #(lib-name, exe-name, +// target-type). +define function find-active-package-test-libraries + (ws :: , include-deps? :: ) => (t ::
) + let t = make(
); + for (lids keyed-by release in ws.lids-by-release) + let keep = choose(method (lid) + is-test-library?(lid.library-name | "") + & (include-deps? | member?(release, ws.workspace-active-packages)) + end, + lids); + if (~empty?(keep)) + t[release] := keep; + end; + end for; + t +end function; + +define function is-test-library? (name :: ) => (_ :: ) + starts-with?(name, "test-") + | ends-with?(name, "-test") + | ends-with?(name, "-test-app") + | ends-with?(name, "-tests") + | ends-with?(name, "-test-suite") + | ends-with?(name, "-test-suite-app") +end function;