From 40e926609a45d60333195a9505bf8f9b37c2b414 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 Aug 2008 22:07:59 -0500 Subject: [PATCH] Fixing unit tests --- basis/compiler/tree/builder/builder.factor | 2 +- .../compiler/tree/def-use/def-use-tests.factor | 5 +++++ .../tree/normalization/normalization.factor | 3 ++- .../tree/propagation/propagation-tests.factor | 5 +++++ basis/hints/hints-docs.factor | 4 ++-- basis/io/encodings/8-bit/8-bit.factor | 8 ++++---- basis/stack-checker/backend/backend.factor | 16 +++++----------- .../known-words/known-words.factor | 16 ++++++++-------- basis/stack-checker/stack-checker.factor | 6 +++--- core/classes/algebra/algebra-tests.factor | 2 +- core/generic/generic-tests.factor | 3 --- core/generic/standard/standard-tests.factor | 2 +- core/io/files/files-tests.factor | 17 ++++------------- extra/combinators/lib/lib.factor | 2 +- extra/inverse/inverse.factor | 2 +- extra/io/files/unique/unique-tests.factor | 11 +++++++++++ extra/mortar/mortar.factor | 12 ------------ extra/pack/pack.factor | 8 ++++---- extra/peg/ebnf/ebnf.factor | 4 ++-- extra/promises/promises.factor | 2 +- 20 files changed, 61 insertions(+), 69 deletions(-) create mode 100644 extra/io/files/unique/unique-tests.factor diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index a01dde3462..54bc445b25 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -39,7 +39,7 @@ IN: compiler.tree.builder ] if ; : check-cannot-infer ( word -- ) - dup +cannot-infer+ word-prop [ cannot-infer-effect ] [ drop ] if ; + dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ; : check-no-compile ( word -- ) dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ; diff --git a/basis/compiler/tree/def-use/def-use-tests.factor b/basis/compiler/tree/def-use/def-use-tests.factor index 88172443ad..993627eb15 100755 --- a/basis/compiler/tree/def-use/def-use-tests.factor +++ b/basis/compiler/tree/def-use/def-use-tests.factor @@ -24,6 +24,11 @@ IN: compiler.tree.def-use.tests compute-def-use check-nodes ; +: too-deep ( a b -- c ) + dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive + +[ ] [ [ too-deep ] build-tree normalize compute-def-use check-nodes ] unit-test + ! compute-def-use checks for SSA violations, so we use that to ! ensure we generate some common patterns correctly. { diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor index a43179653f..98ec4ee3f0 100644 --- a/basis/compiler/tree/normalization/normalization.factor +++ b/basis/compiler/tree/normalization/normalization.factor @@ -81,7 +81,7 @@ SYMBOL: rename-map [ rename-map get at ] keep or ; : rename-values ( values -- values' ) - [ rename-value ] map ; + rename-map get '[ [ , at ] keep or ] map ; GENERIC: rename-node-values* ( node -- node ) @@ -126,6 +126,7 @@ SYMBOL: introduction-stack introduction-stack [ swap cut* swap ] change ; : add-renamings ( old new -- ) + [ rename-values ] dip rename-map get '[ , set-at ] 2each ; M: #introduce normalize* diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index cbd51de933..149a9e1a88 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -560,6 +560,11 @@ M: integer infinite-loop infinite-loop ; [ ] [ [ 0 fold-throw-test ] final-info drop ] unit-test +: too-deep ( a b -- c ) + dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline recursive + +[ ] [ [ too-deep ] final-info drop ] unit-test + ! [ V{ string } ] [ ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! ] unit-test diff --git a/basis/hints/hints-docs.factor b/basis/hints/hints-docs.factor index 8e22966d3f..e6ca1ff26b 100644 --- a/basis/hints/hints-docs.factor +++ b/basis/hints/hints-docs.factor @@ -1,5 +1,5 @@ IN: hints -USING: help.markup help.syntax words ; +USING: help.markup help.syntax words quotations sequences ; ARTICLE: "hints" "Compiler specialization hints" "Specialization hints help the compiler generate efficient code." @@ -11,7 +11,7 @@ $nl "In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class." $nl "Type hints are declared with a parsing word:" -{ $subsection POSTPONE: HINT: } +{ $subsection POSTPONE: HINTS: } $nl "The specialized version of a word which will be compiled by the compiler can be inspected:" { $subsection specialized-def } ; diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index cb645379b8..2cafb6be47 100755 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -53,14 +53,14 @@ SYMBOL: 8-bit-encodings TUPLE: 8-bit decode encode ; : encode-8-bit ( char stream assoc -- ) - swap >r at* - [ r> stream-write1 ] [ r> drop encode-error ] if ; inline + swapd at* + [ swap stream-write1 ] [ nip encode-error ] if ; inline M: 8-bit encode-char encode>> encode-8-bit ; : decode-8-bit ( stream array -- char/f ) - >r stream-read1 dup - [ r> nth [ replacement-char ] unless* ] [ r> 2drop f ] if ; inline + swap stream-read1 dup + [ swap nth [ replacement-char ] unless* ] [ 2drop f ] if ; inline M: 8-bit decode-char decode>> decode-8-bit ; diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index a65eb3c396..6a67b132c0 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -9,15 +9,9 @@ stack-checker.visitor stack-checker.errors ; IN: stack-checker.backend ! Word properties we use -SYMBOL: +inferred-effect+ -SYMBOL: +cannot-infer+ -SYMBOL: +special+ -SYMBOL: +shuffle+ -SYMBOL: +infer+ - SYMBOL: visited -: reset-on-redefine { +inferred-effect+ +cannot-infer+ } ; inline +: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline : (redefined) ( word -- ) dup visited get key? [ drop ] [ @@ -122,7 +116,7 @@ M: object apply-object push-literal ; consume-r dup copy-values [ #r>, ] [ nip output-d ] 2bi ; : undo-infer ( -- ) - recorded get [ f +inferred-effect+ set-word-prop ] each ; + recorded get [ f "inferred-effect" set-word-prop ] each ; : consume/produce ( effect quot -- ) #! quot is ( inputs outputs -- ) @@ -168,11 +162,11 @@ M: object apply-object push-literal ; current-effect [ check-effect ] [ drop recorded get push ] - [ +inferred-effect+ set-word-prop ] + [ "inferred-effect" set-word-prop ] 2tri ; : maybe-cannot-infer ( word quot -- ) - [ ] [ t +cannot-infer+ set-word-prop ] cleanup ; inline + [ ] [ t "cannot-infer" set-word-prop ] cleanup ; inline : infer-word ( word -- effect ) [ @@ -197,7 +191,7 @@ M: object apply-object push-literal ; dup required-stack-effect apply-word/effect ; : cached-infer ( word -- ) - dup +inferred-effect+ word-prop apply-word/effect ; + dup "inferred-effect" word-prop apply-word/effect ; : with-infer ( quot -- effect visitor ) [ diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index a0c91f679b..94dae137af 100755 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -43,7 +43,7 @@ IN: stack-checker.known-words { over (( x y -- x y x )) } { pick (( x y z -- x y z x )) } { swap (( x y -- y x )) } -} [ +shuffle+ set-word-prop ] assoc-each +} [ "shuffle" set-word-prop ] assoc-each : infer-shuffle ( shuffle -- ) [ in>> length consume-d ] keep ! inputs shuffle @@ -52,7 +52,7 @@ IN: stack-checker.known-words #shuffle, ; : infer-shuffle-word ( word -- ) - +shuffle+ word-prop infer-shuffle ; + "shuffle" word-prop infer-shuffle ; : infer-declare ( -- ) pop-literal nip @@ -166,7 +166,7 @@ M: object infer-call* >r r> declare call curry compose execute if dispatch (throw) load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback -} [ t +special+ set-word-prop ] each +} [ t "special" set-word-prop ] each { call execute dispatch load-locals get-local drop-locals } [ t "no-compile" set-word-prop ] each @@ -176,13 +176,13 @@ SYMBOL: +primitive+ : non-inline-word ( word -- ) dup +called+ depends-on { - { [ dup +shuffle+ word-prop ] [ infer-shuffle-word ] } - { [ dup +special+ word-prop ] [ infer-special ] } + { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] } + { [ dup "special" word-prop ] [ infer-special ] } { [ dup +primitive+ word-prop ] [ infer-primitive ] } { [ dup +transform-quot+ word-prop ] [ apply-transform ] } { [ dup "macro" word-prop ] [ apply-macro ] } - { [ dup +cannot-infer+ word-prop ] [ cannot-infer-effect ] } - { [ dup +inferred-effect+ word-prop ] [ cached-infer ] } + { [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] } + { [ dup "inferred-effect" word-prop ] [ cached-infer ] } { [ dup recursive-label ] [ call-recursive-word ] } [ dup infer-word apply-word/effect ] } cond ; @@ -598,7 +598,7 @@ SYMBOL: +primitive+ \ (set-os-envs) { array } { } define-primitive -\ do-primitive [ \ do-primitive cannot-infer-effect ] +infer+ set-word-prop +\ do-primitive [ \ do-primitive cannot-infer-effect ] "infer" set-word-prop \ dll-valid? { object } { object } define-primitive diff --git a/basis/stack-checker/stack-checker.factor b/basis/stack-checker/stack-checker.factor index 88514bd61a..bc3b65518c 100755 --- a/basis/stack-checker/stack-checker.factor +++ b/basis/stack-checker/stack-checker.factor @@ -18,10 +18,10 @@ M: callable infer ( quot -- effect ) : forget-errors ( -- ) all-words [ - dup subwords [ f +cannot-infer+ set-word-prop ] each - f +cannot-infer+ set-word-prop + dup subwords [ f "cannot-infer" set-word-prop ] each + f "cannot-infer" set-word-prop ] each ; : forget-effects ( -- ) forget-errors - all-words [ f +inferred-effect+ set-word-prop ] each ; + all-words [ f "inferred-effect" set-word-prop ] each ; diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor index 350c2fd66f..d9f1a97299 100755 --- a/core/classes/algebra/algebra-tests.factor +++ b/core/classes/algebra/algebra-tests.factor @@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint sequences strings tools.test vectors words quotations classes classes.algebra classes.private classes.union classes.mixin classes.predicate vectors definitions source-files compiler.units growable -random inference effects kernel.private sbufs math.order +random stack-checker effects kernel.private sbufs math.order classes.tuple ; IN: classes.algebra.tests diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 5927927122..ab39cbcbb8 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -91,10 +91,7 @@ M: ratio big-generic-test "ratio" ; M: string big-generic-test "string" ; M: shit big-generic-test "shit" ; -TUPLE: delegating ; - [ T{ shit f } "shit" ] [ T{ shit f } big-generic-test ] unit-test -[ T{ shit f } "shit" ] [ T{ delegating T{ shit f } } big-generic-test ] unit-test [ t ] [ \ + math-generic? ] unit-test diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index 54fc3c8ca3..e5f3ac8394 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -2,7 +2,7 @@ IN: generic.standard.tests USING: tools.test math math.functions math.constants generic.standard strings sequences arrays kernel accessors words float-arrays byte-arrays bit-arrays parser namespaces -quotations inference vectors growable hashtables sbufs +quotations stack-checker vectors growable hashtables sbufs prettyprint byte-vectors bit-vectors float-vectors definitions generic sets graphs assocs ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index cbe03c9ffd..0723096519 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,6 +1,6 @@ IN: io.files.tests USING: tools.test io.files io.files.private io threads kernel -continuations io.encodings.ascii io.files.unique sequences +continuations io.encodings.ascii sequences strings accessors io.encodings.utf8 math destructors namespaces ; @@ -126,6 +126,8 @@ namespaces ; [ f ] [ "test-blah" temp-file exists? ] unit-test +USE: debugger.threads + [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test [ ] [ "test-quux.txt" temp-file delete-file ] unit-test @@ -133,6 +135,7 @@ namespaces ; [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test + [ t ] [ "quux-test.txt" temp-file exists? ] unit-test [ ] [ "quux-test.txt" temp-file delete-file ] unit-test @@ -221,18 +224,6 @@ namespaces ; [ ] [ "append-test" temp-file ascii dispose ] unit-test - - -[ 123 ] [ - "core" ".test" [ - [ - ascii [ - 123 CHAR: a >string write - ] with-file-writer - ] keep file-info size>> - ] with-unique-file -] unit-test - [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 3b92844b3f..410a97d90f 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -3,7 +3,7 @@ ! Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators fry namespaces quotations hashtables -sequences assocs arrays inference effects math math.ranges +sequences assocs arrays stack-checker effects math math.ranges generalizations macros continuations random locals ; IN: combinators.lib diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 5a8ef4c787..5c77568106 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel words summary slots quotations -sequences assocs math arrays inference effects generalizations +sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors diff --git a/extra/io/files/unique/unique-tests.factor b/extra/io/files/unique/unique-tests.factor new file mode 100644 index 0000000000..7007f593b6 --- /dev/null +++ b/extra/io/files/unique/unique-tests.factor @@ -0,0 +1,11 @@ +IN: io.files.unique.tests + +[ 123 ] [ + "core" ".test" [ + [ + ascii [ + 123 CHAR: a >string write + ] with-file-writer + ] keep file-info size>> + ] with-unique-file +] unit-test diff --git a/extra/mortar/mortar.factor b/extra/mortar/mortar.factor index 5b7f3356c1..1842b9a1e2 100755 --- a/extra/mortar/mortar.factor +++ b/extra/mortar/mortar.factor @@ -48,18 +48,6 @@ if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -USE: inference.transforms - -! : narray ( n -- array ) [ drop ] map reverse ; - -: [narray] ( n -- quot ) [ [ drop ] map reverse ] curry ; - -: narray ( n -- array ) [narray] call ; - -\ narray [ [narray] ] 1 define-transform - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : new ( class -- object ) get dup >r class-slots length narray r> swap 2array ; diff --git a/extra/pack/pack.factor b/extra/pack/pack.factor index 5320583df0..ed2756bb80 100755 --- a/extra/pack/pack.factor +++ b/extra/pack/pack.factor @@ -1,7 +1,7 @@ -USING: alien alien.c-types arrays assocs byte-arrays inference -inference.transforms io io.binary io.streams.string kernel math -math.parser namespaces parser prettyprint quotations sequences -strings vectors words macros math.functions math.bitfields.lib ; +USING: alien alien.c-types arrays assocs byte-arrays io +io.binary io.streams.string kernel math math.parser namespaces +parser prettyprint quotations sequences strings vectors words +macros math.functions math.bitfields.lib ; IN: pack SYMBOL: big-endian diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index cc94a215e6..9ca8f470bb 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -4,8 +4,8 @@ USING: kernel compiler.units words arrays strings math.parser sequences quotations vectors namespaces math assocs continuations peg peg.parsers unicode.categories multiline combinators.lib splitting accessors effects sequences.deep peg.search - combinators.short-circuit lexer io.streams.string inference io - prettyprint combinators parser ; + combinators.short-circuit lexer io.streams.string + stack-checker io prettyprint combinators parser ; IN: peg.ebnf : rule ( name word -- parser ) diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor index 2126f0c05d..b9ce6a8557 100755 --- a/extra/promises/promises.factor +++ b/extra/promises/promises.factor @@ -5,7 +5,7 @@ ! Updated by Chris Double, September 2006 USING: arrays kernel sequences math vectors arrays namespaces -quotations parser effects inference words ; +quotations parser effects stack-checker words ; IN: promises TUPLE: promise quot forced? value ;