From c53e87f700c2fdfc20187ca894cc77745da4d5c9 Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Tue, 30 Sep 2025 19:03:00 -0400 Subject: [PATCH] Auto-register components in their `make` methods So that user code doesn't have to remember to do it. This also means one less export as I work on (the remainder of #118). Fixes #118 --- components.dylan | 32 +++-- documentation/source/reference.rst | 11 +- library.dylan | 2 +- tests/testworks-test-suite.dylan | 209 ++++++++++++++--------------- 4 files changed, 120 insertions(+), 134 deletions(-) diff --git a/components.dylan b/components.dylan index 009d0e9..8559aae 100644 --- a/components.dylan +++ b/components.dylan @@ -34,8 +34,15 @@ define class () init-keyword: cleanup-function:; end class ; -define method make (class == , #rest args, #key) => (suite :: ) +define method make + (class == , #rest args, #key register? = #t) => (suite :: ) let suite = next-method(); + for (comp in suite.suite-components) + comp.component-parent := suite; + end; + when (register?) + register-component(suite); + end; check-for-tests-included-multiple-times(suite); suite end; @@ -98,7 +105,7 @@ define abstract class () end class ; define method make - (class :: subclass(), #rest args, #key name, tags) + (class :: subclass(), #rest args, #key name, tags, register? = #t) => (runnable :: ) let tags = map(make-tag, tags | #[]); let negative = choose(tag-negated?, tags); @@ -106,7 +113,11 @@ define method make error("tags associated with tests or benchmarks may not be negated." " test = %s, tags = %s", name, negative); end; - apply(next-method, class, tags: tags, args) + let runnable = apply(next-method, class, tags: tags, args); + when (register?) + register-component(runnable); + end; + runnable end method; define method expected-to-fail? (runnable :: ) @@ -182,18 +193,11 @@ end; /// Suites +// DEPRECATED: use make() directly define method make-suite (name :: , components, #rest keyword-args) => (suite :: ) - let suite = apply(make, , - name: name, - components: components, - keyword-args); - for (comp in components) - comp.component-parent := suite; - end; - register-component(suite); - suite + apply(make, , name: name, components: components, keyword-args) end method make-suite; define macro suite-definer @@ -220,7 +224,7 @@ define macro test-definer name: ?"test-name", function: "%%" ## ?test-name, ?keyword-args); - register-component(?test-name); + ignorable(?test-name); } end macro test-definer; @@ -233,7 +237,7 @@ define macro benchmark-definer name: ?"test-name", function: "%%" ## ?test-name, ?keyword-args); - register-component(?test-name); + ignorable(?test-name); } end macro benchmark-definer; diff --git a/documentation/source/reference.rst b/documentation/source/reference.rst index df47469..31b2b5d 100644 --- a/documentation/source/reference.rst +++ b/documentation/source/reference.rst @@ -837,8 +837,7 @@ This section describes the APIs necessary for creating a test suite programmatically. This is sometimes useful if, for example, tests can be generated from available data or are more easily described in a format like JSON. -Create and :func:`register ` your test components and then call -:func:`run-test-application` as usual. +Create your test components and then call :func:`run-test-application` as usual. .. class:: :sealed: @@ -933,11 +932,3 @@ Create and :func:`register ` your test components and then c See :macro:`suite-definer` for details. See :class:`` for additional init keywords. - -.. function:: register-component - - Register a component (a test, benchmark, or suite) with Testworks so that it will be - found and executed during a test run. All components should be registered. - - :signature: register-component ( *component* ) - :parameter component: An instance of :class:``. diff --git a/library.dylan b/library.dylan index a10bc70..1d86ce7 100644 --- a/library.dylan +++ b/library.dylan @@ -109,7 +109,7 @@ define module testworks , , , - register-component; + register-component; // DEPRECATED: no longer required end module testworks; diff --git a/tests/testworks-test-suite.dylan b/tests/testworks-test-suite.dylan index fc48922..417c87d 100644 --- a/tests/testworks-test-suite.dylan +++ b/tests/testworks-test-suite.dylan @@ -8,6 +8,13 @@ Warranty: Distributed WITHOUT WARRANTY OF ANY KIND /// Some utilities for testing TestWorks +// Make tests with this so that register?: #f is provided. make-suite is already +// exported from %testworks so there is no equivalent for making suites; just remember to +// pass register?: #f to make() or make-suite. +define function make-test (name, function, #rest args) + apply(make, , name: name, function: function, register?: #f, args) +end function; + define function run-component (comp, #key components) if (~components) components := make(); @@ -23,9 +30,7 @@ end function; // return the assertion's result: $passed, $failed, etc. define function do-with-result (thunk :: ) => (status :: ) - let test = make(, - name: "anonymous", - function: thunk); + let test = make-test("anonymous", thunk); let result = run-component(test); let subresults = result.result-subresults; assert-equal(1, subresults.size, @@ -482,11 +487,11 @@ end test test-run-tests/suite; define test test-run-tests/suite-setup-failure () let suite = make-suite("setup-failure-suite", - vector(make(, - name: "setup-failure-passing-test", - function: method () assert-true(#t) end)), + vector(make-test("setup-failure-passing-test", + method () assert-true(#t) end)), setup-function: - curry(error, "error in setup-failure-suite setup function")); + curry(error, "error in setup-failure-suite setup function"), + register?: #f); let suite-result = run-component(suite); assert-equal($crashed, suite-result.result-status, "run-tests returns $crashed when suite setup fails"); @@ -501,11 +506,11 @@ define test test-run-tests/suite-cleanup-failure () = make(, name: "cleanup-failure-suite", components: - vector(make(, - name: "cleanup-failure-passing-test", - function: method () assert-true(#t) end)), + vector(make-test("cleanup-failure-passing-test", + method () assert-true(#t) end)), cleanup-function: - curry(error, "error in cleanup-failure-suite cleanup function")); + curry(error, "error in cleanup-failure-suite cleanup function"), + register?: #f); let suite-result = run-component(suite); assert-equal($crashed, suite-result.result-status, "run-tests returns $crashed when suite cleanup fails"); @@ -526,22 +531,20 @@ define test test-suite-setup-for-specified-test () let top = make-suite("top", list(make-suite("middle1", - list(make(, - name: "test1", - function: method () assert-true(#t) end), - make(, - name: "test2", - function: curry(error, "test2 error"))), + list(make-test("test1", + method () assert-true(#t) end), + make-test("test2", + curry(error, "test2 error"))), setup-function: method () middle1-setup? := #t end, cleanup-function: method () middle1-cleanup? := #t end), make-suite("middle2", - list(make(, - name: "test3", - function: method () assert-true(#t) end)), + list(make-test("test3", + method () assert-true(#t) end)), setup-function: method () middle2-setup? := #t end, cleanup-function: method () middle2-cleanup? := #t end)), setup-function: method () top-setup? := #t end, - cleanup-function: method () top-cleanup? := #t end); + cleanup-function: method () top-cleanup? := #t end, + register?: #f); let result = run-component(top, components: compute-components(top, #[], #["test2"], #[])); expect(top-setup?); expect(top-cleanup?); @@ -556,45 +559,43 @@ end test; // then run as normal tests (which would fail). define constant test-expected-to-fail-always - = make(, - name: "test-expected-to-fail-always", - function: method () assert-true(#f) end, - // Intentionally not passing `expected-to-fail-test:` here. The test - // should be expected to fail because a reason is provided. - expected-to-fail-reason: "because of assert-true(#f)"); + = make-test("test-expected-to-fail-always", + method () assert-true(#f) end, + // Intentionally not passing `expected-to-fail-test:` here. The test + // should be expected to fail because a reason is provided. + expected-to-fail-reason: "because of assert-true(#f)"); define constant test-expected-to-fail-maybe - = make(, - name: "test-expected-to-fail-maybe", - function: method () assert-true(#f) end, - expected-to-fail-test: method () #t end, - expected-to-fail-reason: "because of assert-true(#f)"); + = make-test("test-expected-to-fail-maybe", + method () assert-true(#f) end, + expected-to-fail-test: method () #t end, + expected-to-fail-reason: "because of assert-true(#f)"); define constant test-expected-to-crash-always - = make(, - name: "test-expected-to-crash-always", - function: curry(error, "test-expected-to-crash-always"), - expected-to-fail-test: method () #t end, - expected-to-fail-reason: "because of error(...)"); + = make-test("test-expected-to-crash-always", + curry(error, "test-expected-to-crash-always"), + expected-to-fail-test: method () #t end, + expected-to-fail-reason: "because of error(...)"); define constant expected-to-fail-suite = make(, name: "expected-to-fail-suite", components: vector(test-expected-to-fail-always, test-expected-to-fail-maybe, - test-expected-to-crash-always)); + test-expected-to-crash-always), + register?: #f); define constant test-unexpected-success - = make(, - name: "test-unexpected-success", - function: method () assert-true(#t) end, - expected-to-fail-test: always(#t), - expected-to-fail-reason: "because of assert-true(#t)"); + = make-test("test-unexpected-success", + method () assert-true(#t) end, + expected-to-fail-test: always(#t), + expected-to-fail-reason: "because of assert-true(#t)"); define constant unexpected-success-suite = make(, name: "unexpected-success-suite", - components: vector(test-unexpected-success)); + components: vector(test-unexpected-success), + register?: #f); define test test-run-tests-expect-failure/suite () assert-true(result-passing?(run-component(expected-to-fail-suite)), @@ -688,28 +689,25 @@ define test test-tags-match? () for (input in inputs) let (match-expected?, input-strings) = apply(values, input); let requested-tags = parse-tags(input-strings); - let test = make(, - tags: test-tags, - name: "test", - function: method () end); + let test = make-test("test", method () end, tags: test-tags); assert-equal(match-expected?, tags-match?(requested-tags, test), format-to-string("Requested tags: %=", requested-tags)); end; assert-true(tags-match?(parse-tags(#("-verbose")), - make(, tags: #(), name: "test", function: method() end)), + make-test("test", method() end, tags: #())), "Negative tags match tests with no tags."); assert-false(tags-match?(parse-tags(#("verbose")), - make(, tags: #(), name: "test", function: method() end)), + make-test("test", method() end, tags: #())), "Positive tags do not match tests with no tags."); end test test-tags-match?; // Negated tags shouldn't be allowed in test definitions. define test test-negative-tags-on-tests () - assert-signals(, make(, name: "t", tags: #("-foo"), function: method() end)); + assert-signals(, make-test("t", method() end, tags: #("-foo"))); end; define test test-make-test-converts-strings-to-tags () - let test = make(, name: "t", tags: #("foo"), function: method() end); + let test = make-test("t", method() end, tags: #("foo")); assert-true(every?(rcurry(instance?, ), test.test-tags)); end; @@ -752,8 +750,8 @@ end test; define test test-register-component--duplicate-test-name-causes-error () let n = size($components); + // Exlicitly using make() instead of make-test, so test is registered. let test = make(, name: "t", function: method() end); - assert-no-errors(register-component(test)); assert-equal(size($components), n + 1); assert-signals(, register-component(test)); assert-equal(size($components), n + 1); // no change @@ -762,60 +760,59 @@ define test test-register-component--duplicate-test-name-causes-error () end; define test test-that-not-implemented-is-not-a-failure () - let test = make(, - name: "not-implemented-test", - function: method () end); + let test = make-test("not-implemented-test", + method () end); let suite = make(, name: "not-implemented-suite", - components: vector(test)); + components: vector(test), + register?: #f); let result = run-component(suite); assert-equal($not-implemented, result.result-status); end; define test test-that-not-implemented-plus-passed-is-passed () - let test1 = make(, - name: "not-implemented", - function: method () end); - let test2 = make(, - name: "passed", - function: method () assert-true(#t); end); + let test1 = make-test("not-implemented", + method () end); + let test2 = make-test("passed", + method () assert-true(#t); end); let suite = make(, name: "not-implemented-suite", - components: vector(test1, test2)); + components: vector(test1, test2), + register?: #f); let result = run-component(suite); assert-equal($passed, result.result-status); end; define test test-included-in-suite-multiple-times () - let test1 = make(, - name: "tarantella", - function: always("tarantella")); - let test2 = make(, - name: "bach cello suites", - function: always("bach cello suites")); + let test1 = make-test("tarantella", + always("tarantella")); + let test2 = make-test("bach cello suites", + always("bach cello suites")); let benchmark1 = make(, name: "initials", function: always("initials")); assert-no-errors(make(, name: "suite 1", - components: list(test1, test2, benchmark1))); + components: list(test1, test2, benchmark1), + register?: #f)); // TODO(cgay): signal throughout testworks code assert-signals(, make(, name: "suite 2", - components: list(test1, test1))); + components: list(test1, test1), + register?: #f)); assert-signals(, make(, name: "suite 3", components: list(test1, make(, name: "suite 4", - components: list(test1))))); + components: list(test1))), + register?: #f)); end test; define function check-description (test-function, want-string) - let test = make(, - name: "no name", - function: test-function); + let test = make-test("no name", + test-function); let result = run-component(test); let report = with-output-to-string (stream) print-full-report(result, stream) @@ -965,14 +962,12 @@ end test; define test test-component-test/suite () let suite = make-suite("ct-suite", - list(make(, - name: "ct-test", - function: method () - expect(#t); - end)), + list(make-test("ct-test", + method () expect(#t); end)), when: method () values(#f, "reason") - end); + end, + register?: #f); let result = run-component(suite); assert-equal($skipped, result.result-status); assert-equal("reason", result.result-reason); @@ -988,19 +983,18 @@ end test; define test test-component-test/test () let suite = make-suite("ct-suite2", - list(make(, - name: "ct-test2", - function: method () - expect(#t); - end, - when: method () - values(#f, "reason") - end), - make(, - name: "ct-test3", - function: method () - expect(#t); - end))); + list(make-test("ct-test2", + method () + expect(#t); + end, + when: method () + values(#f, "reason") + end), + make-test("ct-test3", + method () + expect(#t); + end)), + register?: #f); let result = run-component(suite); assert-equal($passed, result.result-status); assert-false(result.result-reason); @@ -1074,9 +1068,8 @@ end test; define test test-debug-option--crashes () let crashing-test - = make(, - name: "test-debug-option-1", - function: curry(error, "error in test-debug-option-1")); + = make-test("test-debug-option-1", + curry(error, "error in test-debug-option-1")); let result-1 = #f; let runner-1 = make(, components: list(crashing-test), @@ -1098,11 +1091,10 @@ end test; define test test-debug-option--failures () let failing-test - = make(, - name: "test-debug-option-2", - function: method () - assert-true(#f, "failed assertion in test-debug-option-2"); - end); + = make-test("test-debug-option-2", + method () + assert-true(#f, "failed assertion in test-debug-option-2"); + end); let result-1 = #f; let runner-1 = make(, components: list(failing-test), @@ -1128,12 +1120,11 @@ end test; define test test-bug-183 () let it = #f; let failing-test - = make(, - name: "test-bug-183", - function: method () - assert-true(#f); - it := #t; - end); + = make-test("test-bug-183", + method () + assert-true(#f); + it := #t; + end); let runner = make(, components: list(failing-test), progress: $progress-none,