steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix some test failures

db4
Slava Pestov 2009-11-10 16:48:06 -06:00
parent 7f889e4bb3
commit 425e9d0dde
3 changed files with 38 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
basis/math/vectors/simd/simd-tests.factor
View File

@ -88,8 +88,8 @@ CONSTANT: simd-classes
{ {
[ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ] [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
[ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ] [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
[ [ call ] dip call ] [ [ [ call ] dip call ] call( quot quot -- result ) ]
[ [ call ] dip compile-call ] [ [ [ call ] dip compile-call ] call( quot quot -- result ) ]
} 2cleave } 2cleave
@ not @ not
] filter ; inline ] filter ; inline
@ -233,7 +233,7 @@ simd-classes&reps [
] [ ] map-as ] [ ] map-as
word '[ _ execute ] ; 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 [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
'[ first2 inputs _ _ check-boolean-op ] '[ first2 inputs _ _ check-boolean-op ]
@ -357,13 +357,15 @@ simd-classes [
new [ drop 16 random ] map ; new [ drop 16 random ] map ;
:: test-shift-vector ( class -- ? ) :: test-shift-vector ( class -- ? )
class random-int-vector :> src [
char-16 random-shift-vector :> perm class random-int-vector :> src
{ class char-16 } :> decl char-16 random-shift-vector :> perm
{ class char-16 } :> decl
src perm vshuffle
src perm [ decl declare vshuffle ] compile-call src perm vshuffle
= ; inline src perm [ decl declare vshuffle ] compile-call
=
] call( -- ? ) ;
{ char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 } { 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 [ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] each
@ -371,19 +373,23 @@ simd-classes [
"== Checking vector tests" print "== Checking vector tests" print
:: test-vector-tests-bool ( vector declaration -- none? any? all? ) :: test-vector-tests-bool ( vector declaration -- none? any? all? )
vector [
[ [ declaration declare vnone? ] compile-call ] vector
[ [ declaration declare vany? ] compile-call ] [ [ declaration declare vnone? ] compile-call ]
[ [ declaration declare vall? ] compile-call ] tri ; inline [ [ declaration declare vany? ] compile-call ]
[ [ declaration declare vall? ] compile-call ] tri
] call( -- none? any? all? ) ;
: yes ( -- x ) t ; : yes ( -- x ) t ;
: no ( -- x ) f ; : no ( -- x ) f ;
:: test-vector-tests-branch ( vector declaration -- none? any? all? ) :: test-vector-tests-branch ( vector declaration -- none? any? all? )
vector [
[ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ] vector
[ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ] [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
[ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline [ [ 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 ; TUPLE: inconsistent-vector-test bool branch ;
@ -391,12 +397,14 @@ TUPLE: inconsistent-vector-test bool branch ;
2dup = [ drop ] [ inconsistent-vector-test boa ] if ; 2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
:: test-vector-tests ( vector decl -- none? any? all? ) :: 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 ) 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-none branch-none ?inconsistent
bool-all branch-all ?inconsistent ; inline bool-any branch-any ?inconsistent
bool-all branch-all ?inconsistent
] call( -- none? any? all? ) ;
[ f t t ] [ f t t ]
[ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test [ 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 "== Checking broadcast" print
: test-broadcast ( seq -- failures ) : test-broadcast ( seq -- failures )
[ length >array ] keep [ 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 [ { } ] [ 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 [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test

6
basis/stack-checker/stack-checker-docs.factor
View File

@ -57,7 +57,7 @@ $nl
{ $heading "Limitations" } { $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:" "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 { $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:" "To make this work, use " { $link dip } " to pass the quotation instead:"
{ $example { $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:" "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" } { $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:" "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:" "The following is correct:"
{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" } { $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." "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." "The stack checker does not trace data flow in two instances."
$nl $nl
"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:" "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:" "However a small change can be made:"
{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" } { $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:" "An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"

4
extra/partial-continuations/partial-continuations-tests.factor
View File

@ -1,12 +1,12 @@
USING: namespaces math partial-continuations tools.test USING: namespaces math partial-continuations tools.test
kernel sequences ; kernel sequences fry ;
IN: partial-continuations.tests IN: partial-continuations.tests
SYMBOL: sum SYMBOL: sum
: range ( r from to -- n ) : range ( r from to -- n )
over - 1 + rot [ over - 1 + rot [
-rot [ over + pick call drop ] each 2drop f '[ over + @ drop ] each drop f
] bshift 2nip ; inline ] bshift 2nip ; inline
[ 55 ] [ [ 55 ] [