Fixing some unit test failures

basis/calendar/format/macros/macros-tests.factor

@@ -1,4 +1,4 @@
-USING: tools.test kernel ;
+USING: tools.test kernel accessors ;
 IN: calendar.format.macros
 
 [ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test

basis/combinators/smart/smart-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test combinators.smart math kernel ;
+USING: tools.test combinators.smart math kernel accessors ;
 IN: combinators.smart.tests
 
 : test-bi ( -- 9 11 )

basis/cpu/ppc/assembler/assembler-tests.factor

@@ -114,5 +114,3 @@ make vocabs sequences ;
 { HEX: fc411800 } [ 1 2 3 FCMPU ] test-assembler
 { HEX: fc411840 } [ 1 2 3 FCMPO ] test-assembler
 { HEX: 3c601234 HEX: 60635678 } [ HEX: 12345678 3 LOAD ] test-assembler
-
-"cpu.ppc.assembler" words [ must-infer ] each

basis/debugger/debugger-tests.factor

@@ -2,3 +2,6 @@ IN: debugger.tests
 USING: debugger kernel continuations tools.test ;
 
 [ ] [ [ drop ] [ error. ] recover ] unit-test
+
+[ f ] [ { } vm-error? ] unit-test
+[ f ] [ { "A" "B" } vm-error? ] unit-test

basis/help/markup/markup-tests.factor

@@ -5,7 +5,7 @@ IN: help.markup.tests
 
 TUPLE: blahblah quux ;
 
-[ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
+[ "int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
 
 [ ] [ \ quux>> print-topic ] unit-test
 [ ] [ \ >>quux print-topic ] unit-test

basis/math/intervals/intervals-tests.factor

@@ -302,8 +302,8 @@ IN: math.intervals.tests
 
 : comparison-test ( -- ? )
     random-interval random-interval random-comparison
-    [ [ [ random-element ] bi@ ] dip first execute ] 3keep
+    [ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
-    second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
+    second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
 
 [ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
 

basis/peg/ebnf/ebnf-tests.factor

@@ -300,8 +300,6 @@ main = Primary
   "x[i][j].y" primary
 ] unit-test
 
-'ebnf' compile must-infer
-
 { V{ V{ "a" "b" } "c" } } [
   "abc" [EBNF a="a" "b" foo=(a "c") EBNF]
 ] unit-test

basis/peg/peg-tests.factor

@@ -206,5 +206,3 @@ USE: compiler
 [ ] [ enable-compiler ] unit-test
 
 [ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
-  
-[ [ ] ] [ "" epsilon [ drop [ [ ] ] ] action [ call ] action parse ] unit-test

basis/regexp/parser/parser-tests.factor

@@ -4,7 +4,7 @@ IN: regexp.parser.tests
 : regexp-parses ( string -- )
     [ [ ] ] dip '[ _ parse-regexp drop ] unit-test ;
 
-: regexp-fails ( string -- regexp )
+: regexp-fails ( string -- )
     '[ _ parse-regexp ] must-fail ;
 
 {

basis/tools/crossref/crossref-tests.factor

@@ -1,6 +1,6 @@
 USING: math kernel sequences io.files io.pathnames
 tools.crossref tools.test parser namespaces source-files generic
-definitions ;
+definitions words accessors compiler.units ;
 IN: tools.crossref.tests
 
 GENERIC: foo ( a b -- c )

basis/tools/crossref/crossref.factor

@@ -13,30 +13,47 @@ GENERIC: uses ( defspec -- seq )
 
 <PRIVATE
 
+SYMBOL: visited
+
 GENERIC# quot-uses 1 ( obj assoc -- )
 
 M: object quot-uses 2drop ;
 
 M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ;
 
-: seq-uses ( seq assoc -- ) [ quot-uses ] curry each ;
+: (seq-uses) ( seq assoc -- )
+    [ quot-uses ] curry each ;
+
+: seq-uses ( seq assoc -- )
+    over visited get memq? [ 2drop ] [
+        over visited get push
+        (seq-uses)
+    ] if ;
+
+: assoc-uses ( assoc' assoc -- )
+    over visited get memq? [ 2drop ] [
+        over visited get push
+        [ >alist ] dip (seq-uses)
+    ] if ;
 
 M: array quot-uses seq-uses ;
 
-M: hashtable quot-uses [ >alist ] dip seq-uses ;
+M: hashtable quot-uses assoc-uses ;
 
 M: callable quot-uses seq-uses ;
 
 M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
 
 M: callable uses ( quot -- assoc )
-    H{ } clone [ quot-uses ] keep keys ;
+    V{ } clone visited [
+        H{ } clone [ quot-uses ] keep keys
+    ] with-variable ;
 
 M: word uses def>> uses ;
 
 M: link uses { $subsection $link $see-also } article-links ;
 
-M: pathname uses string>> source-file top-level-form>> uses ;
+M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
 
 GENERIC: crossref-def ( defspec -- )
 

basis/tools/profiler/profiler-tests.factor

@@ -34,7 +34,7 @@ words ;
 
 [ 1 ] [ \ foobar counter>> ] unit-test
 
-: fooblah ( -- ) { } [ ] like call ;
+: fooblah ( -- ) { } [ ] like call( -- ) ;
 
 : foobaz ( -- ) fooblah fooblah ;
 

basis/unicode/breaks/breaks-tests.factor

@@ -32,7 +32,7 @@ IN: unicode.breaks.tests
         [ concat [ quot call [ "" like ] map ] curry ] bi unit-test
     ] each ;
 
-: grapheme-test ( tests quot -- )
+: grapheme-test ( tests -- )
     [
         [ 1quotation ]
         [ concat [ >graphemes [ "" like ] map ] curry ] bi unit-test

basis/unicode/collation/collation-tests.factor

@@ -11,9 +11,10 @@ IN: unicode.collation.tests
 : test-two ( str1 str2 -- )
     [ +lt+ ] -rot [ string<=> ] 2curry unit-test ;
 
-: test-equality ( str1 str2 -- )
+: test-equality ( str1 str2 -- ? ? ? ? )
     { primary= secondary= tertiary= quaternary= }
-    [ execute ] with with each ;
+    [ execute( a b -- ? ) ] with with map
+    first4 ;
 
 [ f f f f ] [ "hello" "hi" test-equality ] unit-test
 [ t f f f ] [ "hello" "h\u0000e9llo" test-equality ] unit-test

basis/unicode/normalize/normalize-tests.factor

@@ -3,8 +3,6 @@ simple-flat-file io.encodings.utf8 io.files splitting math.parser
 locals math quotations assocs combinators unicode.normalize.private ;
 IN: unicode.normalize.tests
 
-{ nfc nfkc nfd nfkd } [ must-infer ] each
-
 [ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test
 
 [ "ab\u00064b\u000347\u00034e\u00034d\u000346" ] [ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test

basis/windows/com/wrapper/wrapper.factor

@@ -132,7 +132,7 @@ unless
     [ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
 
 : (callbacks>vtbl) ( callbacks -- vtbl )
-    [ execute ] void*-array{ } map-as malloc-byte-array ;
+    [ execute( -- callback ) ] void*-array{ } map-as malloc-byte-array ;
 : (callbacks>vtbls) ( callbacks -- vtbls )
     [ (callbacks>vtbl) ] map ;
 

core/continuations/continuations-tests.factor

@@ -50,21 +50,19 @@ IN: continuations.tests
     gc
 ] unit-test
 
-[ f ] [ { } kernel-error? ] unit-test
-[ f ] [ { "A" "B" } kernel-error? ] unit-test
-
 ! ! See how well callstack overflow is handled
 ! [ clear drop ] must-fail
 ! 
 ! : callstack-overflow callstack-overflow f ;
 ! [ callstack-overflow ] must-fail
 
-: don't-compile-me ( n -- ) { } [ ] each ;
+: don't-compile-me ( -- ) ;
-
+: foo ( -- ) callstack "c" set don't-compile-me ;
-: foo ( -- ) callstack "c" set 3 don't-compile-me ;
 : bar ( -- a b ) 1 foo 2 ;
 
-[ 1 3 2 ] [ bar ] unit-test
+<< { don't-compile-me foo bar } [ t "no-compile" set-word-prop ] each >>
+
+[ 1 2 ] [ bar ] unit-test
 
 [ t ] [ \ bar def>> "c" get innermost-frame-quot = ] unit-test
 

core/kernel/kernel-tests.factor

@@ -1,7 +1,7 @@
 USING: arrays byte-arrays kernel kernel.private math memory
 namespaces sequences tools.test math.private quotations
 continuations prettyprint io.streams.string debugger assocs
-sequences.private accessors locals.backend grouping ;
+sequences.private accessors locals.backend grouping words ;
 IN: kernel.tests
 
 [ 0 ] [ f size ] unit-test
@@ -23,20 +23,25 @@ IN: kernel.tests
 
 : overflow-d ( -- ) 3 overflow-d ;
 
-[ overflow-d ] [ { "kernel-error" 12 f f } = ] must-fail-with
-
-[ ] [ :c ] unit-test
-
 : (overflow-d-alt) ( -- n ) 3 ;
 
 : overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ;
 
+: overflow-r ( -- ) 3 load-local overflow-r ;
+
+<<
+{ overflow-d (overflow-d-alt) overflow-d-alt overflow-r }
+[ t "no-compile" set-word-prop ] each
+>>
+
+[ overflow-d ] [ { "kernel-error" 12 f f } = ] must-fail-with
+
+[ ] [ :c ] unit-test
+
 [ overflow-d-alt ] [ { "kernel-error" 12 f f } = ] must-fail-with
 
 [ ] [ [ :c ] with-string-writer drop ] unit-test
 
-: overflow-r ( -- ) 3 load-local overflow-r ;
-
 [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with
 
 [ ] [ :c ] unit-test
@@ -99,7 +104,9 @@ IN: kernel.tests
 [ ] [ :c ] unit-test
 
 ! Doesn't compile; important
-: foo ( a -- b ) 5 + 0 [ ] each ;
+: foo ( a -- b ) ;
+
+<< \ foo t "no-compile" set-word-prop >>
 
 [ drop foo ] must-fail
 [ ] [ :c ] unit-test
@@ -109,13 +116,13 @@ IN: kernel.tests
     [ pick ] dip swap [ pick ] dip swap
     < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive
 
-: loop ( obj obj -- )
+: loop ( obj -- )
     H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
 
 [ loop ] must-fail
 
 ! Discovered on Windows
-: total-failure-1 ( -- ) "" [ ] map unimplemented ;
+: total-failure-1 ( -- a ) "" [ ] map unimplemented ;
 
 [ total-failure-1 ] must-fail
 

core/parser/parser-tests.factor

@@ -3,7 +3,8 @@ io.streams.string namespaces classes effects source-files assocs
 sequences strings io.files io.pathnames definitions
 continuations sorting classes.tuple compiler.units debugger
 vocabs vocabs.loader accessors eval combinators lexer
-vocabs.parser words.symbol multiline source-files.errors ;
+vocabs.parser words.symbol multiline source-files.errors
+tools.crossref ;
 IN: parser.tests
 
 [

extra/irc/client/internals/internals-tests.factor

@@ -41,7 +41,7 @@ M: mb-writer dispose drop ;
 : %pop-output-line ( -- string ) irc> stream>> out>> lines>> pop ;
 
 : read-matching-message ( chat quot: ( msg -- ? ) -- irc-message )
-    [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
+    [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; inline
 
 : spawning-irc ( quot: ( -- ) -- )
     [ spawn-client ] dip [ (terminate-irc) ] compose with-irc ; inline