]> gitweb.factorcode.org Git - factor.git/commitdiff
Fixing some unit test failures
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 22 Apr 2009 12:05:00 +0000 (07:05 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 22 Apr 2009 12:05:00 +0000 (07:05 -0500)
20 files changed:
basis/calendar/format/macros/macros-tests.factor
basis/combinators/smart/smart-tests.factor
basis/cpu/ppc/assembler/assembler-tests.factor
basis/debugger/debugger-tests.factor
basis/help/markup/markup-tests.factor
basis/math/intervals/intervals-tests.factor
basis/peg/ebnf/ebnf-tests.factor
basis/peg/peg-tests.factor
basis/regexp/parser/parser-tests.factor
basis/tools/crossref/crossref-tests.factor
basis/tools/crossref/crossref.factor
basis/tools/profiler/profiler-tests.factor
basis/unicode/breaks/breaks-tests.factor
basis/unicode/collation/collation-tests.factor
basis/unicode/normalize/normalize-tests.factor
basis/windows/com/wrapper/wrapper.factor
core/continuations/continuations-tests.factor
core/kernel/kernel-tests.factor
core/parser/parser-tests.factor
extra/irc/client/internals/internals-tests.factor

index 48567539adfbce78a18b6fd7e46c29eb4429ebe5..4ba2872b43fb9034f62a902bf7660e33a47b489c 100644 (file)
@@ -1,4 +1,4 @@
-USING: tools.test kernel ;
+USING: tools.test kernel accessors ;
 IN: calendar.format.macros
 
 [ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test
index 080379e924160f73ffa929e56e073e28cb84bda1..a18ef1f3b8804f69cefa6a3525e5904833e5474e 100644 (file)
@@ -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 )
index f35a5cfca81c0fabb94425d8a58fba1c0150b110..09db4cb050780e4c28724216e9410552a6ae7ab7 100644 (file)
@@ -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
index afa4aa1c28c9468851fe9795550ea5e1ded77389..08f84d9335b566ac3fc3c28897ed08cfc3876372 100644 (file)
@@ -2,3 +2,6 @@ IN: debugger.tests
 USING: debugger kernel continuations tools.test ;\r
 \r
 [ ] [ [ drop ] [ error. ] recover ] unit-test\r
+\r
+[ f ] [ { } vm-error? ] unit-test\r
+[ f ] [ { "A" "B" } vm-error? ] unit-test
\ No newline at end of file
index bcd8843b24d4b4b5d237dce0452c4f78529cc3a7..93bed37a5580c197dccfe48b4cebee2c981cb364 100644 (file)
@@ -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
index 8b4345690143b980bd17f0eb552d3b0bd0b2aa1c..2b8b3dff243d5980d53b049ec2d1661a61f85cac 100644 (file)
@@ -302,8 +302,8 @@ IN: math.intervals.tests
 
 : comparison-test ( -- ? )
     random-interval random-interval random-comparison
-    [ [ [ random-element ] bi@ ] dip first execute ] 3keep
-    second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
+    [ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
+    second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
 
 [ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
 
index 58102cffc351aed4ce24a4b6c2f62f9c3aa67ec6..329156d73391a5ecd1adcb5e83a4ffbd99a852bb 100644 (file)
@@ -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
index 9a15dd210575ffc9f6629fbb9e66c252c8aaee44..683fa328d837273616913634b4a658925d4627b6 100644 (file)
@@ -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
\ No newline at end of file
index 0e12014eefe4d6f983db2fef7a8b14d410de02ce..5ea9753fbaf66b9ec2a964a7a8db951f30a0cb9d 100644 (file)
@@ -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 ;
 
 {
index 26c6c4e597c6fe69bf4a24e80cc5463e80678e12..80f5367fb6f0675895d5cecfce05137839ada053 100755 (executable)
@@ -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 )
index feaddc819497f385dc14311ec6a6242abc887ed3..c5cd246f2e08bc826baee4d8cdf387ac4f7df3c7 100644 (file)
@@ -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 -- )
 
index 0bd366372998d76a414663ee9d120137c6a2a4cc..d2e605ecdc78be4a9d9f1a592be6e81d1f4bb7ae 100644 (file)
@@ -34,7 +34,7 @@ words ;
 
 [ 1 ] [ \ foobar counter>> ] unit-test
 
-: fooblah ( -- ) { } [ ] like call ;
+: fooblah ( -- ) { } [ ] like call( -- ) ;
 
 : foobaz ( -- ) fooblah fooblah ;
 
index 3a26b012139ffc5ed3a5e5db47e5fe7141421c8d..6d6d4233f572f043101fa48417ae80e62b6cb036 100644 (file)
@@ -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
index f53a1382ae0591f95be8742472468ef8a1c00b74..fdeb721e650e4110cddae96086bc72b26ace46f3 100644 (file)
@@ -11,9 +11,10 @@ IN: unicode.collation.tests
 : test-two ( str1 str2 -- )\r
     [ +lt+ ] -rot [ string<=> ] 2curry unit-test ;\r
 \r
-: test-equality ( str1 str2 -- )\r
+: test-equality ( str1 str2 -- ? ? ? ? )\r
     { primary= secondary= tertiary= quaternary= }\r
-    [ execute ] with with each ;\r
+    [ execute( a b -- ? ) ] with with map\r
+    first4 ;\r
 \r
 [ f f f f ] [ "hello" "hi" test-equality ] unit-test\r
 [ t f f f ] [ "hello" "h\u0000e9llo" test-equality ] unit-test\r
index f774016272168f8771670543a5ec4cf822877137..cea880c0b08b5885e575da6475c3c017f4fe9f16 100644 (file)
@@ -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
index a014a56ea03219afd101af339f8b9536aa767bb5..e78c987cd4ac6ee8de1136dc37bb2e2b884af740 100755 (executable)
@@ -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 ;
 
index 391b87a44fb1afe7bfc90e1139ad6fadee41d785..f4eeeefb77e2910b3a4b0e147b7f819036a28900 100644 (file)
@@ -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 ;
-
-: foo ( -- ) callstack "c" set 3 don't-compile-me ;
+: don't-compile-me ( -- ) ;
+: foo ( -- ) callstack "c" set 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
 
index 84a356805bc0cbe4e23b9e4893d62419309ff116..b58c744b057bc29a514d6a076f618dc227e6740b 100644 (file)
@@ -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 ( -- ) "" [ ] map unimplemented ;
 
 [ total-failure-1 ] must-fail
 
index a8a57ccdaa947fbbac5ba0d5c43ed9a89342bef1..e944ecc6f29ed0a1963a03117b7388dc5f69231b 100644 (file)
@@ -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
 
 [
index d20ae50bccca95675ef5f732927c97a80f69df34..27b5648f973e162d482ba5a13bb90d0779c2435e 100644 (file)
@@ -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