From 425e9d0ddee99093e97cf29f8854c6ab5d6ddc22 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 10 Nov 2009 16:48:06 -0600 Subject: [PATCH] Fix some test failures --- basis/math/vectors/simd/simd-tests.factor | 58 +++++++++++-------- basis/stack-checker/stack-checker-docs.factor | 6 +- .../partial-continuations-tests.factor | 4 +- 3 files changed, 38 insertions(+), 30 deletions(-) diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 396b8da22a..46cced3cb7 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -88,8 +88,8 @@ CONSTANT: simd-classes { [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ] [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ] - [ [ call ] dip call ] - [ [ call ] dip compile-call ] + [ [ [ call ] dip call ] call( quot quot -- result ) ] + [ [ [ call ] dip compile-call ] call( quot quot -- result ) ] } 2cleave @ not ] filter ; inline @@ -233,7 +233,7 @@ simd-classes&reps [ ] [ ] map-as word '[ _ execute ] ; -: check-boolean-ops ( class elt-class compare-quot -- ) +: check-boolean-ops ( class elt-class compare-quot -- seq ) [ [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip '[ first2 inputs _ _ check-boolean-op ] @@ -357,13 +357,15 @@ simd-classes [ new [ drop 16 random ] map ; :: test-shift-vector ( class -- ? ) - class random-int-vector :> src - char-16 random-shift-vector :> perm - { class char-16 } :> decl - - src perm vshuffle - src perm [ decl declare vshuffle ] compile-call - = ; inline + [ + class random-int-vector :> src + char-16 random-shift-vector :> perm + { class char-16 } :> decl + + src perm vshuffle + src perm [ decl declare vshuffle ] compile-call + = + ] call( -- ? ) ; { char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 } [ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] each @@ -371,19 +373,23 @@ simd-classes [ "== Checking vector tests" print :: test-vector-tests-bool ( vector declaration -- none? any? all? ) - vector - [ [ declaration declare vnone? ] compile-call ] - [ [ declaration declare vany? ] compile-call ] - [ [ declaration declare vall? ] compile-call ] tri ; inline + [ + vector + [ [ declaration declare vnone? ] compile-call ] + [ [ declaration declare vany? ] compile-call ] + [ [ declaration declare vall? ] compile-call ] tri + ] call( -- none? any? all? ) ; : yes ( -- x ) t ; : no ( -- x ) f ; :: test-vector-tests-branch ( vector declaration -- none? any? all? ) - vector - [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ] - [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ] - [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline + [ + vector + [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ] + [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ] + [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri + ] call( -- none? any? all? ) ; TUPLE: inconsistent-vector-test bool branch ; @@ -391,12 +397,14 @@ TUPLE: inconsistent-vector-test bool branch ; 2dup = [ drop ] [ inconsistent-vector-test boa ] if ; :: test-vector-tests ( vector decl -- none? any? all? ) - vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all ) - vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all ) - - bool-none branch-none ?inconsistent - bool-any branch-any ?inconsistent - bool-all branch-all ?inconsistent ; inline + [ + vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all ) + vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all ) + + bool-none branch-none ?inconsistent + bool-any branch-any ?inconsistent + bool-all branch-all ?inconsistent + ] call( -- none? any? all? ) ; [ f t t ] [ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test @@ -470,7 +478,7 @@ TUPLE: inconsistent-vector-test bool branch ; "== Checking broadcast" print : test-broadcast ( seq -- failures ) [ length >array ] keep - '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline + '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index 9ade6f2537..eae163f1ac 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -57,7 +57,7 @@ $nl { $heading "Limitations" } "The stack checker cannot guarantee that a literal quotation is still literal if it is passed on the data stack to an inlined recursive combinator such as " { $link each } " or " { $link map } ". For example, the following will not infer:" { $example - "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected" + "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" } "To make this work, use " { $link dip } " to pass the quotation instead:" { $example @@ -77,7 +77,7 @@ $nl "Combinators which are recursive require additional care. In addition to being declared " { $link POSTPONE: inline } ", they must be declared " { $link POSTPONE: recursive } ". There are three restrictions that only apply to combinators with this declaration:" { $heading "Input quotation declaration" } "Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:" -{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected" } +{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" } "The following is correct:" { $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" } "The effect of the nested quotation itself is only present for documentation purposes; the mere presence of a nested effect is sufficient to mark that value as a quotation parameter." @@ -85,7 +85,7 @@ $nl "The stack checker does not trace data flow in two instances." $nl "An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:" -{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected" } +{ $unchecked-example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" } "However a small change can be made:" { $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" } "An inline recursive word must have a fixed stack effect in its base case. The following will not infer:" diff --git a/extra/partial-continuations/partial-continuations-tests.factor b/extra/partial-continuations/partial-continuations-tests.factor index d6fdefd1aa..e3d8cb7fd9 100644 --- a/extra/partial-continuations/partial-continuations-tests.factor +++ b/extra/partial-continuations/partial-continuations-tests.factor @@ -1,12 +1,12 @@ USING: namespaces math partial-continuations tools.test -kernel sequences ; +kernel sequences fry ; IN: partial-continuations.tests SYMBOL: sum : range ( r from to -- n ) over - 1 + rot [ - -rot [ over + pick call drop ] each 2drop f + '[ over + @ drop ] each drop f ] bshift 2nip ; inline [ 55 ] [