Fix various unit tests

diff --git a/basis/bitstreams/bitstreams-tests.factor b/basis/bitstreams/bitstreams-tests.factor
index d55910b131e6a0bfdf08e93ca06df4fdc47bc178..769efcbb04e9ba52a1d5b0aaed53eb6f0e16518e 100644 (file)
--- a/basis/bitstreams/bitstreams-tests.factor
+++ b/basis/bitstreams/bitstreams-tests.factor
@@ -6,17 +6,17 @@ io.streams.byte-array ;
 IN: bitstreams.tests
 
 [ 1 t ]
-[ B{ 254 } <string-reader> <bitstream-reader> read-bit ] unit-test
+[ B{ 254 } binary <byte-reader> <bitstream-reader> read-bit ] unit-test
 
 [ 254 8 t ]
-[ B{ 254 } <string-reader> <bitstream-reader> 8 swap read-bits ] unit-test
+[ B{ 254 } binary <byte-reader> <bitstream-reader> 8 swap read-bits ] unit-test
 
 [ 4095 12 t ]
-[ B{ 255 255 } <string-reader> <bitstream-reader> 12 swap read-bits ] unit-test
+[ B{ 255 255 } binary <byte-reader> <bitstream-reader> 12 swap read-bits ] unit-test
 
 [ B{ 254 } ]
 [
-    <string-writer> <bitstream-writer> 254 8 rot
+    binary <byte-writer> <bitstream-writer> 254 8 rot
     [ write-bits ] keep stream>> >byte-array
 ] unit-test
 

diff --git a/basis/core-text/core-text-tests.factor b/basis/core-text/core-text-tests.factor
index 93f92391c8d30d7a37c25b1a80ab5d45a0f876b5..a5cf69fdee3e23b7fa5db1aec4b59ddd8db3fffa 100644 (file)
--- a/basis/core-text/core-text-tests.factor
+++ b/basis/core-text/core-text-tests.factor
@@ -1,10 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test core-text core-foundation
-core-foundation.dictionaries destructors
-arrays kernel generalizations math accessors
-core-foundation.utilities
-combinators hashtables colors ;
+USING: tools.test core-text core-text.fonts core-foundation
+core-foundation.dictionaries destructors arrays kernel generalizations
+math accessors core-foundation.utilities combinators hashtables colors
+colors.constants ;
 IN: core-text.tests
 
 : test-font ( name -- font )
