diff --git a/core/bootstrap/image/image-tests.factor b/core/bootstrap/image/image-tests.factor index ea533f0d6f..8c618a8f30 100755 --- a/core/bootstrap/image/image-tests.factor +++ b/core/bootstrap/image/image-tests.factor @@ -1,6 +1,5 @@ IN: temporary -USING: bootstrap.image bootstrap.image.private -tools.test.inference ; +USING: bootstrap.image bootstrap.image.private tools.test ; \ ' must-infer \ write-image must-infer diff --git a/core/compiler/test/alien.factor b/core/compiler/test/alien.factor index dbdbbfc9fa..4adb1c234b 100755 --- a/core/compiler/test/alien.factor +++ b/core/compiler/test/alien.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types alien.syntax compiler kernel namespaces namespaces tools.test sequences inference words arrays parser quotations continuations inference.backend effects namespaces.private io io.streams.string memory system threads -tools.test.inference ; +tools.test ; FUNCTION: void ffi_test_0 ; [ ] [ ffi_test_0 ] unit-test @@ -80,7 +80,7 @@ FUNCTION: tiny ffi_test_17 int x ; : indirect-test-1 "int" { } "cdecl" alien-indirect ; -{ 1 1 } [ indirect-test-1 ] unit-test-effect +{ 1 1 } [ indirect-test-1 ] must-infer-as [ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test @@ -89,7 +89,7 @@ FUNCTION: tiny ffi_test_17 int x ; : indirect-test-2 "int" { "int" "int" } "cdecl" alien-indirect data-gc ; -{ 3 1 } [ indirect-test-2 ] unit-test-effect +{ 3 1 } [ indirect-test-2 ] must-infer-as [ 5 ] [ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor index ab472668c3..9eaf2d1263 100755 --- a/core/compiler/test/redefine.factor +++ b/core/compiler/test/redefine.factor @@ -1,6 +1,6 @@ USING: compiler definitions generic assocs inference math namespaces parser tools.test words kernel sequences arrays io -effects tools.test.inference compiler.units inference.state ; +effects tools.test compiler.units inference.state ; IN: temporary DEFER: x-1 @@ -28,13 +28,13 @@ DEFER: c [ 1 2 1 2 ] [ "USE: temporary b" eval ] unit-test -{ 0 4 } [ b ] unit-test-effect +{ 0 4 } [ b ] must-infer-as [ ] [ "IN: temporary : a 1 2 3 ;" eval ] unit-test [ 1 2 3 1 2 3 ] [ "USE: temporary b" eval ] unit-test -{ 0 6 } [ b ] unit-test-effect +{ 0 6 } [ b ] must-infer-as \ b word-xt "b-xt" set @@ -52,7 +52,7 @@ DEFER: c [ ] [ "IN: temporary : a 1 2 ;" eval ] unit-test -{ 0 4 } [ c ] unit-test-effect +{ 0 4 } [ c ] must-infer-as [ f ] [ "c-xt" get \ c word-xt = ] unit-test diff --git a/core/inference/inference-docs.factor b/core/inference/inference-docs.factor index 5f7e926b6a..68e5920a3d 100755 --- a/core/inference/inference-docs.factor +++ b/core/inference/inference-docs.factor @@ -73,6 +73,12 @@ $nl { $subsection infer-quot-value } "The " { $vocab-link "macros" } " vocabulary defines some nice syntax sugar which makes compiler transforms easier to work with." ; +ARTICLE: "dataflow-graphs" "Inspecting the dataflow graph" +"The dataflow graph used by " { $link "compiler" } " can be obtained:" +{ $subsection dataflow } +"The " { $vocab-link "optimizer.debugger" } " tool prints the dataflow graph in human readable form." +$nl ; + ARTICLE: "inference" "Stack effect inference" "The stack effect inference tool is used to check correctness of code before it is run. It is also used by the compiler to build a dataflow graph on which optimizations can be performed. Only words for which a stack effect can be inferred will compile." $nl @@ -80,14 +86,15 @@ $nl { $subsection infer. } "Instead of printing the inferred information, it can be returned as objects on the stack:" { $subsection infer } -"The dataflow graph used by " { $link "compiler" } " can be obtained:" -{ $subsection dataflow } +"Static stack effect inference can be combined with unit tests; see " { $link "tools.test.write" } "." +$nl "The following articles describe the implementation of the stack effect inference algorithm:" { $subsection "inference-simple" } { $subsection "inference-combinators" } { $subsection "inference-branches" } { $subsection "inference-recursive" } { $subsection "inference-limitations" } +{ $subsection "dataflow-graphs" } { $subsection "compiler-transforms" } ; ABOUT: "inference" diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index b43226166a..c5bc3b5fda 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -4,23 +4,22 @@ math.parser math.private namespaces namespaces.private parser sequences strings vectors words quotations effects tools.test continuations generic.standard sorting assocs definitions prettyprint io inspector tuples classes.union classes.predicate -debugger threads.private io.streams.string combinators.private -tools.test.inference ; +debugger threads.private io.streams.string combinators.private ; IN: temporary -{ 0 2 } [ 2 "Hello" ] unit-test-effect -{ 1 2 } [ dup ] unit-test-effect +{ 0 2 } [ 2 "Hello" ] must-infer-as +{ 1 2 } [ dup ] must-infer-as -{ 1 2 } [ [ dup ] call ] unit-test-effect +{ 1 2 } [ [ dup ] call ] must-infer-as [ [ call ] infer ] must-fail -{ 2 4 } [ 2dup ] unit-test-effect +{ 2 4 } [ 2dup ] must-infer-as -{ 1 0 } [ [ ] [ ] if ] unit-test-effect +{ 1 0 } [ [ ] [ ] if ] must-infer-as [ [ if ] infer ] must-fail [ [ [ ] if ] infer ] must-fail [ [ [ 2 ] [ ] if ] infer ] must-fail -{ 4 3 } [ [ rot ] [ -rot ] if ] unit-test-effect +{ 4 3 } [ [ rot ] [ -rot ] if ] must-infer-as { 4 3 } [ [ @@ -28,17 +27,17 @@ IN: temporary ] [ -rot ] if -] unit-test-effect +] must-infer-as -{ 1 1 } [ dup [ ] when ] unit-test-effect -{ 1 1 } [ dup [ dup fixnum* ] when ] unit-test-effect -{ 2 1 } [ [ dup fixnum* ] when ] unit-test-effect +{ 1 1 } [ dup [ ] when ] must-infer-as +{ 1 1 } [ dup [ dup fixnum* ] when ] must-infer-as +{ 2 1 } [ [ dup fixnum* ] when ] must-infer-as -{ 1 0 } [ [ drop ] when* ] unit-test-effect -{ 1 1 } [ [ { { [ ] } } ] unless* ] unit-test-effect +{ 1 0 } [ [ drop ] when* ] must-infer-as +{ 1 1 } [ [ { { [ ] } } ] unless* ] must-infer-as { 0 1 } -[ [ 2 2 fixnum+ ] dup [ ] when call ] unit-test-effect +[ [ 2 2 fixnum+ ] dup [ ] when call ] must-infer-as [ [ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer @@ -50,7 +49,7 @@ IN: temporary : termination-test-2 [ termination-test-1 ] [ 3 ] if ; -{ 1 1 } [ termination-test-2 ] unit-test-effect +{ 1 1 } [ termination-test-2 ] must-infer-as : infinite-loop infinite-loop ; @@ -62,12 +61,12 @@ IN: temporary : simple-recursion-1 ( obj -- obj ) dup [ simple-recursion-1 ] [ ] if ; -{ 1 1 } [ simple-recursion-1 ] unit-test-effect +{ 1 1 } [ simple-recursion-1 ] must-infer-as : simple-recursion-2 ( obj -- obj ) dup [ ] [ simple-recursion-2 ] if ; -{ 1 1 } [ simple-recursion-2 ] unit-test-effect +{ 1 1 } [ simple-recursion-2 ] must-infer-as : bad-recursion-2 ( obj -- obj ) dup [ dup first swap second bad-recursion-2 ] [ ] if ; @@ -77,10 +76,10 @@ IN: temporary : funny-recursion ( obj -- obj ) dup [ funny-recursion 1 ] [ 2 ] if drop ; -{ 1 1 } [ funny-recursion ] unit-test-effect +{ 1 1 } [ funny-recursion ] must-infer-as ! Simple combinators -{ 1 2 } [ [ first ] keep second ] unit-test-effect +{ 1 2 } [ [ first ] keep second ] must-infer-as ! Mutual recursion DEFER: foe @@ -103,8 +102,8 @@ DEFER: foe 2drop f ] if ; -{ 2 1 } [ fie ] unit-test-effect -{ 2 1 } [ foe ] unit-test-effect +{ 2 1 } [ fie ] must-infer-as +{ 2 1 } [ foe ] must-infer-as : nested-when ( -- ) t [ @@ -113,7 +112,7 @@ DEFER: foe ] when ] when ; -{ 0 0 } [ nested-when ] unit-test-effect +{ 0 0 } [ nested-when ] must-infer-as : nested-when* ( obj -- ) [ @@ -122,11 +121,11 @@ DEFER: foe ] when* ] when* ; -{ 1 0 } [ nested-when* ] unit-test-effect +{ 1 0 } [ nested-when* ] must-infer-as SYMBOL: sym-test -{ 0 1 } [ sym-test ] unit-test-effect +{ 0 1 } [ sym-test ] must-infer-as : terminator-branch dup [ @@ -135,7 +134,7 @@ SYMBOL: sym-test "foo" throw ] if ; -{ 1 1 } [ terminator-branch ] unit-test-effect +{ 1 1 } [ terminator-branch ] must-infer-as : recursive-terminator ( obj -- ) dup [ @@ -144,7 +143,7 @@ SYMBOL: sym-test "Hi" throw ] if ; -{ 1 0 } [ recursive-terminator ] unit-test-effect +{ 1 0 } [ recursive-terminator ] must-infer-as GENERIC: potential-hang ( obj -- obj ) M: fixnum potential-hang dup [ potential-hang ] when ; @@ -157,24 +156,24 @@ M: funny-cons iterate funny-cons-cdr iterate ; M: f iterate drop ; M: real iterate drop ; -{ 1 0 } [ iterate ] unit-test-effect +{ 1 0 } [ iterate ] must-infer-as ! Regression : cat ( obj -- * ) dup [ throw ] [ throw ] if ; : dog ( a b c -- ) dup [ cat ] [ 3drop ] if ; -{ 3 0 } [ dog ] unit-test-effect +{ 3 0 } [ dog ] must-infer-as ! Regression DEFER: monkey : friend ( a b c -- ) dup [ friend ] [ monkey ] if ; : monkey ( a b c -- ) dup [ 3drop ] [ friend ] if ; -{ 3 0 } [ friend ] unit-test-effect +{ 3 0 } [ friend ] must-infer-as ! Regression -- same as above but we infer the second word first DEFER: blah2 : blah ( a b c -- ) dup [ blah ] [ blah2 ] if ; : blah2 ( a b c -- ) dup [ blah ] [ 3drop ] if ; -{ 3 0 } [ blah2 ] unit-test-effect +{ 3 0 } [ blah2 ] must-infer-as ! Regression DEFER: blah4 @@ -182,7 +181,7 @@ DEFER: blah4 dup [ blah3 ] [ dup [ blah4 ] [ blah3 ] if ] if ; : blah4 ( a b c -- ) dup [ blah4 ] [ dup [ 3drop ] [ blah3 ] if ] if ; -{ 3 0 } [ blah4 ] unit-test-effect +{ 3 0 } [ blah4 ] must-infer-as ! Regression : bad-combinator ( obj quot -- ) @@ -199,7 +198,7 @@ DEFER: blah4 dup string? [ 2array throw ] unless over string? [ 2array throw ] unless ; -{ 2 2 } [ bad-input# ] unit-test-effect +{ 2 2 } [ bad-input# ] must-infer-as ! Regression @@ -218,7 +217,7 @@ DEFER: do-crap* ! Regression : too-deep ( a b -- c ) dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline -{ 2 1 } [ too-deep ] unit-test-effect +{ 2 1 } [ too-deep ] must-infer-as ! Error reporting is wrong MATH: xyz @@ -258,17 +257,17 @@ DEFER: C [ dup B C ] } dispatch ; -{ 1 0 } [ A ] unit-test-effect -{ 1 0 } [ B ] unit-test-effect -{ 1 0 } [ C ] unit-test-effect +{ 1 0 } [ A ] must-infer-as +{ 1 0 } [ B ] must-infer-as +{ 1 0 } [ C ] must-infer-as ! I found this bug by thinking hard about the previous one DEFER: Y : X ( a b -- c d ) dup [ swap Y ] [ ] if ; : Y ( a b -- c d ) X ; -{ 2 2 } [ X ] unit-test-effect -{ 2 2 } [ Y ] unit-test-effect +{ 2 2 } [ X ] must-infer-as +{ 2 2 } [ Y ] must-infer-as ! This one comes from UI code DEFER: #1 @@ -332,9 +331,9 @@ DEFER: bar [ [ get-slots ] infer ] [ inference-error? ] must-fail-with ! Test some curry stuff -{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] unit-test-effect +{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as -{ 2 1 } [ [ ] curry 4 [ ] curry if ] unit-test-effect +{ 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as [ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail @@ -381,7 +380,7 @@ DEFER: bar \ assoc-like must-infer \ assoc-clone-like must-infer \ >alist must-infer -{ 1 3 } [ [ 2drop f ] assoc-find ] unit-test-effect +{ 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as ! Test some random library words \ 1quotation must-infer @@ -404,10 +403,10 @@ DEFER: bar \ define-predicate-class must-infer ! Test words with continuations -{ 0 0 } [ [ drop ] callcc0 ] unit-test-effect -{ 0 1 } [ [ 4 swap continue-with ] callcc1 ] unit-test-effect -{ 2 1 } [ [ + ] [ ] [ ] cleanup ] unit-test-effect -{ 2 1 } [ [ + ] [ 3drop 0 ] recover ] unit-test-effect +{ 0 0 } [ [ drop ] callcc0 ] must-infer-as +{ 0 1 } [ [ 4 swap continue-with ] callcc1 ] must-infer-as +{ 2 1 } [ [ + ] [ ] [ ] cleanup ] must-infer-as +{ 2 1 } [ [ + ] [ 3drop 0 ] recover ] must-infer-as \ dispose must-infer @@ -450,13 +449,13 @@ DEFER: bar [ [ barxxx ] infer ] must-fail ! A typo -{ 1 0 } [ { [ ] } dispatch ] unit-test-effect +{ 1 0 } [ { [ ] } dispatch ] must-infer-as DEFER: inline-recursive-2 : inline-recursive-1 ( -- ) inline-recursive-2 ; : inline-recursive-2 ( -- ) inline-recursive-1 ; -{ 0 0 } [ inline-recursive-1 ] unit-test-effect +{ 0 0 } [ inline-recursive-1 ] must-infer-as ! Hooks SYMBOL: my-var @@ -465,22 +464,22 @@ HOOK: my-hook my-var ( -- x ) M: integer my-hook "an integer" ; M: string my-hook "a string" ; -{ 0 1 } [ my-hook ] unit-test-effect +{ 0 1 } [ my-hook ] must-infer-as DEFER: deferred-word : calls-deferred-word [ deferred-word ] [ 3 ] if ; -{ 1 1 } [ calls-deferred-word ] unit-test-effect +{ 1 1 } [ calls-deferred-word ] must-infer-as USE: inference.dataflow -{ 1 0 } [ [ iterate-next ] iterate-nodes ] unit-test-effect +{ 1 0 } [ [ iterate-next ] iterate-nodes ] must-infer-as { 1 0 } [ [ [ iterate-next ] iterate-nodes ] with-node-iterator -] unit-test-effect +] must-infer-as : nilpotent ( quot -- ) t [ [ call ] keep nilpotent ] [ drop ] if ; inline @@ -490,11 +489,11 @@ USE: inference.dataflow { 0 1 } [ [ ] [ call ] keep [ [ call ] keep ] nilpotent ] -unit-test-effect +must-infer-as -{ 0 0 } [ [ ] semisimple ] unit-test-effect +{ 0 0 } [ [ ] semisimple ] must-infer-as -{ 1 0 } [ [ drop ] each-node ] unit-test-effect +{ 1 0 } [ [ drop ] each-node ] must-infer-as DEFER: an-inline-word @@ -510,9 +509,9 @@ DEFER: an-inline-word : an-inline-word ( obj quot -- ) >r normal-word r> call ; inline -{ 1 1 } [ [ 3 * ] an-inline-word ] unit-test-effect +{ 1 1 } [ [ 3 * ] an-inline-word ] must-infer-as -{ 0 1 } [ [ 2 ] [ 2 ] [ + ] compose compose call ] unit-test-effect +{ 0 1 } [ [ 2 ] [ 2 ] [ + ] compose compose call ] must-infer-as TUPLE: custom-error ; @@ -536,4 +535,4 @@ TUPLE: custom-error ; ! This was a false trigger of the undecidable quotation ! recursion bug -{ 2 1 } [ find-last-sep ] unit-test-effect +{ 2 1 } [ find-last-sep ] must-infer-as diff --git a/core/inference/transforms/transforms-tests.factor b/core/inference/transforms/transforms-tests.factor index f58e557b10..0e5c3e231e 100755 --- a/core/inference/transforms/transforms-tests.factor +++ b/core/inference/transforms/transforms-tests.factor @@ -1,6 +1,6 @@ IN: temporary USING: sequences inference.transforms tools.test math kernel -quotations tools.test.inference inference ; +quotations inference ; : compose-n-quot >quotation ; : compose-n compose-n-quot call ; diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 20f52b2ea3..24d70a86c6 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -1,5 +1,5 @@ USING: combinators.lib kernel math math.ranges random sequences -tools.test tools.test.inference continuations arrays vectors ; +tools.test continuations arrays vectors ; IN: temporary [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test diff --git a/extra/io/launcher/launcher-tests.factor b/extra/io/launcher/launcher-tests.factor index b9f8f3e061..6705caa33c 100755 --- a/extra/io/launcher/launcher-tests.factor +++ b/extra/io/launcher/launcher-tests.factor @@ -1,4 +1,4 @@ IN: temporary -USING: tools.test tools.test.inference io.launcher ; +USING: tools.test io.launcher ; \ must-infer diff --git a/extra/io/server/server-tests.factor b/extra/io/server/server-tests.factor old mode 100644 new mode 100755 index 5c37a37380..776bc4b429 --- a/extra/io/server/server-tests.factor +++ b/extra/io/server/server-tests.factor @@ -1,4 +1,4 @@ IN: temporary -USING: tools.test.inference io.server ; +USING: tools.test io.server ; -{ 1 0 } [ [ ] spawn-server ] unit-test-effect +{ 1 0 } [ [ ] spawn-server ] must-infer-as diff --git a/extra/tools/test/test-docs.factor b/extra/tools/test/test-docs.factor index 147e795861..c027073398 100755 --- a/extra/tools/test/test-docs.factor +++ b/extra/tools/test/test-docs.factor @@ -1,6 +1,36 @@ -USING: help.markup help.syntax kernel ; +USING: help.markup help.syntax kernel quotations io ; IN: tools.test +ARTICLE: "tools.test.write" "Writing unit tests" +"Assert that a quotation outputs a specific set of values:" +{ $subsection unit-test } +"Assert that a quotation throws an error:" +{ $subsection must-fail } +{ $subsection must-fail-with } +"Assert that a quotation or word has a specific static stack effect (see " { $link "inference" } "):" +{ $subsection must-infer } +{ $subsection must-infer-as } ; + +ARTICLE: "tools.test.run" "Running unit tests" +"The following words run test harness files; any test failures are collected and printed at the end:" +{ $subsection test } +{ $subsection test-all } ; + +ARTICLE: "tools.test.failure" "Handling test failures" +"Most of the time the words documented in " { $link "tools.test.run" } " are used because they print all test failures in human-readable form. Sometimes, you want to develop a tool which inspects the test failures and takes some kind of action instead; one example is " { $vocab-link "builder" } "." +$nl +"The following words output an association list mapping vocabulary names to sequences of failures; a failure is an array having the shape " { $snippet "{ error test continuation }" } ", and the elements are as follows:" +{ $list + { { $snippet "error" } " - the error thrown by the unit test" } + { { $snippet "test" } " - a pair " { $snippet "{ output input }" } " containing expected output and a unit test quotation which didn't produce this output" } + { { $snippet "continuation" } " - the traceback at the point of the error" } +} +"The following words run test harness files and output failures:" +{ $subsection run-tests } +{ $subsection run-all-tests } +"The following word prints failures:" +{ $subsection failures. } ; + ARTICLE: "tools.test" "Unit testing" "A unit test is a piece of code which starts with known input values, then compares the output of a word with an expected output, where the expected output is defined by the word's contract." $nl @@ -8,13 +38,10 @@ $nl $nl "Unit tests for a vocabulary are placed in test files, named " { $snippet { $emphasis "vocab" } "-tests.factor" } " alongside " { $snippet { $emphasis "vocab" } ".factor" } "; see " { $link "vocabs.loader" } " for details." $nl -"If the test harness needs to define words, they should be placed in the " { $snippet "temporary" } " vocabulary so that they can be forgotten after the tests have been run. Test harness files consist mostly of calls to the following two words:" -{ $subsection unit-test } -{ $subsection must-fail } -{ $subsection must-fail-with } -"The following words run test harness files; any test failures are collected and printed at the end:" -{ $subsection test } -{ $subsection test-all } ; +"If the test harness needs to define words, they should be placed in the " { $snippet "temporary" } " vocabulary so that they can be forgotten after the tests have been run." +{ $subsection "tools.test.write" } +{ $subsection "tools.test.run" } +{ $subsection "tools.test.failure" } ; ABOUT: "tools.test" @@ -26,3 +53,37 @@ HELP: must-fail { $values { "quot" "a quotation run with an empty stack" } } { $description "Runs a quotation with an empty stack, expecting it to throw an error. If the quotation throws an error, this word returns normally. If the quotation does not throw an error, this word " { $emphasis "does" } " raise an error." } { $notes "This word is used to test boundary conditions and fail-fast behavior." } ; + +HELP: must-fail-with +{ $values { "quot" "a quotation run with an empty stack" } { "pred" "a quotation with stack effect " { $snippet "( error -- ? )" } } } +{ $description "Runs a quotation with an empty stack, expecting it to throw an error which must satisfy " { $snippet "pred" } ". If the quotation does not throw an error, or if the error does not match the predicate, the unit test fails." } +{ $notes "This word is used to test error handling code, ensuring that errors thrown by code contain the relevant debugging information." } ; + +HELP: must-infer +{ $values { "word/quot" "a quotation or a word" } } +{ $description "Ensures that the quotation or word has a static stack effect without running it." } +{ $notes "This word is used to test that code will compile with the optimizing compiler for optimum performance. See " { $link "compiler" } "." } ; + +HELP: must-infer-as +{ $values { "effect" "a pair with shape " { $snippet "{ inputs outputs }" } } { "quot" quotation } } +{ $description "Ensures that the quotation has the indicated stack effect without running it." } +{ $notes "This word is used to test that code will compile with the optimizing compiler for optimum performance. See " { $link "compiler" } "." } ; + +HELP: test +{ $values { "prefix" "a vocabulary name" } } +{ $description "Runs unit tests for the vocabulary named " { $snippet "prefix" } " and all of its child vocabularies." } ; + +HELP: run-tests +{ $values { "prefix" "a vocabulary name" } { "failures" "an association list of unit test failures" } } +{ $description "Runs unit tests for the vocabulary named " { $snippet "prefix" } " and all of its child vocabularies. Outputs unit test failures as documented in " { $link "tools.test.failure" } "." } ; + +HELP: test-all +{ $description "Runs unit tests for all loaded vocabularies." } ; + +HELP: run-all-tests +{ $values { "prefix" "a vocabulary name" } { "failures" "an association list of unit test failures" } } +{ $description "Runs unit tests for all loaded vocabularies and outputs unit test failures as documented in " { $link "tools.test.failure" } "." } ; + +HELP: failure. +{ $values { "failures" "an association list of unit test failures" } } +{ $description "Prints unit test failures output by " { $link run-tests } " or " { $link run-all-tests } " to the " { $link stdio } " stream." } ; diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index 09d497aac7..0b1a495e90 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -3,7 +3,8 @@ USING: namespaces arrays prettyprint sequences kernel vectors quotations words parser assocs combinators continuations debugger io io.files vocabs tools.time -vocabs.loader source-files compiler.units inspector ; +vocabs.loader source-files compiler.units inspector +inference effects ; IN: tools.test SYMBOL: failures @@ -29,13 +30,23 @@ SYMBOL: this-test { } swap with-datastack swap >array assert= ] 2curry (unit-test) ; +: short-effect ( effect -- pair ) + dup effect-in length swap effect-out length 2array ; + +: must-infer-as ( effect quot -- ) + >r 1quotation r> [ infer short-effect ] curry unit-test ; + +: must-infer ( word/quot -- ) + dup word? [ 1quotation ] when + [ infer drop ] curry [ ] swap unit-test ; + TUPLE: expected-error ; M: expected-error summary drop "The unit test expected the quotation to throw an error" ; -: must-fail-with ( quot test -- ) +: must-fail-with ( quot pred -- ) >r [ expected-error construct-empty throw ] compose r> [ recover ] 2curry [ t ] swap unit-test ; @@ -60,7 +71,7 @@ M: expected-error summary : run-test ( vocab -- failures ) V{ } clone [ failures [ - (run-test) + [ (run-test) ] [ swap failure ] recover ] with-variable ] keep ; diff --git a/extra/ui/gadgets/books/books-tests.factor b/extra/ui/gadgets/books/books-tests.factor index 35016e1669..9e1b0aa985 100755 --- a/extra/ui/gadgets/books/books-tests.factor +++ b/extra/ui/gadgets/books/books-tests.factor @@ -1,4 +1,4 @@ IN: temporary -USING: tools.test.inference ui.gadgets.books ; +USING: tools.test ui.gadgets.books ; \ must-infer diff --git a/extra/ui/gadgets/buttons/buttons-tests.factor b/extra/ui/gadgets/buttons/buttons-tests.factor index 77dfd30d96..224ef9e1ce 100755 --- a/extra/ui/gadgets/buttons/buttons-tests.factor +++ b/extra/ui/gadgets/buttons/buttons-tests.factor @@ -1,7 +1,6 @@ IN: temporary USING: ui.commands ui.gadgets.buttons ui.gadgets.labels -ui.gadgets tools.test namespaces sequences kernel models -tools.test.inference ; +ui.gadgets tools.test namespaces sequences kernel models ; TUPLE: foo-gadget ; diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor index bc302c1a09..f3a6b9fd5d 100755 --- a/extra/ui/gadgets/editors/editors-tests.factor +++ b/extra/ui/gadgets/editors/editors-tests.factor @@ -1,7 +1,6 @@ USING: ui.gadgets.editors tools.test kernel io io.streams.plain -definitions namespaces ui.gadgets -ui.gadgets.grids prettyprint documents ui.gestures -tools.test.inference tools.test.ui models ; +definitions namespaces ui.gadgets ui.gadgets.grids prettyprint +documents ui.gestures tools.test.ui models ; [ "foo bar" ] [ "editor" set diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index 81b30559df..1e27744f33 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/extra/ui/gadgets/gadgets-tests.factor @@ -1,6 +1,6 @@ IN: temporary USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test -namespaces models kernel tools.test.inference dlists math +namespaces models kernel dlists math math.parser ui sequences hashtables assocs io arrays prettyprint io.streams.string ; diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/extra/ui/gadgets/scrollers/scrollers-tests.factor index 30ba4a18f3..dd667fdfec 100755 --- a/extra/ui/gadgets/scrollers/scrollers-tests.factor +++ b/extra/ui/gadgets/scrollers/scrollers-tests.factor @@ -3,7 +3,7 @@ USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test kernel models ui.gadgets.viewports ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames ui.gadgets.sliders math math.vectors arrays sequences -tools.test.inference tools.test.ui ; +tools.test.ui ; [ ] [ "g" set diff --git a/extra/ui/tools/browser/browser-tests.factor b/extra/ui/tools/browser/browser-tests.factor index 3102ad1bd9..7262c72756 100755 --- a/extra/ui/tools/browser/browser-tests.factor +++ b/extra/ui/tools/browser/browser-tests.factor @@ -1,6 +1,5 @@ IN: temporary -USING: tools.test tools.test.ui ui.tools.browser -tools.test.inference ; +USING: tools.test tools.test.ui ui.tools.browser ; \ must-infer [ ] [ [ ] with-grafted-gadget ] unit-test diff --git a/extra/ui/tools/interactor/interactor-tests.factor b/extra/ui/tools/interactor/interactor-tests.factor index bf9de10a1e..0422c4170a 100755 --- a/extra/ui/tools/interactor/interactor-tests.factor +++ b/extra/ui/tools/interactor/interactor-tests.factor @@ -1,4 +1,4 @@ IN: temporary -USING: ui.tools.interactor tools.test.inference ; +USING: ui.tools.interactor tools.test ; \ must-infer diff --git a/extra/ui/tools/walker/walker-tests.factor b/extra/ui/tools/walker/walker-tests.factor index a23b629d1e..acf0a39bfb 100755 --- a/extra/ui/tools/walker/walker-tests.factor +++ b/extra/ui/tools/walker/walker-tests.factor @@ -2,7 +2,7 @@ USING: arrays continuations ui.tools.listener ui.tools.walker ui.tools.workspace inspector kernel namespaces sequences threads listener tools.test ui ui.gadgets ui.gadgets.worlds ui.gadgets.packs vectors ui.tools tools.interpreter -tools.interpreter.debug tools.test.inference tools.test.ui ; +tools.interpreter.debug tools.test.ui ; IN: temporary \ must-infer diff --git a/extra/ui/tools/workspace/workspace-tests.factor b/extra/ui/tools/workspace/workspace-tests.factor index 41f0151746..5e3695fed3 100755 --- a/extra/ui/tools/workspace/workspace-tests.factor +++ b/extra/ui/tools/workspace/workspace-tests.factor @@ -1,4 +1,4 @@ IN: temporary -USING: tools.test tools.test.inference ui.tools ; +USING: tools.test ui.tools ; \ must-infer