steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve unit test documentation and update some tests

db4
Slava Pestov 2008-02-06 22:58:41 -06:00
parent 8f2f63677b
commit 5ecf3f7225
20 changed files with 172 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/bootstrap/image/image-tests.factor
View File

@ -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

6
core/compiler/test/alien.factor
View File

@ -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 ]

8
core/compiler/test/redefine.factor
View File

@ -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

11
core/inference/inference-docs.factor
View File

@ -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"

115
core/inference/inference-tests.factor
View File

@ -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

2
core/inference/transforms/transforms-tests.factor
View File

@ -1,6 +1,6 @@
IN: temporary
USING: sequences inference.transforms tools.test math kernel
quotations tools.test.inference inference ;
quotations inference ;
: compose-n-quot <repetition> >quotation ;
: compose-n compose-n-quot call ;

2
extra/combinators/lib/lib-tests.factor
View File

@ -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

2
extra/io/launcher/launcher-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
USING: tools.test tools.test.inference io.launcher ;
USING: tools.test io.launcher ;
\ <process-stream> must-infer

4
extra/io/server/server-tests.factor Normal file → Executable file
View File

@ -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

77
extra/tools/test/test-docs.factor
View File

@ -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." } ;

17
extra/tools/test/test.factor
View File

@ -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 ;

2
extra/ui/gadgets/books/books-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
USING: tools.test.inference ui.gadgets.books ;
USING: tools.test ui.gadgets.books ;
\ <book> must-infer

3
extra/ui/gadgets/buttons/buttons-tests.factor
View File

@ -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 ;

5
extra/ui/gadgets/editors/editors-tests.factor
View File

@ -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> "editor" set

2
extra/ui/gadgets/gadgets-tests.factor
View File

@ -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 ;

2
extra/ui/gadgets/scrollers/scrollers-tests.factor
View File

@ -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 ;
[ ] [
<gadget> "g" set

3
extra/ui/tools/browser/browser-tests.factor
View File

@ -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 ;
\ <browser-gadget> must-infer
[ ] [ <browser-gadget> [ ] with-grafted-gadget ] unit-test

2
extra/ui/tools/interactor/interactor-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
USING: ui.tools.interactor tools.test.inference ;
USING: ui.tools.interactor tools.test ;
\ <interactor> must-infer

2
extra/ui/tools/walker/walker-tests.factor
View File

@ -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
\ <walker> must-infer

2
extra/ui/tools/workspace/workspace-tests.factor
View File

@ -1,4 +1,4 @@
IN: temporary
USING: tools.test tools.test.inference ui.tools ;
USING: tools.test ui.tools ;
\ <workspace> must-infer