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

New must-infer word; \ foo must-infer asserts that foo's declared effect matches its inferred effect, put this in your unit tests

db4
Slava Pestov 2007-12-26 20:54:38 -05:00
parent 612b2bf78c
commit f53fa196ac
6 changed files with 94 additions and 89 deletions
extra

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

@ -3,7 +3,7 @@ inference.dataflow kernel classes kernel.private math
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 bootstrap.image tuples
prettyprint io inspector tuples
classes.union classes.predicate debugger bootstrap.image
bootstrap.image.private threads.private
io.streams.string combinators.private tools.test.inference ;
@ -352,69 +352,69 @@ DEFER: bar
[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] unit-test-fails
! Test number protocol
{ 2 1 } [ bitor ] unit-test-effect
{ 2 1 } [ bitand ] unit-test-effect
{ 2 1 } [ bitxor ] unit-test-effect
{ 2 1 } [ mod ] unit-test-effect
{ 2 1 } [ /i ] unit-test-effect
{ 2 1 } [ /f ] unit-test-effect
{ 2 2 } [ /mod ] unit-test-effect
{ 2 1 } [ + ] unit-test-effect
{ 2 1 } [ - ] unit-test-effect
{ 2 1 } [ * ] unit-test-effect
{ 2 1 } [ / ] unit-test-effect
{ 2 1 } [ < ] unit-test-effect
{ 2 1 } [ <= ] unit-test-effect
{ 2 1 } [ > ] unit-test-effect
{ 2 1 } [ >= ] unit-test-effect
{ 2 1 } [ number= ] unit-test-effect
\ bitor must-infer
\ bitand must-infer
\ bitxor must-infer
\ mod must-infer
\ /i must-infer
\ /f must-infer
\ /mod must-infer
\ + must-infer
\ - must-infer
\ * must-infer
\ / must-infer
\ < must-infer
\ <= must-infer
\ > must-infer
\ >= must-infer
\ number= must-infer
! Test object protocol
{ 2 1 } [ = ] unit-test-effect
{ 1 1 } [ clone ] unit-test-effect
{ 2 1 } [ hashcode* ] unit-test-effect
\ = must-infer
\ clone must-infer
\ hashcode* must-infer
! Test sequence protocol
{ 1 1 } [ length ] unit-test-effect
{ 2 1 } [ nth ] unit-test-effect
{ 2 0 } [ set-length ] unit-test-effect
{ 3 0 } [ set-nth ] unit-test-effect
{ 2 1 } [ new ] unit-test-effect
{ 2 1 } [ new-resizable ] unit-test-effect
{ 2 1 } [ like ] unit-test-effect
{ 2 0 } [ lengthen ] unit-test-effect
\ length must-infer
\ nth must-infer
\ set-length must-infer
\ set-nth must-infer
\ new must-infer
\ new-resizable must-infer
\ like must-infer
\ lengthen must-infer
! Test assoc protocol
{ 2 2 } [ at* ] unit-test-effect
{ 3 0 } [ set-at ] unit-test-effect
{ 2 1 } [ new-assoc ] unit-test-effect
{ 2 0 } [ delete-at ] unit-test-effect
{ 1 0 } [ clear-assoc ] unit-test-effect
{ 1 1 } [ assoc-size ] unit-test-effect
{ 2 1 } [ assoc-like ] unit-test-effect
{ 2 1 } [ assoc-clone-like ] unit-test-effect
{ 1 1 } [ >alist ] unit-test-effect
\ at* must-infer
\ set-at must-infer
\ new-assoc must-infer
\ delete-at must-infer
\ clear-assoc must-infer
\ assoc-size must-infer
\ assoc-like must-infer
\ assoc-clone-like must-infer
\ >alist must-infer
{ 1 3 } [ [ 2drop f ] assoc-find ] unit-test-effect
! Test some random library words
{ 1 1 } [ 1quotation ] unit-test-effect
{ 1 1 } [ string>number ] unit-test-effect
{ 1 1 } [ get ] unit-test-effect
\ 1quotation must-infer
\ string>number must-infer
\ get must-infer
{ 2 0 } [ push ] unit-test-effect
{ 2 1 } [ append ] unit-test-effect
{ 1 1 } [ peek ] unit-test-effect
\ push must-infer
\ append must-infer
\ peek must-infer
{ 1 1 } [ reverse ] unit-test-effect
{ 2 1 } [ member? ] unit-test-effect
{ 2 1 } [ remove ] unit-test-effect
{ 1 1 } [ natural-sort ] unit-test-effect
\ reverse must-infer
\ member? must-infer
\ remove must-infer
\ natural-sort must-infer
{ 1 0 } [ forget ] unit-test-effect
{ 4 0 } [ define-class ] unit-test-effect
{ 2 0 } [ define-tuple-class ] unit-test-effect
{ 2 0 } [ define-union-class ] unit-test-effect
{ 3 0 } [ define-predicate-class ] unit-test-effect
\ forget must-infer
\ define-class must-infer
\ define-tuple-class must-infer
\ define-union-class must-infer
\ define-predicate-class must-infer
! Test words with continuations
{ 0 0 } [ [ drop ] callcc0 ] unit-test-effect
@ -423,38 +423,36 @@ DEFER: bar
{ 2 1 } [ [ + ] [ 3drop 0 ] recover ] unit-test-effect
! Test stream protocol
{ 2 0 } [ set-timeout ] unit-test-effect
{ 2 1 } [ stream-read ] unit-test-effect
{ 1 1 } [ stream-read1 ] unit-test-effect
{ 1 1 } [ stream-readln ] unit-test-effect
{ 2 2 } [ stream-read-until ] unit-test-effect
{ 2 0 } [ stream-write ] unit-test-effect
{ 2 0 } [ stream-write1 ] unit-test-effect
{ 1 0 } [ stream-nl ] unit-test-effect
{ 1 0 } [ stream-close ] unit-test-effect
{ 3 0 } [ stream-format ] unit-test-effect
{ 3 0 } [ stream-write-table ] unit-test-effect
{ 1 0 } [ stream-flush ] unit-test-effect
{ 2 1 } [ make-span-stream ] unit-test-effect
{ 2 1 } [ make-block-stream ] unit-test-effect
{ 2 1 } [ make-cell-stream ] unit-test-effect
\ set-timeout must-infer
\ stream-read must-infer
\ stream-read1 must-infer
\ stream-readln must-infer
\ stream-read-until must-infer
\ stream-write must-infer
\ stream-write1 must-infer
\ stream-nl must-infer
\ stream-close must-infer
\ stream-format must-infer
\ stream-write-table must-infer
\ stream-flush must-infer
\ make-span-stream must-infer
\ make-block-stream must-infer
\ make-cell-stream must-infer
! Test stream utilities
{ 1 1 } [ lines ] unit-test-effect
{ 1 1 } [ contents ] unit-test-effect
\ lines must-infer
\ contents must-infer
! Test prettyprinting
{ 1 0 } [ . ] unit-test-effect
{ 1 0 } [ short. ] unit-test-effect
{ 1 1 } [ unparse ] unit-test-effect
\ . must-infer
\ short. must-infer
\ unparse must-infer
{ 1 0 } [ describe ] unit-test-effect
{ 1 0 } [ error. ] unit-test-effect
\ describe must-infer
\ error. must-infer
! Test odds and ends
{ 1 1 } [ ' ] unit-test-effect
{ 2 0 } [ write-image ] unit-test-effect
{ 0 0 } [ idle-thread ] unit-test-effect
\ idle-thread must-infer
! Incorrect stack declarations on inline recursive words should
! be caught

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

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

9
extra/tools/test/inference/inference.factor
View File

@ -1,5 +1,7 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: effects sequences kernel arrays quotations inference
tools.test ;
tools.test words ;
IN: tools.test.inference
: short-effect
@ -7,3 +9,8 @@ IN: tools.test.inference
: unit-test-effect ( effect quot -- )
>r 1quotation r> [ infer short-effect ] curry unit-test ;
: must-infer ( word -- )
dup "declared-effect" word-prop
dup effect-in length swap effect-out length 2array
swap 1quotation unit-test-effect ;

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

@ -40,7 +40,7 @@ tools.test.inference tools.test.ui models ;
] with-grafted-gadget
] unit-test
{ 0 1 } [ <editor> ] unit-test-effect
\ <editor> must-infer
"hello" <model> <field> "field" set

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

@ -193,12 +193,12 @@ M: mock-gadget ungraft*
{ { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
] string-out print
{ 0 1 } [ <gadget> ] unit-test-effect
{ 1 0 } [ unparent ] unit-test-effect
{ 2 0 } [ add-gadget ] unit-test-effect
{ 2 0 } [ add-gadgets ] unit-test-effect
{ 1 0 } [ clear-gadget ] unit-test-effect
\ <gadget> must-infer
\ unparent must-infer
\ add-gadget must-infer
\ add-gadgets must-infer
\ clear-gadget must-infer
{ 1 0 } [ relayout ] unit-test-effect
{ 1 0 } [ relayout-1 ] unit-test-effect
{ 1 1 } [ pref-dim ] unit-test-effect
\ relayout must-infer
\ relayout-1 must-infer
\ pref-dim 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 ;
{ 0 1 } [ <workspace> ] unit-test-effect
\ <workspace> must-infer