@@ -21,8 +20,8 @@ IN: core-text.tests
 
 : test-typographic-bounds ( string font -- ? )
     [
-        test-font &CFRelease white <CTLine> &CFRelease
-        line-typographic-bounds {
+        test-font &CFRelease tuck COLOR: white <CTLine> &CFRelease
+        compute-line-metrics {
             [ width>> float? ]
             [ ascent>> float? ]
             [ descent>> float? ]

diff --git a/basis/simple-flat-file/simple-flat-file-tests.factor b/basis/simple-flat-file/simple-flat-file-tests.factor
index 5b58f569cb25beecc9f26a0bb7447673217dacd3..33b6d4ac2a104b4b0de999a9b2a7788d11cbb1e9 100644 (file)
--- a/basis/simple-flat-file/simple-flat-file-tests.factor
+++ b/basis/simple-flat-file/simple-flat-file-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Yun, Jonghyouk.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: simple-flat-file tools.test memoize ;
+USING: simple-flat-file tools.test memoize assocs ;
 IN: simple-flat-file.tests
 
 

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index 6e7774aba1bfc7f13559296ab1001f6584f8eeb0..c881ccee11438e9ed7987f72b770b3a185d7d20d 100644 (file)
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -288,7 +288,7 @@ DEFER: bar
 [ [ [ dup call ] dup call ] infer ]
 [ inference-error? ] must-fail-with
 
-: m dup call ; inline
+: m ( q -- ) dup call ; inline
 
 [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
 
@@ -296,13 +296,13 @@ DEFER: bar
 
 [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
 
-: m'' [ dup curry ] ; inline
+: m'' ( -- q ) [ dup curry ] ; inline
 
-: m''' m'' call call ; inline
+: m''' ( -- ) m'' call call ; inline
 
 [ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with
 
-: m-if t over if ; inline
+: m-if ( a b c -- ) t over if ; inline
 
 [ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with
 
@@ -488,7 +488,7 @@ ERROR: custom-error ;
     [ custom-error ] infer
 ] unit-test
 
-: funny-throw throw ; inline
+: funny-throw ( a -- * ) throw ; inline
 
 [ T{ effect f 0 0 t } ] [
     [ 3 funny-throw ] infer
@@ -502,12 +502,8 @@ ERROR: custom-error ;
     [ dup [ 3 throw ] dip ] infer
 ] unit-test
 
-! This was a false trigger of the undecidable quotation
-! recursion bug
-{ 2 1 } [ find-last-sep ] must-infer-as
-
 ! Regression
-: missing->r-check 1 load-locals ;
+: missing->r-check ( a -- ) 1 load-locals ;
 
 [ [ missing->r-check ] infer ] must-fail
 
@@ -516,7 +512,7 @@ ERROR: custom-error ;
 
 [ [ [ f dup ] [ ] while ] infer ] must-fail
 
-: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
+: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline recursive
 
 [ [ erg's-inference-bug ] infer ] must-fail
 
@@ -544,10 +540,10 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
 
 [ [ inference-invalidation-d ] infer ] must-fail
 
-: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline
+: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline recursive
 [ [ bad-recursion-3 ] infer ] must-fail
 
-: bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline
+: bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline recursive
 [ [ [ ] [ 1 2 3 ] over dup bad-recursion-4 ] infer ] must-fail
 
 : bad-recursion-5 ( obj quot: ( -- ) -- ) dup call swap bad-recursion-5 ; inline recursive

diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor
index 9210c2cab1431cbcbf3930c5d6b46d939c4cc93a..7e377aedd90abe4390ddebc3b9ddfa8d64a52337 100644 (file)
--- a/basis/tools/annotations/annotations-tests.factor
+++ b/basis/tools/annotations/annotations-tests.factor
@@ -45,4 +45,4 @@ M: string blah-generic ;
 
 { string blah-generic } watch
 
-[ ] [ "hi" blah-generic ] unit-test
+[ "hi" ] [ "hi" blah-generic ] unit-test

diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor
index 337921a00cebb02aee1b42891cdd113ab4826a2c..cd56dd876e6812f8c06a3d84a696980864a4bb88 100644 (file)
--- a/basis/ui/tools/listener/listener-tests.factor
+++ b/basis/ui/tools/listener/listener-tests.factor
@@ -25,7 +25,7 @@ IN: ui.tools.listener.tests
     ! This should not throw an exception
     [ ] [ "interactor" get evaluate-input ] unit-test
 
-    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
+    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
 
     [ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
 
@@ -48,7 +48,7 @@ IN: ui.tools.listener.tests
 
     [ ] [ "hi" "interactor" get set-editor-string ] unit-test
 
-    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
+    [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
 
     [ ] [ "interactor" get evaluate-input ] unit-test
 

diff --git a/extra/tetris/board/board-tests.factor b/extra/tetris/board/board-tests.factor
index 518b5544e9137bc173b8523c920e6f476fe96d0e..81ee65bcb8bc30fef72b8a0c01b6f612a9f4d507 100644 (file)
--- a/extra/tetris/board/board-tests.factor
+++ b/extra/tetris/board/board-tests.factor
@@ -1,23 +1,23 @@
-USING: accessors arrays colors kernel tetris.board tetris.piece tools.test ;
+USING: accessors arrays colors colors.constants kernel tetris.board tetris.piece tools.test ;
 
 [ { { f f } { f f } { f f } } ] [ 2 3 make-rows ] unit-test
 [ { { f f } { f f } { f f } } ] [ 2 3 <board> rows>> ] unit-test
 [ 1 { f f } ] [ 2 3 <board> { 1 1 } board@block ] unit-test
 [ f ] [ 2 3 <board> { 1 1 } block ] unit-test
 [ 2 3 <board> { 2 3 } block ] must-fail
-red 1array [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } block ] unit-test
+COLOR: red 1array [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block ] unit-test
 [ t ] [ 2 3 <board> { 1 1 } block-free? ] unit-test
-[ f ] [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } block-free? ] unit-test
-[ t ] [ 2 3 <board> dup { 1 1 } red set-block { 1 2 } block-free? ] unit-test
-[ t ] [ 2 3 <board> dup { 1 1 } red set-block { 0 1 } block-free? ] unit-test
+[ f ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block-free? ] unit-test
+[ t ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 2 } block-free? ] unit-test
+[ t ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 0 1 } block-free? ] unit-test
 [ t ] [ 2 3 <board> { 0 0 } block-in-bounds? ] unit-test
 [ f ] [ 2 3 <board> { -1 0 } block-in-bounds? ] unit-test
 [ t ] [ 2 3 <board> { 1 2 } block-in-bounds? ] unit-test
 [ f ] [ 2 3 <board> { 2 2 } block-in-bounds? ] unit-test
 [ t ] [ 2 3 <board> { 1 1 } location-valid? ] unit-test
-[ f ] [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } location-valid? ] unit-test
+[ f ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } location-valid? ] unit-test
 [ t ] [ 10 10 <board> 10 <random-piece> piece-valid? ] unit-test
 [ f ] [ 2 3 <board> 10 <random-piece> { 1 2 } >>location piece-valid? ] unit-test
 [ { { f } { f } } ] [ 1 1 <board> add-row rows>> ] unit-test
-[ { { f } } ] [ 1 2 <board> dup { 0 1 } red set-block remove-full-rows rows>> ] unit-test
-[ { { f } { f } } ] [ 1 2 <board> dup { 0 1 } red set-block dup check-rows drop rows>> ] unit-test
+[ { { f } } ] [ 1 2 <board> dup { 0 1 } COLOR: red set-block remove-full-rows rows>> ] unit-test
+[ { { f } { f } } ] [ 1 2 <board> dup { 0 1 } COLOR: red set-block dup check-rows drop rows>> ] unit-test

diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
index 4b5ceac08613295c9b1269cd06d21cf52b8225d4..982aabe2e8c6f9217d7dfc4fe7603d66de01bfdd 100644 (file)
--- a/extra/ui/gadgets/lists/lists.factor
+++ b/extra/ui/gadgets/lists/lists.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.vectors classes.tuple math.rectangles colors
-kernel sequences models opengl math math.order namespaces
-ui.commands ui.gestures ui.render ui.gadgets
-ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs ;
+kernel sequences models opengl math math.order namespaces call
+ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.presentations ui.gadgets.viewports
+ui.gadgets.packs ;
 IN: ui.gadgets.lists
 
 TUPLE: list < pack index presenter color hook ;
@@ -32,7 +32,7 @@ TUPLE: list < pack index presenter color hook ;
     hook>> [ [ list? ] find-parent ] prepend ;
 
 : <list-presentation> ( hook elt presenter -- gadget )
-    keep [ >label text-theme ] dip
+    [ call( elt -- obj ) ] [ drop ] 2bi [ >label text-theme ] dip
     <presentation>
     swap >>hook ; inline