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 IN: temporary
USING: bootstrap.image bootstrap.image.private USING: bootstrap.image bootstrap.image.private tools.test ;
tools.test.inference ;
\ ' must-infer \ ' must-infer
\ write-image 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 namespaces namespaces tools.test sequences inference words
arrays parser quotations continuations inference.backend effects arrays parser quotations continuations inference.backend effects
namespaces.private io io.streams.string memory system threads namespaces.private io io.streams.string memory system threads
tools.test.inference ; tools.test ;
FUNCTION: void ffi_test_0 ; FUNCTION: void ffi_test_0 ;
[ ] [ ffi_test_0 ] unit-test [ ] [ ffi_test_0 ] unit-test
@ -80,7 +80,7 @@ FUNCTION: tiny ffi_test_17 int x ;
: indirect-test-1 : indirect-test-1
"int" { } "cdecl" alien-indirect ; "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 [ 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 : indirect-test-2
"int" { "int" "int" } "cdecl" alien-indirect data-gc ; "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 ] [ 5 ]
[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] [ 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 USING: compiler definitions generic assocs inference math
namespaces parser tools.test words kernel sequences arrays io 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 IN: temporary
DEFER: x-1 DEFER: x-1
@ -28,13 +28,13 @@ DEFER: c
[ 1 2 1 2 ] [ "USE: temporary b" eval ] unit-test [ 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 [ ] [ "IN: temporary : a 1 2 3 ;" eval ] unit-test
[ 1 2 3 1 2 3 ] [ "USE: temporary b" 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 \ b word-xt "b-xt" set
@ -52,7 +52,7 @@ DEFER: c
[ ] [ "IN: temporary : a 1 2 ;" eval ] unit-test [ ] [ "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 [ 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 } { $subsection infer-quot-value }
"The " { $vocab-link "macros" } " vocabulary defines some nice syntax sugar which makes compiler transforms easier to work with." ; "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" 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." "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 $nl
@ -80,14 +86,15 @@ $nl
{ $subsection infer. } { $subsection infer. }
"Instead of printing the inferred information, it can be returned as objects on the stack:" "Instead of printing the inferred information, it can be returned as objects on the stack:"
{ $subsection infer } { $subsection infer }
"The dataflow graph used by " { $link "compiler" } " can be obtained:" "Static stack effect inference can be combined with unit tests; see " { $link "tools.test.write" } "."
{ $subsection dataflow } $nl
"The following articles describe the implementation of the stack effect inference algorithm:" "The following articles describe the implementation of the stack effect inference algorithm:"
{ $subsection "inference-simple" } { $subsection "inference-simple" }
{ $subsection "inference-combinators" } { $subsection "inference-combinators" }
{ $subsection "inference-branches" } { $subsection "inference-branches" }
{ $subsection "inference-recursive" } { $subsection "inference-recursive" }
{ $subsection "inference-limitations" } { $subsection "inference-limitations" }
{ $subsection "dataflow-graphs" }
{ $subsection "compiler-transforms" } ; { $subsection "compiler-transforms" } ;
ABOUT: "inference" 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 sequences strings vectors words quotations effects tools.test
continuations generic.standard sorting assocs definitions continuations generic.standard sorting assocs definitions
prettyprint io inspector tuples classes.union classes.predicate prettyprint io inspector tuples classes.union classes.predicate
debugger threads.private io.streams.string combinators.private debugger threads.private io.streams.string combinators.private ;
tools.test.inference ;
IN: temporary IN: temporary
{ 0 2 } [ 2 "Hello" ] unit-test-effect { 0 2 } [ 2 "Hello" ] must-infer-as
{ 1 2 } [ dup ] unit-test-effect { 1 2 } [ dup ] must-infer-as
{ 1 2 } [ [ dup ] call ] unit-test-effect { 1 2 } [ [ dup ] call ] must-infer-as
[ [ call ] infer ] must-fail [ [ 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
[ [ [ ] if ] infer ] must-fail [ [ [ ] if ] infer ] must-fail
[ [ [ 2 ] [ ] 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 } [ { 4 3 } [
[ [
@ -28,17 +27,17 @@ IN: temporary
] [ ] [
-rot -rot
] if ] if
] unit-test-effect ] must-infer-as
{ 1 1 } [ dup [ ] when ] unit-test-effect { 1 1 } [ dup [ ] when ] must-infer-as
{ 1 1 } [ dup [ dup fixnum* ] when ] unit-test-effect { 1 1 } [ dup [ dup fixnum* ] when ] must-infer-as
{ 2 1 } [ [ dup fixnum* ] when ] unit-test-effect { 2 1 } [ [ dup fixnum* ] when ] must-infer-as
{ 1 0 } [ [ drop ] when* ] unit-test-effect { 1 0 } [ [ drop ] when* ] must-infer-as
{ 1 1 } [ [ { { [ ] } } ] unless* ] unit-test-effect { 1 1 } [ [ { { [ ] } } ] unless* ] must-infer-as
{ 0 1 } { 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 [ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer
@ -50,7 +49,7 @@ IN: temporary
: termination-test-2 [ termination-test-1 ] [ 3 ] if ; : 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 ; : infinite-loop infinite-loop ;
@ -62,12 +61,12 @@ IN: temporary
: simple-recursion-1 ( obj -- obj ) : simple-recursion-1 ( obj -- obj )
dup [ simple-recursion-1 ] [ ] if ; 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 ) : simple-recursion-2 ( obj -- obj )
dup [ ] [ simple-recursion-2 ] if ; 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 ) : bad-recursion-2 ( obj -- obj )
dup [ dup first swap second bad-recursion-2 ] [ ] if ; dup [ dup first swap second bad-recursion-2 ] [ ] if ;
@ -77,10 +76,10 @@ IN: temporary
: funny-recursion ( obj -- obj ) : funny-recursion ( obj -- obj )
dup [ funny-recursion 1 ] [ 2 ] if drop ; dup [ funny-recursion 1 ] [ 2 ] if drop ;
{ 1 1 } [ funny-recursion ] unit-test-effect { 1 1 } [ funny-recursion ] must-infer-as
! Simple combinators ! Simple combinators
{ 1 2 } [ [ first ] keep second ] unit-test-effect { 1 2 } [ [ first ] keep second ] must-infer-as
! Mutual recursion ! Mutual recursion
DEFER: foe DEFER: foe
@ -103,8 +102,8 @@ DEFER: foe
2drop f 2drop f
] if ; ] if ;
{ 2 1 } [ fie ] unit-test-effect { 2 1 } [ fie ] must-infer-as
{ 2 1 } [ foe ] unit-test-effect { 2 1 } [ foe ] must-infer-as
: nested-when ( -- ) : nested-when ( -- )
t [ t [
@ -113,7 +112,7 @@ DEFER: foe
] when ] when
] when ; ] when ;
{ 0 0 } [ nested-when ] unit-test-effect { 0 0 } [ nested-when ] must-infer-as
: nested-when* ( obj -- ) : nested-when* ( obj -- )
[ [
@ -122,11 +121,11 @@ DEFER: foe
] when* ] when*
] when* ; ] when* ;
{ 1 0 } [ nested-when* ] unit-test-effect { 1 0 } [ nested-when* ] must-infer-as
SYMBOL: sym-test SYMBOL: sym-test
{ 0 1 } [ sym-test ] unit-test-effect { 0 1 } [ sym-test ] must-infer-as
: terminator-branch : terminator-branch
dup [ dup [
@ -135,7 +134,7 @@ SYMBOL: sym-test
"foo" throw "foo" throw
] if ; ] if ;
{ 1 1 } [ terminator-branch ] unit-test-effect { 1 1 } [ terminator-branch ] must-infer-as
: recursive-terminator ( obj -- ) : recursive-terminator ( obj -- )
dup [ dup [
@ -144,7 +143,7 @@ SYMBOL: sym-test
"Hi" throw "Hi" throw
] if ; ] if ;
{ 1 0 } [ recursive-terminator ] unit-test-effect { 1 0 } [ recursive-terminator ] must-infer-as
GENERIC: potential-hang ( obj -- obj ) GENERIC: potential-hang ( obj -- obj )
M: fixnum potential-hang dup [ potential-hang ] when ; 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: f iterate drop ;
M: real iterate drop ; M: real iterate drop ;
{ 1 0 } [ iterate ] unit-test-effect { 1 0 } [ iterate ] must-infer-as
! Regression ! Regression
: cat ( obj -- * ) dup [ throw ] [ throw ] if ; : cat ( obj -- * ) dup [ throw ] [ throw ] if ;
: dog ( a b c -- ) dup [ cat ] [ 3drop ] if ; : dog ( a b c -- ) dup [ cat ] [ 3drop ] if ;
{ 3 0 } [ dog ] unit-test-effect { 3 0 } [ dog ] must-infer-as
! Regression ! Regression
DEFER: monkey DEFER: monkey
: friend ( a b c -- ) dup [ friend ] [ monkey ] if ; : friend ( a b c -- ) dup [ friend ] [ monkey ] if ;
: monkey ( a b c -- ) dup [ 3drop ] [ friend ] 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 ! Regression -- same as above but we infer the second word first
DEFER: blah2 DEFER: blah2
: blah ( a b c -- ) dup [ blah ] [ blah2 ] if ; : blah ( a b c -- ) dup [ blah ] [ blah2 ] if ;
: blah2 ( a b c -- ) dup [ blah ] [ 3drop ] if ; : blah2 ( a b c -- ) dup [ blah ] [ 3drop ] if ;
{ 3 0 } [ blah2 ] unit-test-effect { 3 0 } [ blah2 ] must-infer-as
! Regression ! Regression
DEFER: blah4 DEFER: blah4
@ -182,7 +181,7 @@ DEFER: blah4
dup [ blah3 ] [ dup [ blah4 ] [ blah3 ] if ] if ; dup [ blah3 ] [ dup [ blah4 ] [ blah3 ] if ] if ;
: blah4 ( a b c -- ) : blah4 ( a b c -- )
dup [ blah4 ] [ dup [ 3drop ] [ blah3 ] if ] if ; dup [ blah4 ] [ dup [ 3drop ] [ blah3 ] if ] if ;
{ 3 0 } [ blah4 ] unit-test-effect { 3 0 } [ blah4 ] must-infer-as
! Regression ! Regression
: bad-combinator ( obj quot -- ) : bad-combinator ( obj quot -- )
@ -199,7 +198,7 @@ DEFER: blah4
dup string? [ 2array throw ] unless dup string? [ 2array throw ] unless
over string? [ 2array throw ] unless ; over string? [ 2array throw ] unless ;
{ 2 2 } [ bad-input# ] unit-test-effect { 2 2 } [ bad-input# ] must-infer-as
! Regression ! Regression
@ -218,7 +217,7 @@ DEFER: do-crap*
! Regression ! Regression
: too-deep ( a b -- c ) : too-deep ( a b -- c )
dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline 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 ! Error reporting is wrong
MATH: xyz MATH: xyz
@ -258,17 +257,17 @@ DEFER: C
[ dup B C ] [ dup B C ]
} dispatch ; } dispatch ;
{ 1 0 } [ A ] unit-test-effect { 1 0 } [ A ] must-infer-as
{ 1 0 } [ B ] unit-test-effect { 1 0 } [ B ] must-infer-as
{ 1 0 } [ C ] unit-test-effect { 1 0 } [ C ] must-infer-as
! I found this bug by thinking hard about the previous one ! I found this bug by thinking hard about the previous one
DEFER: Y DEFER: Y
: X ( a b -- c d ) dup [ swap Y ] [ ] if ; : X ( a b -- c d ) dup [ swap Y ] [ ] if ;
: Y ( a b -- c d ) X ; : Y ( a b -- c d ) X ;
{ 2 2 } [ X ] unit-test-effect { 2 2 } [ X ] must-infer-as
{ 2 2 } [ Y ] unit-test-effect { 2 2 } [ Y ] must-infer-as
! This one comes from UI code ! This one comes from UI code
DEFER: #1 DEFER: #1
@ -332,9 +331,9 @@ DEFER: bar
[ [ get-slots ] infer ] [ inference-error? ] must-fail-with [ [ get-slots ] infer ] [ inference-error? ] must-fail-with
! Test some curry stuff ! 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 [ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail
@ -381,7 +380,7 @@ DEFER: bar
\ assoc-like must-infer \ assoc-like must-infer
\ assoc-clone-like must-infer \ assoc-clone-like must-infer
\ >alist 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 ! Test some random library words
\ 1quotation must-infer \ 1quotation must-infer
@ -404,10 +403,10 @@ DEFER: bar
\ define-predicate-class must-infer \ define-predicate-class must-infer
! Test words with continuations ! Test words with continuations
{ 0 0 } [ [ drop ] callcc0 ] unit-test-effect { 0 0 } [ [ drop ] callcc0 ] must-infer-as
{ 0 1 } [ [ 4 swap continue-with ] callcc1 ] unit-test-effect { 0 1 } [ [ 4 swap continue-with ] callcc1 ] must-infer-as
{ 2 1 } [ [ + ] [ ] [ ] cleanup ] unit-test-effect { 2 1 } [ [ + ] [ ] [ ] cleanup ] must-infer-as
{ 2 1 } [ [ + ] [ 3drop 0 ] recover ] unit-test-effect { 2 1 } [ [ + ] [ 3drop 0 ] recover ] must-infer-as
\ dispose must-infer \ dispose must-infer
@ -450,13 +449,13 @@ DEFER: bar
[ [ barxxx ] infer ] must-fail [ [ barxxx ] infer ] must-fail
! A typo ! A typo
{ 1 0 } [ { [ ] } dispatch ] unit-test-effect { 1 0 } [ { [ ] } dispatch ] must-infer-as
DEFER: inline-recursive-2 DEFER: inline-recursive-2
: inline-recursive-1 ( -- ) inline-recursive-2 ; : inline-recursive-1 ( -- ) inline-recursive-2 ;
: inline-recursive-2 ( -- ) inline-recursive-1 ; : inline-recursive-2 ( -- ) inline-recursive-1 ;
{ 0 0 } [ inline-recursive-1 ] unit-test-effect { 0 0 } [ inline-recursive-1 ] must-infer-as
! Hooks ! Hooks
SYMBOL: my-var SYMBOL: my-var
@ -465,22 +464,22 @@ HOOK: my-hook my-var ( -- x )
M: integer my-hook "an integer" ; M: integer my-hook "an integer" ;
M: string my-hook "a string" ; M: string my-hook "a string" ;
{ 0 1 } [ my-hook ] unit-test-effect { 0 1 } [ my-hook ] must-infer-as
DEFER: deferred-word DEFER: deferred-word
: calls-deferred-word [ deferred-word ] [ 3 ] if ; : 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 USE: inference.dataflow
{ 1 0 } [ [ iterate-next ] iterate-nodes ] unit-test-effect { 1 0 } [ [ iterate-next ] iterate-nodes ] must-infer-as
{ 1 0 } { 1 0 }
[ [
[ [ iterate-next ] iterate-nodes ] with-node-iterator [ [ iterate-next ] iterate-nodes ] with-node-iterator
] unit-test-effect ] must-infer-as
: nilpotent ( quot -- ) : nilpotent ( quot -- )
t [ [ call ] keep nilpotent ] [ drop ] if ; inline t [ [ call ] keep nilpotent ] [ drop ] if ; inline
@ -490,11 +489,11 @@ USE: inference.dataflow
{ 0 1 } { 0 1 }
[ [ ] [ call ] keep [ [ call ] keep ] nilpotent ] [ [ ] [ 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 DEFER: an-inline-word
@ -510,9 +509,9 @@ DEFER: an-inline-word
: an-inline-word ( obj quot -- ) : an-inline-word ( obj quot -- )
>r normal-word r> call ; inline >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 ; TUPLE: custom-error ;
@ -536,4 +535,4 @@ TUPLE: custom-error ;
! This was a false trigger of the undecidable quotation ! This was a false trigger of the undecidable quotation
! recursion bug ! 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 IN: temporary
USING: sequences inference.transforms tools.test math kernel USING: sequences inference.transforms tools.test math kernel
quotations tools.test.inference inference ; quotations inference ;
: compose-n-quot <repetition> >quotation ; : compose-n-quot <repetition> >quotation ;
: compose-n compose-n-quot call ; : 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 USING: combinators.lib kernel math math.ranges random sequences
tools.test tools.test.inference continuations arrays vectors ; tools.test continuations arrays vectors ;
IN: temporary IN: temporary
[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test

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

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

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

@ -1,4 +1,4 @@
IN: temporary 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 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" 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." "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 $nl
@ -8,13 +38,10 @@ $nl
$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." "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 $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:" "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 unit-test } { $subsection "tools.test.write" }
{ $subsection must-fail } { $subsection "tools.test.run" }
{ $subsection must-fail-with } { $subsection "tools.test.failure" } ;
"The following words run test harness files; any test failures are collected and printed at the end:"
{ $subsection test }
{ $subsection test-all } ;
ABOUT: "tools.test" ABOUT: "tools.test"
@ -26,3 +53,37 @@ HELP: must-fail
{ $values { "quot" "a quotation run with an empty stack" } } { $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." } { $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." } ; { $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 USING: namespaces arrays prettyprint sequences kernel
vectors quotations words parser assocs combinators vectors quotations words parser assocs combinators
continuations debugger io io.files vocabs tools.time 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 IN: tools.test
SYMBOL: failures SYMBOL: failures
@ -29,13 +30,23 @@ SYMBOL: this-test
{ } swap with-datastack swap >array assert= { } swap with-datastack swap >array assert=
] 2curry (unit-test) ; ] 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 ; TUPLE: expected-error ;
M: expected-error summary M: expected-error summary
drop drop
"The unit test expected the quotation to throw an error" ; "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> >r [ expected-error construct-empty throw ] compose r>
[ recover ] 2curry [ recover ] 2curry
[ t ] swap unit-test ; [ t ] swap unit-test ;
@ -60,7 +71,7 @@ M: expected-error summary
: run-test ( vocab -- failures ) : run-test ( vocab -- failures )
V{ } clone [ V{ } clone [
failures [ failures [
(run-test) [ (run-test) ] [ swap failure ] recover
] with-variable ] with-variable
] keep ; ] keep ;

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

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

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

@ -1,7 +1,6 @@
IN: temporary IN: temporary
USING: ui.commands ui.gadgets.buttons ui.gadgets.labels USING: ui.commands ui.gadgets.buttons ui.gadgets.labels
ui.gadgets tools.test namespaces sequences kernel models ui.gadgets tools.test namespaces sequences kernel models ;
tools.test.inference ;
TUPLE: foo-gadget ; 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 USING: ui.gadgets.editors tools.test kernel io io.streams.plain
definitions namespaces ui.gadgets definitions namespaces ui.gadgets ui.gadgets.grids prettyprint
ui.gadgets.grids prettyprint documents ui.gestures documents ui.gestures tools.test.ui models ;
tools.test.inference tools.test.ui models ;
[ "foo bar" ] [ [ "foo bar" ] [
<editor> "editor" set <editor> "editor" set

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

@ -1,6 +1,6 @@
IN: temporary IN: temporary
USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test 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 math.parser ui sequences hashtables assocs io arrays
prettyprint io.streams.string ; 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 namespaces tools.test kernel models ui.gadgets.viewports
ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
ui.gadgets.sliders math math.vectors arrays sequences ui.gadgets.sliders math math.vectors arrays sequences
tools.test.inference tools.test.ui ; tools.test.ui ;
[ ] [ [ ] [
<gadget> "g" set <gadget> "g" set

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

@ -1,6 +1,5 @@
IN: temporary IN: temporary
USING: tools.test tools.test.ui ui.tools.browser USING: tools.test tools.test.ui ui.tools.browser ;
tools.test.inference ;
\ <browser-gadget> must-infer \ <browser-gadget> must-infer
[ ] [ <browser-gadget> [ ] with-grafted-gadget ] unit-test [ ] [ <browser-gadget> [ ] with-grafted-gadget ] unit-test

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

@ -1,4 +1,4 @@
IN: temporary IN: temporary
USING: ui.tools.interactor tools.test.inference ; USING: ui.tools.interactor tools.test ;
\ <interactor> must-infer \ <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 ui.tools.workspace inspector kernel namespaces sequences threads
listener tools.test ui ui.gadgets ui.gadgets.worlds listener tools.test ui ui.gadgets ui.gadgets.worlds
ui.gadgets.packs vectors ui.tools tools.interpreter 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 IN: temporary
\ <walker> must-infer \ <walker> must-infer

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

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