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

math.vectors.simd: fix bad comparison logic in unit tests

db4
Slava Pestov 2009-09-29 23:46:21 -05:00
parent 0a29e64287
commit d70b95e4b8
1 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -177,21 +177,29 @@ CONSTANT: simd-classes
: approx= ( x y -- ? ) : approx= ( x y -- ? )
{ {
{ [ 2dup [ float? ] both? ] [ -1.e8 ~ ] } { [ 2dup [ float? ] both? ] [ -1.e8 ~ ] }
{ [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
{ [ 2dup [ sequence? ] both? ] [ { [ 2dup [ sequence? ] both? ] [
[ [
{ {
{ [ 2dup [ fp-nan? ] both? ] [ 2drop t ] } { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
{ [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
{ [ 2dup [ fp-nan? ] either? not ] [ -1.e8 ~ ] } { [ 2dup [ fp-nan? ] either? not ] [ -1.e8 ~ ] }
} cond } cond
] 2all? ] 2all?
] } ] }
} cond ; } cond ;
: exact= ( x y -- ? )
{
{ [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
{ [ 2dup [ sequence? ] both? ] [ [ fp-bitwise= ] 2all? ] }
} cond ;
: simd-classes&reps ( -- alist ) : simd-classes&reps ( -- alist )
simd-classes [ simd-classes [
{ {
{ [ dup name>> "float" head? ] [ float [ approx= ] ] } { [ dup name>> "float" head? ] [ float [ approx= ] ] }
{ [ dup name>> "double" head? ] [ float [ = ] ] } { [ dup name>> "double" head? ] [ float [ exact= ] ] }
[ fixnum [ = ] ] [ fixnum [ = ] ]
} cond 3array } cond 3array
] map ; ] map ;